tomboy-ng_0.34-1/0000755000175000017500000000000014145033543013415 5ustar dbannondbannontomboy-ng_0.34-1/kcontrols/0000755000175000017500000000000014145033543015433 5ustar dbannondbannontomboy-ng_0.34-1/kcontrols/source/0000755000175000017500000000000014145033543016733 5ustar dbannondbannontomboy-ng_0.34-1/kcontrols/source/kfunctions.pas0000644000175000017500000023771614125207534021644 0ustar dbannondbannon{ @abstract(This file is part of the KControls component suite for Delphi and Lazarus.) @author(Tomas Krysl) Copyright (c) 2020 Tomas Krysl

License:
This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } unit kfunctions; // lowercase name because of Lazarus/Linux {$include kcontrols.inc} {$WEAKPACKAGEUNIT ON} interface uses {$IFDEF FPC} {$IFDEF MSWINDOWS} Windows, {$ELSE} {$IF DEFINED(UNIX) and (FPC_FULLVERSION>=20701)} UnixCP, {$IFEND} {$ENDIF} LazUTF8, {$ELSE} Windows, Messages, {$ENDIF} Classes, Contnrs, SysUtils; const { Carriage return character. } cCR = #13; { Line feed character. } cLF = #10; { TAB character. } cTAB = #9; { SPACE character. } cSPACE = #32; { String terminator. } cNULL = #0; { Set of word break characters. } cWordBreaks = [cNULL, cTAB, cSPACE]; { Set of line break characters. } cLineBreaks = [cCR, cLF]; { Text ellipsis string. } cEllipsis = '...'; { Alphabetic letters. } cLetters = ['a'..'z', 'A'..'Z']; { Number. } cNumbers = ['0'..'9']; {$IFnDEF FPC} lcl_fullversion = 0; {$ENDIF} {$IFDEF MSWINDOWS} { @exclude } SHFolderDll = 'SHFolder.dll'; {$ENDIF} {$IFDEF UNIX} cEOL = cLF; cFirstEOL = cLF; {$ELSE} cEOL = cCR + cLF; cFirstEOL = cCR; {$ENDIF} {$IFDEF MSWINDOWS} cDirectoryDelimiter = '\'; {$ELSE} cDirectoryDelimiter = '/'; {$ENDIF} cUTF16FirstSurrogateBegin = $D800; cUTF16FirstSurrogateEnd = $DBFF; cUTF16SecondSurrogateBegin = $DC00; cUTF16SecondSurrogateEnd = $DFFF; cHexFmtText = '%.2x'; cHexBase = 16; cHexDigitCount = 2; type //PInteger = ^Integer; defined by System.pas { Static array for Integer. } TIntegers = array[0..MaxInt div SizeOf(Integer) - 1] of Integer; { Pointer for TIntegers. } PIntegers = ^TIntegers; { Dynamic array for Integer. } TDynIntegers = array of Integer; //PCardinal = ^Cardinal; defined by System.pas { Static array for Cardinal. } TCardinals = array[0..MaxInt div SizeOf(Cardinal) - 1] of Cardinal; { Pointer for TCardinals. } PCardinals = ^TCardinals; { Dynamic array for Cardinal. } TDynCardinals = array of Cardinal; //PShortInt = ^ShortInt; defined by System.pas { Static array for ShortInt. } TShortInts = array[0..MaxInt div SizeOf(ShortInt) - 1] of ShortInt; { Pointer for TShortInts. } PShortInts = ^TShortInts; { Dynamic array for ShortInt. } TDynShortInts = array of ShortInt; //PSmallInt = ^SmallInt; defined by System.pas { Static array for SmallInt. } TSmallInts = array[0..MaxInt div SizeOf(SmallInt) - 1] of SmallInt; { Pointer for TSmallInts. } PSmallInts = ^TSmallInts; { Dynamic array for SmallInt. } TDynSmallInts = array of SmallInt; //PLongInt = ^LongInt; defined by System.pas { Static array for LongInt. } TLongInts = array[0..MaxInt div SizeOf(LongInt) - 1] of LongInt; { Pointer for TLongInts. } PLongInts = ^TLongInts; { Dynamic array for LongInt. } TDynLongInts = array of LongInt; //PInt64 = ^Int64; defined by System.pas { Static array for Int64. } TInt64s = array[0..MaxInt div SizeOf(Int64) - 1] of Int64; { Pointer for TInt64s. } PInt64s = ^TInt64s; { Dynamic array for Int64. } TDynInt64s = array of Int64; //PByte = ^Byte; defined by System.pas { Static array for Byte. } TBytes = array[0..MaxInt div SizeOf(Byte) - 1] of Byte; { Pointer for TBytes. } PBytes = ^TBytes; { Dynamic array for Byte. } TDynBytes = array of Byte; //PWord = ^Word; defined by System.pas { Static array for Word. } TWords = array[0..MaxInt div SizeOf(Word) - 1] of Word; { Pointer for TWords. } PWords = ^TWords; { Dynamic array for Word. } TDynWords = array of Word; //PLongWord = ^LongWord; defined by System.pas { Static array for LongWord. } TLongWords = array[0..MaxInt div SizeOf(LongWord) - 1] of LongWord; { Pointer for TLongWords. } PLongWords = ^TLongWords; { Dynamic array for LongWord. } TDynLongWords = array of LongWord; {$IF DEFINED(COMPILER10_UP) OR DEFINED(FPC)} {$IFDEF FPC} PUInt64 = ^UInt64; {$ELSE} //PUInt64 = ^UInt64; defined by System.pas {$ENDIF} { Static array for UInt64. } TUInt64s = array[0..MaxInt div SizeOf(UInt64) - 1] of UInt64; { Pointer for TUInt64s. } PUInt64s = ^TUInt64s; { Dynamic array for UInt64. } TDynUInt64s = array of UInt64; {$IFEND} //PSingle = ^Single; defined by System.pas { Static array for Single. } TSingles = array[0..MaxInt div SizeOf(Single) - 1] of Single; { Pointer for TSingles. } PSingles = ^TSingles; { Dynamic array for Single. } TDynSingles = array of Single; //PDouble = ^Double; defined by System.pas { Static array for Double. } TDoubles = array[0..MaxInt div SizeOf(Double) - 1] of Double; { Pointer for TDoubles. } PDoubles = ^TDoubles; { Dynamic array for Double. } TDynDoubles = array of Double; {$IFNDEF FPC} //PExtended = ^Extended; defined by System.pas { Static array for Extended. } TExtendeds = array[0..MaxInt div SizeOf(Extended) - 1] of Extended; { Pointer for TExtendeds. } PExtendeds = ^TExtendeds; { Dynamic array for Extended. } TDynExtendeds = array of Extended; {$ENDIF} //PChar is special type { Static array for Char. } TChars = array[0..MaxInt div SizeOf(Char) - 1] of Char; { Pointer for TChars. } PChars = ^TChars; { Dynamic array for Char. } TDynChars = array of Char; //PAnsiChar is special type { Static array for AnsiChar. } TAnsiChars = array[0..MaxInt div SizeOf(AnsiChar) - 1] of AnsiChar; { Pointer for TChars. } PAnsiChars = ^TAnsiChars; { Dynamic array for Char. } TDynAnsiChars = array of AnsiChar; PBoolean = ^Boolean; { Static array for Double. } TBooleans = array[0..MaxInt div SizeOf(Boolean) - 1] of Boolean; { Pointer for TBooleans. } PBooleans = ^TBooleans; { Dynamic array for Double. } TDynBooleans = array of Boolean; {$IFDEF FPC} { TKString is UTF8 string in Lazarus. } TKString = string; { TKChar is UTF8 character in Lazarus. } TKChar = string[7]; // UTF-8 character is at most 6 bytes plus a #0 { PKChar is pointer to UTF8 character in Lazarus. } PKChar = ^TKChar; { PKText is PChar (null terminated UTF8 string) in Lazarus. } PKText = PChar; {$ELSE} {$IFDEF STRING_IS_UNICODE} { TKString is UnicodeString (UTF16) in unicode aware Delphi. } TKString = string; { TKChar is Char in unicode aware Delphi. } TKChar = Char; { PKChar is pointer to Char in unicode aware Delphi. } PKChar = ^Char; { PKText is PChar in unicode aware Delphi. } PKText = PChar; {$ELSE} { TKString is WideString in old non-unicode Delphi versions. } TKString = WideString; { TKChar is WideChar in old non-unicode Delphi versions. } TKChar = WideChar; { PKChar is pointer to WideChar in old non-unicode Delphi versions. } PKChar = ^WideChar; { PKText is PWideChar in old non-unicode Delphi versions. } PKText = PWideChar; {$ENDIF} {$ENDIF} { Useful structure to handle general data and size as a single item } TDataSize = record Data: Pointer; Size: Int64; end; { Pointer for TDataSize } PDataSize = ^TDataSize; { Set type for @link(CharInSetEx). } TKSysCharSet = set of AnsiChar; { Defines a currency format settings for @link(FormatCurrency). } TKCurrencyFormat = record CurrencyFormat, CurrencyDecimals: Byte; CurrencyString: TKString; DecimalSep: Char; ThousandSep: Char; UseThousandSep: Boolean; end; { @abstract(Declares a structure that holds both column and row span of a cell) } TKCellSpan = record ColSpan: Integer; RowSpan: Integer; end; { @abstract(Declares a structure that holds point coordinates as 64-bit wide integers) } TKPoint64 = record X, Y: Int64; end; { Pointer } PKPoint64 = ^TKPoint64; { @abstract(Declares a structure that holds rectangle coordinates as 64-bit wide integers) } TKRect64 = record Left, Right, Top, Bottom: Int64; end; { Pointer } PKRect64 = ^TKRect64; { @abstract(Declares the digit position in a hex string) } TKHexDigitPosition = record Index: Int64; Digit: Integer; end; TKLogType = ( lgNone, lgError, lgWarning, lgNote, lgHint, lgInfo, lgInputError, lgIOError, lgAll ); TKObjectList = class; TKObject = class(TObject) private FParent: TKObjectList; procedure SetParent(const Value: TKObjectList); protected FUpdateLock: Integer; procedure CallBeforeUpdate; virtual; procedure CallAfterUpdate; virtual; procedure ParentChanged; virtual; public constructor Create; virtual; procedure Assign(ASource: TKObject); virtual; function EqualProperties(AValue: TKObject): Boolean; virtual; procedure LockUpdate; virtual; procedure UnLockUpdate; virtual; function UpdateUnlocked: Boolean; virtual; property Parent: TKObjectList read FParent write SetParent; end; TKObjectClass = class of TKObject; TKObjectList = class(TObjectList) protected FUpdateLock: Integer; procedure CallBeforeUpdate; virtual; procedure CallAfterUpdate; virtual; public constructor Create; virtual; function Add(AObject: TObject): Integer; procedure Assign(ASource: TKObjectList); virtual; function EqualProperties(AValue: TKObjectList): Boolean; virtual; procedure Insert(Index: Integer; AObject: TObject); procedure LockUpdate; virtual; procedure UnLockUpdate; virtual; function UpdateUnlocked: Boolean; virtual; end; TKPersistent = class(TPersistent) private FChanged: Boolean; FUpdateLock: Integer; protected { Call in property setters to track changes to this class. } procedure Changed; { Override to perform requested actions when changing properties in this class. Update will be called either immediately when you call Changed or on next UnlockUpdate call if Changed has been called while updating was locked. } procedure Update; virtual; abstract; public { Creates the instance. } constructor Create; virtual; { Locks updating. Use this if you assign many properties at the same time. Every LockUpdate call must have a corresponding @link(TKPersistent.UnlockUpdate) call, please use a try-finally section. } procedure LockUpdate; { Unlocks page setup updating and updates the page settings. Each @link(TKPersistent.LockUpdate) call must be always followed by the UnlockUpdate call. } procedure UnlockUpdate(ACallUpdate: Boolean = True); { Returns True if updating is not locked, i.e. there is no open LockUpdate and UnlockUpdate pair. } function UpdateUnlocked: Boolean; property UpdateLock: Integer read FUpdateLock; end; { Replaces possible decimal separators in S with DecimalSeparator variable.} function AdjustDecimalSeparator(const S: string): string; { Converts an AnsiString into a TKString. If CodePage is not set the current system code page for ANSI-UTFx translations will be used. } function AnsiStringToString(const Text: AnsiString; CodePage: Cardinal = 0): TKString; {$IFNDEF FPC} function AnsiStringToWideChar(const Text: AnsiString; CodePage: Cardinal = 0): PWideChar; {$ENDIF} type { Callback for binary search data item comparison. } TBsCompareProc = function(Data: Pointer; Index: Integer; KeyPtr: Pointer): Integer; { Performs binary search on previously sorted data given by AData and ACount. KeyPtr is the pointer to the key which is passed to the ACompareProc. The items are compared by CompareProc callback. Returns the zero based index of the matched data or -1 if no match has been found. } function BinarySearch(AData: Pointer; ACount: Integer; KeyPtr: Pointer; ACompareProc: TBSCompareProc; ASortedDown: Boolean): Integer; { Compiler independent Delphi2009-like CharInSet function for ANSI characters. } function CharInSetEx(AChar: AnsiChar; const ASet: TKSysCharSet): Boolean; overload; { Compiler independent Delphi2009-like CharInSet function for Unicode characters. } function CharInSetEx(AChar: WideChar; const ASet: TKSysCharSet): Boolean; overload; { Compares two Integers. Returns 1 if I1 > I2, -1 if I1 < I2 and 0 if I1 = I2. } function CompareIntegers(I1, I2: Integer): Integer; { Compares two PWideChar strings. Returns 1 if W1 > W2, -1 if W1 < W2 and 0 if W1 = W2. The strings will be compared using the default user locale unless another locale has been specified in Locale. } function CompareWideChars(W1, W2: PWideChar{$IFDEF USE_WIDEWINPROCS}; Locale: Cardinal = LOCALE_USER_DEFAULT{$ENDIF}): Integer; {$IFDEF STRING_IS_UNICODE} { Compares two Unicode strings (Lazarus, Delphi 2009 and better). Returns 1 if S1 > S2, -1 if S1 < S2 and 0 if S1 = S2. The strings will be compared using the default user locale unless another locale has been specified in Locale. } function CompareChars(S1, S2: PChar{$IFDEF USE_WIDEWINPROCS}; Locale: Cardinal = LOCALE_USER_DEFAULT{$ENDIF}): Integer; {$ENDIF} { Compares two WideString strings. Returns 1 if W1 > W2, -1 if W1 < W2 and 0 if W1 = W2. The strings will be compared using the default user locale unless another locale has been specified in Locale. } function CompareWideStrings(W1, W2: WideString{$IFDEF USE_WIDEWINPROCS}; Locale: Cardinal = LOCALE_USER_DEFAULT{$ENDIF}): Integer; {$IFDEF STRING_IS_UNICODE} { Compares two Unicode strings (Lazarus, Delphi 2009 and better). Returns 1 if S1 > S2, -1 if S1 < S2 and 0 if S1 = S2. The strings will be compared using the default user locale unless another locale has been specified in Locale. } function CompareStrings(S1, S2: string{$IFDEF USE_WIDEWINPROCS}; Locale: Cardinal = LOCALE_USER_DEFAULT{$ENDIF}): Integer; {$ENDIF} { Converts tab characters in a string to space characters. } procedure ConvertTabsToSpaces(var AText: TKString; ASpacesForTab: Integer); { Creates given directory, even if more folders have to be created. } function CreateMultipleDir(const Dir: string): Boolean; { Converts hexadecimal digit to nibble. } function DigitToNibble(Digit: AnsiChar; var Nibble: Byte): Boolean; { Performs integer division. If there is a nonzero remainder, the result will be incremented. } function DivUp(Dividend, Divisor: Integer): Integer; { Performs 64-bit integer division. If there is a nonzero remainder, the result will be incremented. } function DivUp64(Dividend, Divisor: Int64): Int64; { Performs integer division. If there is a nonzero remainder, the result will be decremented. } function DivDown(Dividend, Divisor: Integer): Integer; { Performs 64-bit integer division. If there is a nonzero remainder, the result will be decremented. } function DivDown64(Dividend, Divisor: Int64): Int64; { Ensures the path given by APath has slash at the end. } procedure EnsureLastPathSlash(var APath: string); { Ensures the path given by APath has slash at the end. } function EnsureLastPathSlashFnc(const APath: string): string; { Raises a general exception with associated message Msg. } procedure Error(const Msg: string); { Swaps values of two SmallInt variables. } procedure Exchange(var Value1, Value2: SmallInt); overload; { Swaps values of two ShortInt variables. } procedure Exchange(var Value1, Value2: ShortInt); overload; { Swaps values of two Integer variables. } procedure Exchange(var Value1, Value2: Integer); overload; { Swaps values of two Int64 variables. } procedure Exchange(var Value1, Value2: Int64); overload; { Swaps values of two Byte variables. } procedure Exchange(var Value1, Value2: Byte); overload; { Swaps values of two Word variables. } procedure Exchange(var Value1, Value2: Word); overload; { Swaps values of two Cardinal variables. } procedure Exchange(var Value1, Value2: Cardinal); overload; {$IFDEF COMPILER10_UP } { Swaps values of two UInt64 variables. } procedure Exchange(var Value1, Value2: UInt64); overload; {$ENDIF} { Swaps values of two Single variables. } procedure Exchange(var Value1, Value2: Single); overload; { Swaps values of two Double variables. } procedure Exchange(var Value1, Value2: Double); overload; {$IFNDEF FPC} { Swaps values of two Extended variables. } procedure Exchange(var Value1, Value2: Extended); overload; {$ENDIF} { Swaps values of two Char variables. } procedure Exchange(var Value1, Value2: Char); overload; { Returns file name without path and extension. } function ExtractFileRawName(const APath: string): string; { Formats the given currency value with to specified parameters. Not thread safe. } function FormatCurrency(Value: Currency; const AFormat: TKCurrencyFormat): TKString; { Returns the module version for given module. Tested under WinX, Linux, OSX. } function GetAppVersion(const ALibName: string; out MajorVersion, MinorVersion, BuildNumber, RevisionNumber: Word): Boolean; { Returns the module version string for given module. Tested under WinX, Linux, OSX. } function GetAppVersionString(const ALibName, ACodePage, AString: string; out AValue: string): Boolean; { Returns number of a specific character in a string. } function GetCharCount(const AText: TKString; AChar: TKChar): Integer; { Returns the standard locale dependent format settings. } function GetFormatSettings: TFormatSettings; { Converts an integer into binary string with custom alignment (given by Digits). } function IntToAscii(Value: Int64; Digits: Integer): string; { Converts an integer into binary digit string with custom alignment (given by Digits) and suffix. } function IntToBinStr(Value: Int64; Digits: Integer; const Suffix: string): string; { Converts an integer value into BCD number. } function IntToBCD(Value: Cardinal): Cardinal; { Converts a signed integer into decimal digit string with custom alignment (given by Digits). } function IntToDecStr(Value: Int64; Digits: Integer = 0): string; { Converts a unsigned integer into decimal digit string with custom alignment (given by Digits). } function UIntToDecStr(Value: UInt64; Digits: Integer = 0): string; { Converts an integer into hexadecimal digit string with custom alignment (given by Digits), prefix and suffix. Digits represented by alphabetical characters can be either in lower or upper case. } function IntToHexStr(Value: Int64; Digits: Integer; const Prefix, Suffix: string; UseLowerCase: Boolean): string; { Converts an integer into octal digit string. } function IntToOctStr(Value: Int64): string; { Converts an integer into roman number. } function IntToRoman(Value: Integer; AUpperCase: Boolean): string; { Converts an integer into latin alphabetic numbering. } function IntToLatin(Value: Integer; AUpperCase: Boolean): string; { Calculates an integer power from an integer number. } function IntPowerInt(Value: Int64; Exponent: Integer): Int64; { Converts a binary string into integer with custom alignment (given by Digits). } function AsciiToInt(S: string; Digits: Integer): Int64; { Converts a BCD number into integer value. } function BCDToInt(Value: Cardinal): Cardinal; { Converts a binary digit string into integer with custom alignment (given by Digits) and sign of a value represented by the string (given by Signed). Code returns either zero for a successful conversion or the position of first bad character. } function BinStrToInt(S: string; Digits: Integer; Signed: Boolean; var Code: Integer): Int64; { Converts a decimal digit string into integer. Code returns either zero for a successful conversion or the position of first bad character. Equals to Val. } function DecStrToInt(S: string; var Code: Integer): Int64; { Converts a hexadecimal digit string into integer with custom alignment (given by Digits) and sign of a value represented by the string (given by Signed). Code returns either zero for a successful conversion or the position of first bad character. } function HexStrToInt(S: string; Digits: Integer; Signed: Boolean; var Code: Integer): Int64; { Converts an octal digit string into integer. Code returns either zero for a successful conversion or the position of first bad character. } function OctStrToInt(S: string; var Code: Integer): Int64; { Calls SysUtils.Format. } function KFormat(const Format: string; const Args: array of const; const AFormatSettings: TFormatSettings): string; overload; { Calls SysUtils.WideFormat. } function KFormat(const Format: WideString; const Args: array of const; const AFormatSettings: TFormatSettings): WideString; overload; { Makes a @link(TKCellSpan) record from AColumns and ARows. } function MakeCellSpan(AColumns, ARows: Integer): TKCellSpan; { Returns a clipped ShortInt value so that it lies between Min and Max } function MinMax(Value, Min, Max: ShortInt): ShortInt; overload; { Returns a clipped SmallInt value so that it lies between Min and Max } function MinMax(Value, Min, Max: SmallInt): SmallInt; overload; { Returns a clipped Integer value so that it lies between Min and Max } function MinMax(Value, Min, Max: Integer): Integer; overload; { Returns a clipped Int64 value so that it lies between Min and Max } function MinMax(Value, Min, Max: Int64): Int64; overload; { Returns a clipped Single value so that it lies between Min and Max } function MinMax(Value, Min, Max: Single): Single; overload; { Returns a clipped Double value so that it lies between Min and Max } function MinMax(Value, Min, Max: Double): Double; overload; {$IFNDEF FPC} { Returns a clipped Extended value so that it lies between Min and Max } function MinMax(Value, Min, Max: Extended): Extended; overload; {$ENDIF} { Fill the data & size structure. } function MakeDataSize(AData: Pointer; ASize: Integer): TDataSize; { Converts nibble to hexadecimal digit. } function NibbleToDigit(Nibble: Byte; UpperCase: Boolean): AnsiChar; type { Callback for quicksort data item comparison. } TQsCompareProc = function(Data: Pointer; Index1, Index2: Integer): Integer; { Callback for quicksort data item exchange. } TQsExchangeProc = procedure(Data: Pointer; Index1, Index2: Integer); { Sorts Count number of items by means of a non recursive quicksort algorithm. The items are compared by CompareProc callback and sorted by ExchangeProc callback. } procedure QuickSortNR(AData: Pointer; ACount: Integer; ACompareProc: TQsCompareProc; AExchangeProc: TQsExchangeProc; ASortedDown: Boolean); { Sorts Count number of items by means of a recursive quicksort algorithm. The items are compared by CompareProc callback and sorted by ExchangeProc callback. } procedure QuickSort(AData: Pointer; ACount: Integer; ACompareProc: TQsCompareProc; AExchangeProc: TQsExchangeProc; ASortedDown: Boolean); { Add AX and AY to APoint. } procedure OffsetPoint(var APoint: TPoint; AX, AY: Integer); overload; { Add AOffset to APoint. } procedure OffsetPoint(var APoint: TPoint; const AOffset: TPoint); overload; { Normalizes the given input rectangle. } function NormalizeRect(const ARect: TRect): TRect; { Create 64-bit point structure. } function Point64(AX, AY: Int64): TKPoint64; { Convert point structure to 64-bit point structure. } function PointToPoint64(const APoint: TPoint): TKPoint64; { Convert point structure to 64-bit point structure. } function Point64ToPoint(const APoint: TKPoint64): TPoint; { Examines if APoint lies within ARect. } function Pt64InRect(const ARect: TRect; const APoint: TKPoint64): Boolean; { Create 64-bit rectangle structure. } function Rect64(ALeft, ATop, ARight, ABottom: Int64): TKRect64; { Examines if some part of Rect lies within Bounds. } function RectInRect(Bounds, Rect: TRect): Boolean; { Examines if Rect lies fully within Bounds. } function RectInRectFully(Bounds, Rect: TRect): Boolean; { Add AX and AY to ARect. } procedure OffsetRect(var ARect: TRect; AX, AY: Integer); overload; { Add AOffset to ARect. } procedure OffsetRect(var ARect: TRect; const AOffset: TPoint); overload; { Ensures the path given by APath has no slash at the end. } procedure StripLastPathSlash(var APath: string); { Ensures the path given by APath has no slash at the end. } function StripLastPathSlashFnc(const APath: string): string; { Returns next character index for given string and character index. Takes MBCS (UTF16 in Delphi and UTF8 in Lazarus) into account. } function StrNextCharIndex(const AText: TKString; Index: Integer): Integer; { Returns previous character index for given string and character index. Takes MBCS (UTF16 in Delphi and UTF8 in Lazarus) into account. } function StrPreviousCharIndex(const AText: TKString; Index: Integer): Integer; { Converts byte index to code point index for given string and byte index. Takes MBCS (UTF16 in Delphi and UTF8 in Lazarus) into account. } function StrByteIndexToCPIndex(const AText: TKString; ByteIndex: Integer): Integer; { Converts code point index to byte index for given string and code point index. Takes MBCS (UTF16 in Delphi and UTF8 in Lazarus) into account. } function StrCPIndexToByteIndex(const AText: TKString; CPIndex: Integer): Integer; { Returns the index for given string where character at given index begins. Takes MBCS (UTF16 in Delphi and UTF8 in Lazarus) into account. } function StringCharBegin(const AText: TKString; Index: Integer): Integer; { Returns the number of characters in a string. Takes MBCS (UTF16 in Delphi and UTF8 in Lazarus) into account. } function StringLength(const AText: TKString): Integer; { Performs standard Copy operation. Takes MBCS (UTF16 in Delphi and UTF8 in Lazarus) into account. } function StringCopy(const ASource: TKString; At, Count: Integer): TKString; { Performs standard Delete operation. Takes MBCS (UTF16 in Delphi and UTF8 in Lazarus) into account. } procedure StringDelete(var ASource: TKString; At, Count: Integer); { Trims characters specified by ASet from the beginning and end of AText. New text length is returned by ALen. } procedure TrimWhiteSpaces(const AText: TKString; var AStart, ALen: Integer; const ASet: TKSysCharSet); overload; { Trims characters specified by ASet from the beginning and end of AText. } procedure TrimWhiteSpaces(var AText: TKString; const ASet: TKSysCharSet); overload; {$IFNDEF FPC} { Trims characters specified by ASet from the beginning and end of AText. } procedure TrimWhiteSpaces(var AText: AnsiString; const ASet: TKSysCharSet); overload; {$ENDIF} { Converts a TKString into AnsiString. If CodePage is not set the current system code page for ANSI-UTFx translations will be used. } function StringToAnsiString(const AText: TKString; CodePage: Cardinal = 0): AnsiString; function StringToUTF8(const AText: string): AnsiString; { Converts specified character of TKString into TKChar. } function StringToChar(const AText: TKString; AIndex: Integer): TKChar; {$IFDEF MSWINDOWS} function GetWindowsFolder(CSIDL: Cardinal; var APath: string): Boolean; function RunExecutable(const AFileName: string; AWaitForIt: Boolean): DWORD; {$ENDIF} function SystemCodePage: Integer; function NativeUTFToUnicode(const AText: TKString): WideChar; function UnicodeUpperCase(const AText: TKString): TKString; function UnicodeLowerCase(const AText: TKString): TKString; function UnicodeToNativeUTF(const AParam: WideChar): TKString; function UnicodeStringReplace(const AText, AOldPattern, ANewPattern: TKString; AFlags: TReplaceFlags): TKString; function UTF8ToString(const AText: AnsiString): string; { Creates a selection structure from given Index and Digit parameters } function MakeHexDigitPosition(Index: Int64; Digit: Integer): TKHexDigitPosition; { Converts a hexadecimal digit character ('0'..'F') to binary value } function DigitToBin(Value: AnsiChar): Integer; { Examines/converts hexadecimal digit string to binary value string. Returns True if the digit string is valid. } function DigitsToBinStr(var S: AnsiString; Convert: Boolean = True): Boolean; { Converts a binary value string into binary data. If the binary value string is not divisible by 2, it will be right padded with zero. Example: '#A#F#0#1#D#C#0#5#3' is converted into '#AF#01#DC#05#30'. } function BinStrToBinary(const S: AnsiString): AnsiString; { Converts binary value (0..15) to hexadecimal digit character ('0'..'F') } function BinToDigit(Value: Byte): AnsiChar; { Converts binary data into hexadecimal digit string. Example: '#AF#01#DC#05#30' is converted into 'AF01DC0530'. If AInsertSpaces is True then resulting string is 'AF 01 DC 05 30'. } function BinaryToDigits(Buffer: PBytes; SelStart, SelEnd: TKHexDigitPosition; AInsertSpaces: Boolean = False): AnsiString; overload; { Convertes binary data into hexadecimal digit string. Entire data used. } function BinaryToDigits(Buffer: PBytes; ASize: Int64; AInsertSpaces: Boolean = False): AnsiString; overload; { Convertes binary data into hexadecimal digit string. Uses AnsiString as source data. } function BinaryToDigits(const Source: AnsiString; AInsertSpaces: Boolean = False): AnsiString; overload; { Converts a binary value string into hexadecimal digit string. If the binary value string is not divisible by 2, it will be trimmed. Example: '#A#F#0#1#D#C#0#5#3' is converted into 'AF01DC05'. If AInsertSpaces is True then resulting string is 'AF 01 DC 05'. } function BinStrToDigits(const Source: AnsiString; AInsertSpaces: Boolean = False): AnsiString; { Insert spaces into hexadecimal digit string. Example: 'AF01DC05' becomes 'AF 01 DC 05'. } function InsertSpacesToDigits(const Source: AnsiString): AnsiString; { Replaces a hexadecimal digit in the given binary value. Returns the original value with a replaced digit. Example: Value = $A18D, Digit = $C, Pos = 3: Result = $AC8D } function ReplaceDigit(Value, Digit, Pos: Integer): Integer; implementation uses Math, TypInfo {$IFDEF FPC} , versionresource {$ENDIF} {$IFDEF USE_WIDEWINPROCS} , KWideWinProcs {$ENDIF} {$IFDEF FPC} , LConvEncoding {$ENDIF} ; { TKObject } constructor TKObject.Create; begin inherited; FParent := nil; FUpdateLock := 0; end; procedure TKObject.Assign(ASource: TKObject); begin end; procedure TKObject.CallAfterUpdate; begin end; procedure TKObject.CallBeforeUpdate; begin end; function TKObject.EqualProperties(AValue: TKObject): Boolean; begin Result := True; end; procedure TKObject.LockUpdate; begin if FUpdateLock <= 0 then CallBeforeUpdate; Inc(FUpdateLock); end; procedure TKObject.ParentChanged; begin end; procedure TKObject.SetParent(const Value: TKObjectList); begin if Value <> FParent then begin FParent := Value; ParentChanged; end; end; procedure TKObject.UnLockUpdate; begin if FUpdateLock > 0 then begin Dec(FUpdateLock); if FUpdateLock = 0 then CallAfterUpdate; end; end; function TKObject.UpdateUnlocked: Boolean; begin Result := FUpdateLock <= 0; end; { TKObjectList } constructor TKObjectList.Create; begin inherited; FUpdateLock := 0; end; function TKObjectList.Add(AObject: TObject): Integer; begin if AObject is TKObject then TKObject(AObject).Parent := Self; Result := inherited Add(AObject); end; procedure TKObjectList.Assign(ASource: TKObjectList); var I: Integer; Cls: TKObjectClass; SrcItem, DstItem: TKObject; begin if ASource <> nil then begin Clear; for I := 0 to ASource.Count - 1 do begin SrcItem := ASource.Items[I] as TKObject; Cls := TKObjectClass(SrcItem.ClassType); DstItem := Cls.Create; DstItem.Parent := Self; DstItem.Assign(SrcItem); Add(DstItem); end; end; end; procedure TKObjectList.CallBeforeUpdate; begin end; procedure TKObjectList.CallAfterUpdate; begin end; function TKObjectList.EqualProperties(AValue: TKObjectList): Boolean; var I: Integer; begin Result := False; if AValue <> nil then begin Result := AValue.Count = Count; if Result then begin for I := 0 to Count - 1 do if not TKObject(Items[I]).EqualProperties(TKObject(AValue[I])) then begin Result := False; Break; end; end; end; end; procedure TKObjectList.Insert(Index: Integer; AObject: TObject); begin if AObject is TKObject then TKObject(AObject).Parent := Self; inherited Insert(Index, AObject); end; procedure TKObjectList.LockUpdate; begin if FUpdateLock <= 0 then CallBeforeUpdate; Inc(FUpdateLock); end; procedure TKObjectList.UnLockUpdate; begin if FUpdateLock > 0 then begin Dec(FUpdateLock); if FUpdateLock = 0 then CallAfterUpdate; end; end; function TKObjectList.UpdateUnlocked: Boolean; begin Result := FUpdateLock <= 0; end; { TKPersistent } constructor TKPersistent.Create; begin inherited; FUpdateLock := 0; FChanged := False; end; procedure TKPersistent.Changed; begin if FUpdateLock = 0 then Update else FChanged := True; end; procedure TKPersistent.LockUpdate; begin Inc(FUpdateLock); FChanged := False; end; procedure TKPersistent.UnlockUpdate(ACallUpdate: Boolean); begin if FUpdateLock > 0 then begin Dec(FUpdateLock); if (FUpdateLock = 0) and FChanged and ACallUpdate then Update; end; end; function TKPersistent.UpdateUnlocked: Boolean; begin Result := FUpdateLock = 0; end; function AdjustDecimalSeparator(const S: string): string; var I: Integer; begin Result := S; for I := 1 to Length(Result) do if CharInSetEx(Result[I], [',', '.']) then Result[I] := GetFormatSettings.DecimalSeparator; end; function AnsiStringToString(const Text: AnsiString; CodePage: Cardinal): TKString; var {$IFDEF FPC} CP: string; {$ELSE} Len: Integer; {$ENDIF} begin {$IFDEF FPC} if CodePage = 0 then CP := 'ansi' else CP := Format('cp%d', [Codepage]); Result := LConvEncoding.ConvertEncoding(Text, CP, 'utf8'); {$ELSE} Len := MultiByteToWideChar(CodePage, 0, PAnsiChar(Text), -1, nil, 0); SetLength(Result, Len shr 1); MultiByteToWideChar(CodePage, 0, PAnsiChar(Text), -1, PWideChar(Result), Len); {$ENDIF} end; {$IFNDEF FPC} function AnsiStringToWideChar(const Text: AnsiString; CodePage: Cardinal): PWideChar; var Len: Integer; begin Len := MultiByteToWideChar(CodePage, 0, PAnsiChar(Text), -1, nil, 0); GetMem(Result, Len shl 1); MultiByteToWideChar(CodePage, 0, PAnsiChar(Text), -1, Result, Len); end; {$ENDIF} function BinarySearch(AData: Pointer; ACount: Integer; KeyPtr: Pointer; ACompareProc: TBsCompareProc; ASortedDown: Boolean): Integer; var Lo, Hi, Index, Ret: Integer; begin Result := -1; Lo := 0; Hi := ACount - 1; repeat Index := (Lo + Hi) div 2; Ret := ACompareProc(AData, Index, KeyPtr); if ASortedDown and (Ret < 0) or not ASortedDown and (Ret > 0) then Hi := Index - 1 else Lo := Index + 1 until (Lo > Hi) or (Ret = 0); if Ret = 0 then Result := Index; end; function CharInSetEx(AChar: AnsiChar; const ASet: TKSysCharSet): Boolean; begin Result := AChar in ASet; end; function CharInSetEx(AChar: WideChar; const ASet: TKSysCharSet): Boolean; begin Result := (Ord(AChar) < $100) and {$IFDEF COMPILER12_UP} CharInSet(AChar, ASet); {$ELSE} (AnsiChar(AChar) in ASet); {$ENDIF} end; function CompareIntegers(I1, I2: Integer): Integer; begin if I1 > I2 then Result := 1 else if I1 < I2 then Result := -1 else Result := 0; end; function CompareWideChars(W1, W2: PWideChar{$IFDEF USE_WIDEWINPROCS}; Locale: Cardinal{$ENDIF}): Integer; begin if (W1 = nil) or (W2 = nil) then begin if W1 <> nil then Result := 1 else if W2 <> nil then Result := -1 else Result := 0; end else begin {$IFDEF USE_WIDEWINPROCS} Result := WideWinProcs.CompareString(Locale, 0, W1, -1, W2, -1); Dec(Result, 2); {$ELSE} Result := WideCompareStr(WideString(W1), WideString(W2)); {$ENDIF} end; end; {$IFDEF STRING_IS_UNICODE} function CompareChars(S1, S2: PChar{$IFDEF USE_WIDEWINPROCS}; Locale: Cardinal{$ENDIF}): Integer; begin if (S1 = nil) or (S2 = nil) then begin if S1 <> nil then Result := 1 else if S2 <> nil then Result := -1 else Result := 0; end else begin {$IFDEF USE_WIDEWINPROCS} Result := WideWinProcs.CompareString(Locale, 0, PWideChar(S1), -1, PWideChar(S2), -1); Dec(Result, 2); {$ELSE} Result := CompareStr(string(S1), string(S2)); {$ENDIF} end; end; {$ENDIF} function CompareWideStrings(W1, W2: WideString{$IFDEF USE_WIDEWINPROCS}; Locale: Cardinal{$ENDIF}): Integer; begin {$IFDEF USE_WIDEWINPROCS} Result := WideWinProcs.CompareString(Locale, 0, PWideChar(W1), -1, PWideChar(W2), -1); Dec(Result, 2); {$ELSE} Result := WideCompareStr(W1, W2); {$ENDIF} end; {$IFDEF STRING_IS_UNICODE} function CompareStrings(S1, S2: string{$IFDEF USE_WIDEWINPROCS}; Locale: Cardinal{$ENDIF}): Integer; begin {$IFDEF USE_WIDEWINPROCS} Result := WideWinProcs.CompareString(Locale, 0, PWideChar(S1), -1, PWideChar(S2), -1); Dec(Result, 2); {$ELSE} Result := CompareStr(S1, S2); {$ENDIF} end; {$ENDIF} procedure ConvertTabsToSpaces(var AText: TKString; ASpacesForTab: Integer); var TabCount: Integer; S: TKString; I, J, K: Integer; begin if ASpacesForTab >= 0 then begin TabCount := GetCharCount(AText, cTAB); if TabCount > 0 then begin SetLength(S, Length(AText) + (ASpacesForTab - 1) * TabCount); J := 1; for I := 1 to Length(AText) do begin if AText[I] = cTAB then begin for K := 0 to ASpacesForTab - 1 do begin S[J] := cSPACE; Inc(J); end; end else begin S[J] := AText[I]; Inc(J); end; end; AText := S; end; end; end; function CreateMultipleDir(const Dir: string): Boolean; var I: Integer; T: string; begin for I := 1 to Length(Dir) do begin if CharInSetEx(Dir[I], ['/', '\']) then begin T := Copy(Dir, 1, I - 1); if not (DirectoryExists(T) or CreateDir(T)) then Break; end; end; if not DirectoryExists(Dir) then CreateDir(Dir); Result := DirectoryExists(Dir); end; function DigitToNibble(Digit: AnsiChar; var Nibble: Byte): Boolean; begin Result := True; if (Digit >= '0') and (Digit <= '9') then Nibble := Ord(Digit) - Ord('0') else if (Digit >= 'a') and (Digit <= 'f') then Nibble := Ord(Digit) - Ord('a') + 10 else if (Digit >= 'A') and (Digit <= 'F') then Nibble := Ord(Digit) - Ord('A') + 10 else Result := False; end; function DivUp(Dividend, Divisor: Integer): Integer; begin if Divisor = 0 then Result := 0 else if Dividend mod Divisor > 0 then Result := Dividend div Divisor + 1 else Result := Dividend div Divisor; end; function DivUp64(Dividend, Divisor: Int64): Int64; begin if Divisor = 0 then Result := 0 else if Dividend mod Divisor > 0 then Result := Dividend div Divisor + 1 else Result := Dividend div Divisor; end; function DivDown(Dividend, Divisor: Integer): Integer; begin if Divisor = 0 then Result := 0 else if Dividend mod Divisor < 0 then Result := Dividend div Divisor - 1 else Result := Dividend div Divisor; end; function DivDown64(Dividend, Divisor: Int64): Int64; begin if Divisor = 0 then Result := 0 else if Dividend mod Divisor < 0 then Result := Dividend div Divisor - 1 else Result := Dividend div Divisor; end; procedure EnsureLastPathSlash(var APath: string); begin if APath <> '' then if not CharInSetEx(APath[Length(APath)], ['\', '/']) then APath := APath + cDirectoryDelimiter; end; function EnsureLastPathSlashFnc(const APath: string): string; begin Result := APath; EnsureLastPathSlash(Result); end; procedure Exchange(var Value1, Value2: ShortInt); var Tmp: ShortInt; begin Tmp := Value1; Value1 := Value2; Value2 := Tmp; end; procedure Exchange(var Value1, Value2: SmallInt); var Tmp: SmallInt; begin Tmp := Value1; Value1 := Value2; Value2 := Tmp; end; procedure Exchange(var Value1, Value2: Integer); var Tmp: Integer; begin Tmp := Value1; Value1 := Value2; Value2 := Tmp; end; procedure Exchange(var Value1, Value2: Int64); var Tmp: Int64; begin Tmp := Value1; Value1 := Value2; Value2 := Tmp; end; procedure Exchange(var Value1, Value2: Byte); var Tmp: Byte; begin Tmp := Value1; Value1 := Value2; Value2 := Tmp; end; procedure Exchange(var Value1, Value2: Word); var Tmp: Word; begin Tmp := Value1; Value1 := Value2; Value2 := Tmp; end; procedure Exchange(var Value1, Value2: Cardinal); var Tmp: Cardinal; begin Tmp := Value1; Value1 := Value2; Value2 := Tmp; end; {$IFDEF COMPILER10_UP } procedure Exchange(var Value1, Value2: UINT64); var Tmp: UINT64; begin Tmp := Value1; Value1 := Value2; Value2 := Tmp; end; {$ENDIF} procedure Exchange(var Value1, Value2: Single); var Tmp: Single; begin Tmp := Value1; Value1 := Value2; Value2 := Tmp; end; procedure Exchange(var Value1, Value2: Double); var Tmp: Double; begin Tmp := Value1; Value1 := Value2; Value2 := Tmp; end; {$IFNDEF FPC} procedure Exchange(var Value1, Value2: Extended); var Tmp: Extended; begin Tmp := Value1; Value1 := Value2; Value2 := Tmp; end; {$ENDIF} procedure Exchange(var Value1, Value2: Char); var Tmp: Char; begin Tmp := Value1; Value1 := Value2; Value2 := Tmp; end; function ExtractFileRawName(const APath: string): string; var I: Integer; begin Result := ExtractFileName(APath); I := Length(Result); while I > 1 do begin if Result[I] = '.' then begin SetLength(Result, I - 1); Break; end; Dec(I); end; end; procedure Error(const Msg: string); begin raise Exception.Create(Msg); end; function FormatCurrency(Value: Currency; const AFormat: TKCurrencyFormat): TKString; var Fmt: string; FS: TFormatSettings; begin if AFormat.UseThousandSep then begin FS.ThousandSeparator := AFormat.ThousandSep; Fmt := '%.*n'; end else Fmt := '%.*f'; FS.DecimalSeparator := AFormat.DecimalSep; case AFormat.CurrencyFormat of 0: Result := KFormat('%s' + Fmt, [AFormat.CurrencyString, AFormat.CurrencyDecimals, Value], FS); 1: Result := KFormat(Fmt + '%s', [AFormat.CurrencyDecimals, Value, AFormat.CurrencyString], FS); 2: Result := KFormat('%s ' + Fmt, [AFormat.CurrencyString, AFormat.CurrencyDecimals, Value], FS); else Result := KFormat(Fmt + ' %s', [AFormat.CurrencyDecimals, Value, AFormat.CurrencyString], FS); end; end; function GetAppVersion(const ALibName: string; out MajorVersion, MinorVersion, BuildNumber, RevisionNumber: Word): Boolean; var {$IFDEF FPC} Info: TVersionResource; Stream: TResourceStream; ResID: Integer; Res: TFPResourceHandle; {$ELSE} dwHandle, dwLen: DWORD; BufLen: Cardinal; lpData: LPTSTR; pFileInfo: ^VS_FIXEDFILEINFO; {$ENDIF} begin Result := False; {$IFDEF FPC} Info := TVersionResource.Create; try ResID := 1; // Defensive code to prevent failure if no resource available... Res := FindResource(HInstance, PChar(PtrInt(ResID)), PChar(RT_VERSION)); If Res = 0 Then Exit; Stream := TResourceStream.CreateFromID(HInstance, ResID, {$IFDEF LCLWinCE}PWideChar{$ELSE}PChar{$ENDIF}(RT_VERSION)); Try Info.SetCustomRawDataStream(Stream); MajorVersion := Info.FixedInfo.FileVersion[0]; MinorVersion := Info.FixedInfo.FileVersion[1]; BuildNumber := Info.FixedInfo.FileVersion[2]; RevisionNumber := Info.FixedInfo.FileVersion[3]; Info.SetCustomRawDataStream(nil); Finally Stream.Free; End; Result := True; finally Info.Free; end; {$ELSE} dwLen := GetFileVersionInfoSize(PChar(ALibName), dwHandle); if dwLen <> 0 then begin GetMem(lpData, dwLen); try if GetFileVersionInfo(PChar(ALibName), dwHandle, dwLen, lpData) then begin if VerQueryValue(lpData, '\\', Pointer(pFileInfo), BufLen) then begin MajorVersion := HIWORD(pFileInfo.dwFileVersionMS); MinorVersion := LOWORD(pFileInfo.dwFileVersionMS); BuildNumber := HIWORD(pFileInfo.dwFileVersionLS); RevisionNumber := LOWORD(pFileInfo.dwFileVersionLS); Result := True; end; end; finally FreeMem(lpData); end; end; {$ENDIF} end; function GetAppVersionString(const ALibName, ACodePage, AString: string; out AValue: string): Boolean; {$IFnDEF FPC} type TTranslation = packed record wLanguage: Word; wCodePage: Word; end; {$ENDIF} var {$IFDEF FPC} Info: TVersionResource; Stream: TResourceStream; ResID: Integer; Res: TFPResourceHandle; {$ELSE} dwHandle, dwLen: DWORD; BufLen: Cardinal; lpData: LPTSTR; pValue: Pointer; Translation: ^TTranslation; CP: string; Tmp: WideString; {$ENDIF} begin Result := False; {$IFDEF FPC} Info := TVersionResource.Create; try ResID := 1; // Defensive code to prevent failure if no resource available... Res := FindResource(HInstance, PChar(PtrInt(ResID)), PChar(RT_VERSION)); If Res = 0 Then Exit; Stream := TResourceStream.CreateFromID(HInstance, ResID, {$IFDEF LCLWinCE}PWideChar{$ELSE}PChar{$ENDIF}(RT_VERSION)); Try Info.SetCustomRawDataStream(Stream); if Info.StringFileInfo.Count > 0 then begin AValue := Info.StringFileInfo.Items[0].Values[AString]; Result := True; end; Info.SetCustomRawDataStream(nil); Finally Stream.Free; End; finally Info.Free; end; {$ELSE} dwLen := GetFileVersionInfoSize(PChar(ALibName), dwHandle); if dwLen <> 0 then begin GetMem(lpData, dwLen); try if GetFileVersionInfo(PChar(ALibName), dwHandle, dwLen, lpData) then begin if ACodePage = '' then begin // retrieve first codepage available if VerQueryValue(lpData, '\VarFileInfo\Translation', Pointer(Translation), BufLen) and (BufLen >= 4) then CP := Format('%4.4x%4.4x', [Translation.wLanguage, Translation.wCodePage]) else CP := ''; // error! end else CP := ACodePage; if (CP <> '') and (VerQueryValue(lpData, PChar(Format('\StringFileInfo\%s\%s', [CP, AString])), pValue, BufLen)) then begin SetString(Tmp, PChar(pValue), BufLen); AValue := string(Tmp); Result := True; end; end; finally FreeMem(lpData); end; end; {$ENDIF} end; function GetCharCount(const AText: TKString; AChar: TKChar): Integer; var I: Integer; begin Result := 0; for I := 1 to Length(AText) do if AText[I] = AChar then Inc(Result); end; function GetFormatSettings: TFormatSettings; begin {$IFDEF FPC} Result := FormatSettings; {$ELSE} {$IFDEF COMPILER15_UP} Result := TFormatSettings.Create; {$ELSE} GetLocaleFormatSettings(GetThreadLocale, Result); {$ENDIF} {$ENDIF} end; function IntToAscii(Value: Int64; Digits: Integer): string; var I: Integer; begin Result := ''; I := 0; while I < Digits do begin Result := Result + Chr(Value and $FF); Value := Value shr 8; Inc(I); end; end; function IntToBCD(Value: Cardinal): Cardinal; var Exp: Cardinal; begin Result := 0; Exp := 1; while (Value > 0) and (Exp > 0) do begin Result := Result + Value mod 10 * Exp; Value := Value div 10; Exp := Exp * 16; end; end; function IntToBinStr(Value: Int64; Digits: Integer; const Suffix: string): string; var B: Byte; C: Char; begin Result := ''; if Digits <> 0 then Digits := MinMax(Digits, 1, 64); repeat B := Byte(Value and $1); Value := Value shr 1; C := Chr(Ord('0') + B); Result := C + Result; until (Value = 0) or ((Digits <> 0) and (Length(Result) = Digits)); while Length(Result) < Digits do Result := '0' + Result; Result := Result + Suffix; end; function IntToDecStr(Value: Int64; Digits: Integer): string; var B: Byte; C: Char; Signum: Boolean; begin Result := ''; Signum := Value < 0; {if Signum then asm nop end;} repeat B := Byte(Value mod 10); if Signum then B := 256 - B; Value := Value div 10; C := Chr(Ord('0') + B); Result := C + Result; until Value = 0; while Length(Result) < Digits do Result := '0' + Result; if Signum then Result := '-' + Result; end; function UIntToDecStr(Value: UInt64; Digits: Integer): string; var B: Byte; C: Char; begin Result := ''; repeat B := Byte(Value mod 10); Value := Value div 10; C := Chr(Ord('0') + B); Result := C + Result; until Value = 0; while Length(Result) < Digits do Result := '0' + Result; end; function IntToHexStr(Value: Int64; Digits: Integer; const Prefix, Suffix: string; UseLowerCase: Boolean): string; var B: Byte; begin Result := ''; if Digits <> 0 then Digits := MinMax(Digits, 1, 16); repeat B := Byte(Value and $F); Value := Value shr 4; Result := Char(NibbleToDigit(B, not UseLowerCase)) + Result; until (Value = 0) or ((Digits <> 0) and (Length(Result) = Digits)); while Length(Result) < Digits do Result := '0' + Result; Result := Prefix + Result + Suffix; end; function IntToOctStr(Value: Int64): string; var B: Byte; C: Char; Signum: Boolean; begin if Value < 0 then begin Signum := True; Value := -Value; end else Signum := False; Result := ''; repeat B := Byte(Value mod 8); Value := Value div 8; C := Chr(Ord('0') + B); Result := C + Result; until Value = 0; Result := '0' + Result; if Signum then Result := '-' + Result; end; function IntToRoman(Value: Integer; AUpperCase: Boolean): string; begin Result := ''; while Value >= 1000 do begin Result := Result + 'M'; Value := Value - 1000; end; { while } if Value >= 900 then begin Result := Result + 'CM'; Value := Value - 900; end; { if } while Value >= 500 do begin Result := Result + 'D'; Value := Value - 500; end; { while } if Value >= 400 then begin Result := Result + 'CD'; Value := Value - 400; end; { if } while Value >= 100 do begin Result := Result + 'C'; Value := Value - 100; end; { while } if Value >= 90 then begin Result := Result + 'XC'; Value := Value - 90; end; { if } while Value >= 50 do begin Result := Result + 'L'; Value := Value - 50; end; { while } if Value >= 40 then begin Result := Result + 'XL'; Value := Value - 40; end; { while } while Value >= 10 do begin Result := Result + 'X'; Value := Value - 10; end; { while } if Value >= 9 then begin Result := Result + 'IX'; Value := Value - 9; end; { if } while Value >= 5 do begin Result := Result + 'V'; Value := Value - 5; end; { while } if Value >= 4 then begin Result := Result + 'IV'; Value := Value - 4; end; { if } while Value > 0 do begin Result := Result + 'I'; Dec(Value); end; { while } if not AUpperCase then Result := LowerCase(Result); end; function IntToLatin(Value: Integer; AUpperCase: Boolean): string; var OrdA: Integer; begin Result := ''; if AUpperCase then OrdA := Ord('A') else OrdA := Ord('a'); while Value > 0 do begin Result := Chr(Value mod 26 + OrdA - 1) + Result; Value := Value div 26; end; end; function IntPowerInt(Value: Int64; Exponent: Integer): Int64; begin Result := Value; while Exponent > 1 do begin Result := Result * Value; Dec(Exponent); end; end; function AsciiToInt(S: string; Digits: Integer): Int64; var I: Integer; begin Result := 0; I := Min(Length(S), Digits); while I > 0 do begin Result := Result shl 8; Result := Ord(S[I]) + Result; Dec(I); end; end; function BCDToInt(Value: Cardinal): Cardinal; var Exp: Cardinal; begin Result := 0; Exp := 1; while Value > 0 do begin Result := Result + Min(Value and 15, 9) * Exp; Value := Value shr 4; Exp := Exp * 10; end; end; function BinStrToInt(S: string; Digits: Integer; Signed: Boolean; var Code: Integer): Int64; var I, L, Len: Integer; N: Byte; C: Char; M: Int64; begin Result := 0; Code := 0; L := 0; Len := Length(S); if (Digits = 0) or (Digits > 64) then Digits := 64; if (Len >= 1) and CharInSetEx(S[Len], ['b', 'B']) then begin Delete(S, Len, 1); Dec(Len); end; I := 1; while I <= Len do begin C := S[I]; N := 255; if (C >= '0') and (C <= '1') then N := Ord(C) - Ord('0'); if N > 1 then begin Code := I; Break; end else if (N > 0) or (Result <> 0) then begin if L >= Digits then begin Code := I; Break; end; Result := Result shl 1; Inc(Result, N); Inc(L); end; Inc(I); end; if Signed and (Digits < 64) then begin M := Int64(1) shl Digits; if Result >= M shr 1 - 1 then Dec(Result, M); end; end; function DecStrToInt(S: string; var Code: Integer): Int64; var I, Len: Integer; N: Byte; C: Char; Minus: Boolean; begin Result := 0; Code := 0; Len := Length(S); Minus := S[1] = '-'; if Minus then I := 2 else I := 1; while I <= Len do begin C := S[I]; N := 255; if (C >= '0') and (C <= '9') then N := Ord(C) - Ord('0'); if N > 9 then begin Code := I; Break; end else if (N > 0) or (Result <> 0) then begin Result := Result * 10; Inc(Result, N); end; Inc(I); end; if Minus then Result := -Result; end; function HexStrToInt(S: string; Digits: Integer; Signed: Boolean; var Code: Integer): Int64; var I, L, Len: Integer; N: Byte; C: AnsiChar; M: Int64; begin Result := 0; Code := 0; L := 0; Len := Length(S); if (Digits = 0) or (Digits > 16) then Digits := 16; if (Len >= 2) and (AnsiChar(S[1]) = '0') and CharInSetEx(S[2], ['x', 'X']) then I := 3 else if (Len >= 1) and CharInSetEx(S[1], ['x', 'X', '$']) then I := 2 else I := 1; while I <= Len do begin C := AnsiChar(S[I]); N := 255; DigitToNibble(C, N); if N > 15 then begin if CharInSetEx(C, ['h', 'H']) then begin if Len > I then Code := I + 1; end else Code := I; Break; end else if (N > 0) or (Result <> 0) then begin if L >= Digits then begin Code := I; Break; end; Result := Result shl 4; Inc(Result, N); Inc(L); end; Inc(I); end; if Signed and (Digits < 16) then begin M := Int64(1) shl (Digits shl 2); if Result >= M shr 1 - 1 then Dec(Result, M); end; end; function OctStrToInt(S: string; var Code: Integer): Int64; var I, Len: Integer; N: Byte; C: Char; Minus: Boolean; begin Result := 0; Code := 0; Len := Length(S); Minus := S[1] = '-'; if Minus then I := 2 else I := 1; while I <= Len do begin C := S[I]; N := 255; if (C >= '0') and (C <= '7') then N := Ord(C) - Ord('0'); if N > 7 then begin Code := I; Break; end else if (N > 0) or (Result <> 0) then begin Result := Result * 8; Inc(Result, N); end; Inc(I); end; if Minus then Result := -Result; end; function KFormat(const Format: string; const Args: array of const; const AFormatSettings: TFormatSettings): string; begin Result := SysUtils.Format(Format, Args, AFormatSettings); end; function KFormat(const Format: WideString; const Args: array of const; const AFormatSettings: TFormatSettings): WideString; begin Result := SysUtils.WideFormat(Format, Args, AFormatSettings); end; function MakeCellSpan(AColumns, ARows: Integer): TKCellSpan; begin Result.ColSpan := AColumns; Result.RowSpan := ARows; end; function MinMax(Value, Min, Max: ShortInt): ShortInt; begin if Max < Min then Exchange(Min, Max); if Value <= Max then if Value >= Min then Result := Value else Result := Min else Result := Max; end; function MinMax(Value, Min, Max: SmallInt): SmallInt; begin if Max < Min then Exchange(Min, Max); if Value <= Max then if Value >= Min then Result := Value else Result := Min else Result := Max; end; function MinMax(Value, Min, Max: Integer): Integer; begin if Max < Min then Exchange(Min, Max); if Value <= Max then if Value >= Min then Result := Value else Result := Min else Result := Max; end; function MinMax(Value, Min, Max: Int64): Int64; begin if Max < Min then Exchange(Min, Max); if Value <= Max then if Value >= Min then Result := Value else Result := Min else Result := Max; end; function MinMax(Value, Min, Max: Single): Single; begin if Max < Min then Exchange(Min, Max); if Value <= Max then if Value >= Min then Result := Value else Result := Min else Result := Max; end; function MinMax(Value, Min, Max: Double): Double; begin if Max < Min then Exchange(Min, Max); if Value <= Max then if Value >= Min then Result := Value else Result := Min else Result := Max; end; {$IFNDEF FPC} function MinMax(Value, Min, Max: Extended): Extended; begin if Max < Min then Exchange(Min, Max); if Value <= Max then if Value >= Min then Result := Value else Result := Min else Result := Max; end; {$ENDIF} function MakeDataSize(AData: Pointer; ASize: Integer): TDataSize; begin Result.Data := AData; Result.Size := ASize; end; function NibbleToDigit(Nibble: Byte; UpperCase: Boolean): AnsiChar; begin if Nibble < 10 then Result := AnsiChar(Ord('0') + Nibble) else if UpperCase then Result := AnsiChar(Ord('A') + Nibble - 10) else Result := AnsiChar(Ord('a') + Nibble - 10); end; procedure QuickSortNR(AData: Pointer; ACount: Integer; ACompareProc: TQsCompareProc; AExchangeProc: TQsExchangeProc; ASortedDown: Boolean); type TStackItem = record LIndex, RIndex: Integer; end; const cStackGrow = 100; var Key, Left, Right, L, R, LBack, RBack, StackLen, StackPtr: Integer; Stack: array of TStackItem; begin { this is the non recursive quick sort algorithm to avoid stack overflows. Right parts of divided arrays are stored into a stack-like array in dynamic memory for later use. } Left := 0; Right := ACount - 1; SetLength(Stack, cStackGrow); StackPtr := 0; with Stack[StackPtr] do begin LIndex := Left; RIndex := Right end; repeat with Stack[StackPtr] do begin Left := LIndex; Right := RIndex end; Dec(StackPtr); repeat L := Left; R := Right; Key := (L + R) div 2; LBack := Left - 1; RBack := Right; repeat if ASortedDown then begin while (L < Right) and (ACompareProc(AData, L, Key) < 0) do Inc(L); while (R > Left) and (ACompareProc(AData, R, Key) > 0) do Dec(R); end else begin while (L < Right) and (ACompareProc(AData, L, Key) > 0) do Inc(L); while (R > Left) and (ACompareProc(AData, R, Key) < 0) do Dec(R); end; if L <= R then begin if L < R then if (L = Key) or (R = Key) then begin // preserve Key, exchange later LBack := L; RBack := R; end else AExchangeProc(AData, L, R); Dec(R); Inc(L); end; until L >= R; // exchange anything with former Key if LBack >= Left then AExchangeProc(AData, LBack, RBack); if L < Right then begin Inc(StackPtr); StackLen := Length(Stack); if StackPtr >= StackLen then SetLength(Stack, StackLen + cStackGrow); with Stack[StackPtr] do begin LIndex := L; RIndex := Right end; end; Right := R; until Left >= Right; until StackPtr < 0; end; procedure QuickSort(AData: Pointer; ACount: Integer; ACompareProc: TQsCompareProc; AExchangeProc: TQsExchangeProc; ASortedDown: Boolean); procedure Sort(const Left, Right: Integer); var Key, L, R, LBack, RBack: Integer; begin Key := (Left + Right) div 2; L := Left; R := Right; LBack := Left - 1; RBack := Right; repeat if ASortedDown then begin while (L < Right) and (ACompareProc(AData, L, Key) < 0) do Inc(L); while (R > Left) and (ACompareProc(AData, R, Key) > 0) do Dec(R); end else begin while (L < Right) and (ACompareProc(AData, L, Key) > 0) do Inc(L); while (R > Left) and (ACompareProc(AData, R, Key) < 0) do Dec(R); end; if L <= R then begin if L < R then if (L = Key) or (R = Key) then begin // preserve Key, exchange later LBack := L; RBack := R; end else AExchangeProc(AData, L, R); Inc(L); Dec(R); end; until L >= R; // exchange anything with former Key if LBack >= Left then AExchangeProc(AData, LBack, RBack); if Left < R then Sort(Left, R); if L < Right then Sort(L, Right); end; begin if ACount > 1 then Sort(0, ACount - 1); end; procedure OffsetPoint(var APoint: TPoint; AX, AY: Integer); begin Inc(APoint.X, AX); Inc(APoint.Y, AY); end; procedure OffsetPoint(var APoint: TPoint; const AOffset: TPoint); begin Inc(APoint.X, AOffset.X); Inc(APoint.Y, AOffset.Y); end; function NormalizeRect(const ARect: TRect): TRect; begin Result := ARect; if Result.Left > Result.Right then Exchange(Result.Left, Result.Right); if Result.Top > Result.Bottom then Exchange(Result.Top, Result.Bottom); end; function Point64(AX, AY: Int64): TKPoint64; begin Result.X:= AX; Result.Y:= AY; end; function PointToPoint64(const APoint: TPoint): TKPoint64; begin Result.X:= APoint.x; Result.Y:= APoint.y; end; function Point64ToPoint(const APoint: TKPoint64): TPoint; begin Result.X:= Integer(APoint.X); Result.Y:= Integer(APoint.Y); end; function Pt64InRect(const ARect: TRect; const APoint: TKPoint64): Boolean; begin Result := (APoint.X >= ARect.Left) and (APoint.X < ARect.Right) and (APoint.Y >= ARect.Top) and (APoint.Y < ARect.Bottom); end; function Rect64(ALeft, ATop, ARight, ABottom: Int64): TKRect64; begin Result.Left:= ALeft; Result.Top:= ATop; Result.Right:= ARight; Result.Bottom:= ABottom; end; function RectInRect(Bounds, Rect: TRect): Boolean; begin Result := (Rect.Left < Bounds.Right) and (Rect.Right >= Bounds.Left) and (Rect.Top < Bounds.Bottom) and (Rect.Bottom >= Bounds.Top); end; function RectInRectFully(Bounds, Rect: TRect): Boolean; begin Result := (Rect.Left >= Bounds.Left) and (Rect.Right <= Bounds.Right) and (Rect.Top >= Bounds.Top) and (Rect.Bottom <= Bounds.Bottom); end; procedure OffsetRect(var ARect: TRect; AX, AY: Integer); begin Inc(ARect.Left, AX); Inc(ARect.Top, AY); Inc(ARect.Right, AX); Inc(ARect.Bottom, AY); end; procedure OffsetRect(var ARect: TRect; const AOffset: TPoint); begin Inc(ARect.Left, AOffset.X); Inc(ARect.Top, AOffset.Y); Inc(ARect.Right, AOffset.X); Inc(ARect.Bottom, AOffset.Y); end; procedure StripLastPathSlash(var APath: string); begin if APath <> '' then if CharInSetEx(APath[Length(APath)], ['\', '/']) then Delete(APath, Length(APath), 1); end; function StripLastPathSlashFnc(const APath: string): string; begin Result := APath; StripLastPathSlash(Result); end; function StrNextCharIndex(const AText: TKString; Index: Integer): Integer; begin {$IFDEF FPC} Result := Index + LazUTF8.UTF8CharacterLength(@AText[Index]); {$ELSE} if (Word(AText[Index]) >= cUTF16FirstSurrogateBegin) and (Word(AText[Index]) <= cUTF16FirstSurrogateEnd) then Result := Index + 2 else Result := Index + 1; {$ENDIF} end; function StrPreviousCharIndex(const AText: TKString; Index: Integer): Integer; begin {$IFDEF FPC} Result := Index - LazUTF8.UTF8CharacterLength(@AText[StringCharBegin(AText, Index - 1)]); {$ELSE} if (Word(AText[Index - 1]) >= cUTF16SecondSurrogateBegin) and (Word(AText[Index - 1]) <= cUTF16SecondSurrogateEnd) then Result := Index - 2 else Result := Index - 1; {$ENDIF} end; function StrByteIndexToCPIndex(const AText: TKString; ByteIndex: Integer): Integer; var I: Integer; begin Result := 0; I := 1; while I < ByteIndex do begin {$IFDEF FPC} Inc(I, LazUTF8.UTF8CharacterLength(@AText[I])); {$ELSE} if (Word(AText[I]) >= cUTF16FirstSurrogateBegin) or (Word(AText[I]) > cUTF16FirstSurrogateEnd) then Inc(I, 2) else Inc(I); {$ENDIF} Inc(Result); end; end; function StrCPIndexToByteIndex(const AText: TKString; CPIndex: Integer): Integer; var I: Integer; begin Result := 0; for I := 1 to CPIndex do begin {$IFDEF FPC} Inc(Result, LazUTF8.UTF8CharacterLength(@AText[Result])); {$ELSE} if (Word(AText[Result]) >= cUTF16FirstSurrogateBegin) and (Word(AText[Result]) <= cUTF16FirstSurrogateEnd) then Inc(Result, 2) else Inc(Result); {$ENDIF} if Result > Length(AText) then Break; end; end; function StringCharBegin(const AText: TKString; Index: Integer): Integer; begin {$IFDEF FPC} Result := LazUTF8.UTF8CharToByteIndex(PChar(AText), Length(AText), Index) {$ELSE} if (Word(AText[Index - 1]) >= cUTF16SecondSurrogateBegin) and (Word(AText[Index - 1]) <= cUTF16SecondSurrogateEnd) then Result := Index - 1 else Result := Index {$ENDIF} end; function StringLength(const AText: TKString): Integer; var I: Integer; begin {$IFDEF FPC} Result := LazUTF8.UTF8Length(AText) {$ELSE} Result := 0; for I := 1 to Length(AText) do if (Word(AText[I]) < cUTF16SecondSurrogateBegin) or (Word(AText[I]) > cUTF16SecondSurrogateEnd) then Inc(Result); {$ENDIF} end; function StringCopy(const ASource: TKString; At, Count: Integer): TKString; {$IFnDEF FPC} var ByteFrom, ByteTo: Integer; {$ENDIF} begin {$IFDEF FPC} Result := UTF8Copy(ASource, At, Count); {$ELSE} ByteFrom := StrCPIndexToByteIndex(ASource, At); ByteTo := StrCPIndexToByteIndex(ASource, At + Count); Result := Copy(ASource, ByteFrom, ByteTo - ByteFrom); {$ENDIF} end; procedure StringDelete(var ASource: TKString; At, Count: Integer); {$IFnDEF FPC} var ByteFrom, ByteTo: Integer; {$ENDIF} begin {$IFDEF FPC} LazUTF8.UTF8Delete(ASource, At, Count); {$ELSE} ByteFrom := StrCPIndexToByteIndex(ASource, At); ByteTo := StrCPIndexToByteIndex(ASource, At + Count); Delete(ASource, ByteFrom, ByteTo - ByteFrom); {$ENDIF} end; procedure TrimWhiteSpaces(const AText: TKString; var AStart, ALen: Integer; const ASet: TKSysCharSet); begin while (ALen > 0) and CharInSetEx(AText[AStart], ASet) do begin Inc(AStart); Dec(ALen); end; while (ALen > 0) and CharInSetEx(AText[AStart + ALen - 1], ASet) do Dec(ALen); end; procedure TrimWhiteSpaces(var AText: TKString; const ASet: TKSysCharSet); begin while (Length(AText) > 0) and CharInSetEx(AText[1], ASet) do Delete(AText, 1, 1); while (Length(AText) > 0) and CharInSetEx(AText[Length(AText)], ASet) do Delete(AText, Length(AText), 1); end; {$IFNDEF FPC} procedure TrimWhiteSpaces(var AText: AnsiString; const ASet: TKSysCharSet); begin while (Length(AText) > 0) and CharInSetEx(AText[1], ASet) do Delete(AText, 1, 1); while (Length(AText) > 0) and CharInSetEx(AText[Length(AText)], ASet) do Delete(AText, Length(AText), 1); end; {$ENDIF} function StringToAnsiString(const AText: TKString; CodePage: Cardinal): AnsiString; var {$IFDEF FPC} CP: string; {$ELSE} Len: Integer; W: WideString; DefaultChar: AnsiChar; {$ENDIF} begin {$IFDEF FPC} if CodePage = 0 then CP := 'ansi' else CP := Format('cp%d', [Codepage]); Result := LConvEncoding.ConvertEncoding(AText, 'utf8', CP); {$ELSE} if AText <> '' then begin DefaultChar := #0; W := WideString(AText); Len := WideCharToMultiByte(CodePage, 0, PWideChar(W), -1, nil, 0, @DefaultChar, nil); SetLength(Result, Len - 1); WideCharToMultiByte(CodePage, 0, PWideChar(W), -1, PAnsiChar(Result), Len, @DefaultChar, nil); end else Result := ''; {$ENDIF} end; function StringToUTF8(const AText: string): AnsiString; begin {$IFDEF FPC} Result := AText; {$ELSE} Result := UTF8Encode(AText); {$ENDIF} end; function StringToChar(const AText: TKString; AIndex: Integer): TKChar; begin {$IFDEF FPC} Result := LazUTF8.UTF8Copy(AText, AIndex, 1); {$ELSE} Result := AText[AIndex]; {$ENDIF} end; {$IFDEF MSWINDOWS} function GetWindowsFolder(CSIDL: Cardinal; var APath: string): Boolean; type TSHGetFolderPathProc = function(hWnd: HWND; CSIDL: Integer; hToken: THandle; dwFlags: DWORD; pszPath: PAnsiChar): HResult; stdcall; var SHFolderHandle: HMODULE; SHGetFolderPathProc: TSHGetFolderPathProc; Buffer: PAnsiChar; begin Result := False; APath := ''; SHFolderHandle := GetModuleHandle(SHFolderDll); if SHFolderHandle <> 0 then begin SHGetFolderPathProc := GetProcAddress(SHFolderHandle, 'SHGetFolderPathA'); if Assigned(SHGetFolderPathProc) then begin GetMem(Buffer, MAX_PATH); try if Succeeded(SHGetFolderPathProc(0, CSIDL, 0, 0, Buffer)) then begin APath := string(Buffer); Result := True; end finally FreeMem(Buffer); end; end; end; end; function RunExecutable(const AFileName: string; AWaitForIt: Boolean): DWORD; var StartupInfo: TStartupInfo; ProcessInfo: TProcessInformation; ErrMsg: PChar; begin Result := STILL_ACTIVE; GetStartupInfo(StartupInfo); if CreateProcess(nil, PChar(AFileName), nil, nil, IsConsole, NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo) then begin try if (not AWaitForIt) or (WaitForSingleObject(ProcessInfo.hProcess,INFINITE) = WAIT_OBJECT_0) then GetExitCodeProcess(ProcessInfo.hProcess, Result); finally CloseHandle(ProcessInfo.hThread); CloseHandle(ProcessInfo.hProcess); end; end else begin if FormatMessage(Format_Message_Allocate_Buffer or Format_Message_From_System, nil, GetLastError, 0, @errMsg, 0, nil) <> 0 then begin try Error('CreateProcess failed with error "' + String (errMsg) + '".'); finally LocalFree (HLOCAL(errMsg)); end; end; end; end; {$ENDIF} function SystemCodePage: Integer; begin {$IFDEF MSWINDOWS} Result := getACP; {$ELSE} {$IF DEFINED(UNIX) and (FPC_FULLVERSION>=20701)} Result := GetSystemCodepage; {$ELSE} Result := 0; {$IFEND} {$ENDIF} end; function NativeUTFToUnicode(const AText: TKString): WideChar; {$IFDEF FPC} var CharLen: Integer; {$ENDIF} begin {$IFDEF FPC} Result := WideChar(LazUTF8.UTF8CharacterToUnicode(PChar(AText), CharLen)); {$ELSE} Result := AText[1]; {$ENDIF} end; function UnicodeUpperCase(const AText: TKString): TKString; begin {$IFDEF FPC} Result := LazUTF8.UTF8UpperCase(AText); {$ELSE} {$IFDEF STRING_IS_UNICODE} Result := AnsiUpperCase(AText); {$ELSE} Result := WideUpperCase(AText); {$ENDIF} {$ENDIF} end; function UnicodeLowerCase(const AText: TKString): TKString; begin {$IFDEF FPC} Result := LazUTF8.UTF8LowerCase(AText); {$ELSE} {$IFDEF STRING_IS_UNICODE} Result := AnsiLowerCase(AText); {$ELSE} Result := WideLowerCase(AText); {$ENDIF} {$ENDIF} end; function UnicodeToNativeUTF(const AParam: WideChar): TKString; begin {$IFDEF FPC} Result := LazUTF8.UnicodeToUTF8(Cardinal(AParam)); {$ELSE} Result := AParam; {$ENDIF} end; function UnicodeStringReplace(const AText, AOldPattern, ANewPattern: TKString; AFlags: TReplaceFlags): TKString; var SearchStr, Pattern, Candidate: TKString; I, NewI, PatternLen, SearchLen: Integer; DoInc, Found: Boolean; begin Result := ''; if rfIgnoreCase in AFlags then begin SearchStr := UnicodeUpperCase(AText); Pattern := UnicodeUpperCase(AOldPattern); end else begin SearchStr := AText; Pattern := AOldPattern; end; PatternLen := Length(Pattern); SearchLen := Length(SearchStr); Found := False; I := 1; while (I <= SearchLen) do begin DoInc := True; if (rfReplaceAll in AFlags) or not Found then begin if SearchStr[I] = Pattern[1] then begin Candidate := Copy(SearchStr, I, PatternLen); if Candidate = Pattern then begin Result := Result + ANewPattern; Inc(I, PatternLen); DoInc := False; Found := True; end; end; end; if DoInc then begin NewI := StrNextCharIndex(SearchStr, I); Result := Result + Copy(SearchStr, I, NewI - I); I := NewI; end; end; end; function UTF8ToString(const AText: AnsiString): string; begin {$IFDEF FPC} Result := AText; {$ELSE} {$IFDEF COMPILER12_UP} Result := System.UTF8ToString(AText); {$ELSE} Result := System.UTF8Decode(AText); {$ENDIF} {$ENDIF} end; function MakeHexDigitPosition(Index: Int64; Digit: Integer): TKHexDigitPosition; begin Result.Index := Index; Result.Digit := Digit; end; function DigitToBin(Value: AnsiChar): Integer; begin if ((Value >= 'a') and (Value <= 'f')) then Result := Ord(Value) - Ord('a') + 10 else if ((Value >= 'A') and (Value <= 'F')) then Result := Ord(Value) - Ord('A') + 10 else if ((Value >= '0') and (Value <= '9')) then Result := Ord(Value) - Ord('0') else Result := -1; end; function DigitsToBinStr(var S: AnsiString; Convert: Boolean = True): Boolean; var I, J, K: Integer; T: AnsiString; begin // check and convert text characters to hex values 0..15 Result := True; if Convert then SetLength(T, Length(S)); J := 0; for I := 1 to Length(S) do if not CharInSetEx(S[I], [cTAB, cSPACE]) then begin K := DigitToBin(S[I]); if K >= 0 then begin if Convert then begin Inc(J); T[J] := AnsiChar(K) end; end else begin Result := False; Break; end; end; if Result and Convert then begin SetLength(T, J); S := T; end; end; function BinStrToBinary(const S: AnsiString): AnsiString; var I, J, L: Integer; B1, B2: Byte; begin L := Length(S); Result := ''; if L > 0 then begin SetLength(Result, DivUp(L, 2)); if L = 1 then Result := S else begin J := 1; for I := 1 to Length(Result) do begin B1 := Byte(S[J]); Inc(J); if J <= L then begin B2 := Byte(S[J]); Inc(J); end else B2 := 0; Result[I] := AnsiChar(B1 shl 4 + B2); end; end; end; end; function BinToDigit(Value: Byte): AnsiChar; begin if Value >= $10 then Result := '0' else if Value >= $A then Result := AnsiChar(Ord('A') + Value - 10) else Result := AnsiChar(Ord('0') + Value) end; function BinaryToDigits(Buffer: PBytes; SelStart, SelEnd: TKHexDigitPosition; AInsertSpaces: Boolean): AnsiString; var I, J, SpaceCount: Integer; begin if AInsertSpaces then SpaceCount := SelEnd.Index - SelStart.Index else SpaceCount := 0; SetLength(Result, (SelEnd.Index - SelStart.Index) * cHexDigitCount - SelStart.Digit + SelEnd.Digit + SpaceCount); J := 1; for I := SelStart.Index to SelEnd.Index do begin if ((I > SelStart.Index) or (SelStart.Digit < 1)) and ((I < SelEnd.Index) or (SelEnd.Digit > 0)) then begin Result[J] := BinToDigit((Buffer[I] shr 4) and $F); Inc(J); end; if ((I > SelStart.Index) or (SelStart.Digit < 2)) and ((I < SelEnd.Index) or (SelEnd.Digit > 1)) then begin Result[J] := BinToDigit(Buffer[I] and $F); Inc(J); end; if AInsertSpaces and (I < SelEnd.Index) then begin Result[J] := ' '; Inc(J); end; end; end; function BinaryToDigits(Buffer: PBytes; ASize: Int64; AInsertSpaces: Boolean = False): AnsiString; begin Result := BinaryToDigits(Buffer, MakeHexDigitPosition(0, 0), MakeHexDigitPosition(ASize - 1, cHexDigitCount), AInsertSpaces); end; function BinaryToDigits(const Source: AnsiString; AInsertSpaces: Boolean): AnsiString; begin Result := BinaryToDigits(PBytes(@Source[1]), MakeHexDigitPosition(0, 0), MakeHexDigitPosition(Length(Source) - 1, cHexDigitCount), AInsertSpaces); end; function BinStrToDigits(const Source: AnsiString; AInsertSpaces: Boolean): AnsiString; var I, J, CharLen, SpaceCount: Integer; begin CharLen := Length(Source) div 2; if AInsertSpaces then SpaceCount := CharLen - 1 else SpaceCount := 0; SetLength(Result, CharLen * 2 + SpaceCount); J := 1; for I := 1 to CharLen do begin Result[J] := BinToDigit(Ord(Source[I * 2 - 1])); Inc(J); Result[J] := BinToDigit(Ord(Source[I * 2])); Inc(J); if AInsertSpaces and (I < CharLen) then begin Result[J] := ' '; Inc(J); end; end; end; function InsertSpacesToDigits(const Source: AnsiString): AnsiString; var I, J, CharLen, SpaceCount: Integer; begin CharLen := Length(Source) div 2; SpaceCount := CharLen - 1; SetLength(Result, CharLen * 2 + SpaceCount); J := 1; for I := 1 to CharLen do begin Result[J] := Source[I * 2 - 1]; Inc(J); Result[J] := Source[I * 2]; Inc(J); if I < CharLen then begin Result[J] := ' '; Inc(J); end; end; end; function ReplaceDigit(Value, Digit, Pos: Integer): Integer; var I, Mask, O: Integer; begin O := 1; for I := Pos to cHexDigitCount - 2 do O := O * cHexBase; Mask := cHexBase - 1; Result := (((Value div O) and not Mask) + (Digit and Mask)) * O + Value mod O; end; end. tomboy-ng_0.34-1/kcontrols/source/kprintpreview.dfm0000644000175000017500000014330114125207534022337 0ustar dbannondbannonobject KCustomPrintPreviewForm: TKCustomPrintPreviewForm Left = 324 Top = 212 Caption = 'Print Preview' ClientHeight = 614 ClientWidth = 812 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] Icon.Data = { 0000010001001010000001002000680400001600000028000000100000002000 000001002000000000000004000000000000000000000000000000000000FFFF FF005F5E5FFF5F5E5FFF5F5E5FFF5F5E5FFF5F5E5FFF5F5E5FFF5F5E5FFF5F5E 5FFF5F5E5FFF5F5E5FFF5F5E5F9F00000000B779329FB779329F00000000FFFF FF005F5E5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFB779329FB77932FFB77932FFB779329FFFFF FF005F5E5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFE8D5BEFFC089 4BFFB77932FFB77932FFBB813EFFB77932FFB77932FFB77932FFB779329FFFFF FF005F5E5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFE8D5BEFFB77932FFBE88 49FFD5B591FFD5B591FFBE8849FFB77932FFB77932FFB779329F00000000FFFF FF005F5E5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0894BFFBE8849FFF0EA E4FFF4F2F0FFF4F2F0FFF0EAE4FFBE8849FFB77932EF0000000000000000FFFF FF005F5E5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFB77932FFD5B591FFF4F2 F0FFF4F2F0FFF4F2F0FFF4F2F0FFD5B591FFB77932FF0000000000000000FFFF FF005F5E5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFB77932FFD5B591FFF4F2 F0FFF4F2F0FFF4F2F0FFF4F2F0FFD5B591FFB77932FF0000000000000000FFFF FF005F5E5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0894BFFBE8849FFF0EA E4FFF4F2F0FFF4F2F0FFF0EAE4FFBE8849FFB77932DF0000000000000000FFFF FF005F5E5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFE8D5BEFFB77932FFBE88 49FFD5B591FFD5B591FFBE8849FFB77932FFB779324F0000000000000000FFFF FF005F5E5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFE8D5BEFFC089 4BFFB77932FFB77932FFC0894BFFB779324FFFFFFF00FFFFFF00FFFFFF00FFFF FF005F5E5FFF5F5E5FFF5F5E5FFF5F5E5FFF5F5E5FFFC3C2C3FFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF5F5E5F9FFFFFFF00FFFFFF00FFFFFF00FFFF FF005F5E5F9F5F5E5FFF5F5E5FFF5F5E5FFF5F5E5FFF5F5E5FFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF5F5E5FFFFFFFFF00FFFFFF00FFFFFF00FFFF FF00000000005F5E5F9F5F5E5FFF5F5E5FFF5F5E5FFF5F5E5FFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF5F5E5FFFFFFFFF00FFFFFF00FFFFFF00FFFF FF0000000000000000005F5E5F9F5F5E5FFF5F5E5FFF5F5E5FFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF5F5E5FFF000000000000000000000000FFFF FF000000000000000000000000005F5E5F9F5F5E5FFF5F5E5FFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF5F5E5FFF000000000000000000000000FFFF FF00000000000000000000000000000000005F5E5F9F5F5E5FFF5F5E5FFF5F5E 5FFF5F5E5FFF5F5E5FFF5F5E5FFF5F5E5FFF0000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000} KeyPreview = True OldCreateOrder = False Position = poScreenCenter OnCreate = FormCreate OnKeyDown = FormKeyDown OnShow = FormShow PixelsPerInch = 96 TextHeight = 13 object ToBMain: TToolBar Left = 0 Top = 0 Width = 812 Height = 30 AutoSize = True ButtonHeight = 30 ButtonWidth = 31 Caption = 'TBMain' Images = ILMain TabOrder = 0 Wrapable = False object TBPageFirst: TToolButton Left = 0 Top = 0 Action = ACPageFirst Grouped = True ParentShowHint = False ShowHint = True end object TBPagePrevious: TToolButton Left = 31 Top = 0 Action = ACPagePrevious Grouped = True ParentShowHint = False ShowHint = True end object TBPageNext: TToolButton Left = 62 Top = 0 Action = ACPageNext Grouped = True ParentShowHint = False ShowHint = True end object TBPageLast: TToolButton Left = 93 Top = 0 Action = ACPageLast Grouped = True ParentShowHint = False ShowHint = True end object ToolButton3: TToolButton Left = 124 Top = 0 Width = 8 Caption = 'ToolButton3' ImageIndex = 2 Style = tbsSeparator end object PNPage: TPanel Left = 132 Top = 0 Width = 71 Height = 30 BevelOuter = bvNone ParentBackground = False TabOrder = 0 object EDPage: TEdit Left = 7 Top = 4 Width = 43 Height = 21 TabOrder = 0 Text = '1' OnExit = EDPageExit OnKeyDown = EDPageKeyDown end object UDPage: TUpDown Left = 50 Top = 4 Width = 15 Height = 21 Associate = EDPage Min = 1 Position = 1 TabOrder = 1 OnClick = UDPageClick end end object ToolButton6: TToolButton Left = 203 Top = 0 Width = 8 Caption = 'ToolButton6' ImageIndex = 3 Style = tbsSeparator end object PNScale: TPanel Left = 211 Top = 0 Width = 112 Height = 30 BevelOuter = bvNone ParentBackground = False ParentColor = True TabOrder = 1 object CoBScale: TComboBox Left = 9 Top = 4 Width = 95 Height = 21 AutoComplete = False DropDownCount = 16 TabOrder = 0 OnExit = CoBScaleExit OnSelect = CoBScaleExit Items.Strings = ( '25 %' '50 %' '75 %' '100 %' '125 %' '150 %' '200 %' '500 %' 'whole page' 'page width') end end object ToolButton1: TToolButton Left = 323 Top = 0 Width = 8 Caption = 'ToolButton1' ImageIndex = 4 Style = tbsSeparator end object TBPrint: TToolButton Left = 331 Top = 0 Action = ACPrint ParentShowHint = False ShowHint = True end object ToolButton4: TToolButton Left = 362 Top = 0 Width = 8 Caption = 'ToolButton4' ImageIndex = 5 Style = tbsSeparator end object TBClose: TToolButton Left = 370 Top = 0 Action = ACClose ParentShowHint = False ShowHint = True end end object ILMain: TImageList ColorDepth = cd32Bit DrawingStyle = dsTransparent Height = 24 Width = 24 Left = 16 Top = 54 Bitmap = { 494C010106002000340018001800FFFFFFFF2110FFFFFFFFFFFFFFFF424D3600 0000000000003600000028000000600000003000000001002000000000000048 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000E0E0E0F2424242C393939543C3B3B5A3B3B3B593B3B3B593B3B 3B593B3B3B593B3B3B593B3B3B593B3B3B593C3B3B5A3737374F1D1D1D220808 0809000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000303030404040405000000000000 0000000000000000000033333243FEEFC3FFFEE5BBFFFEE5BBFFFEE5BCFFFEE6 BDFFFEE7BEFFFEE9C2FFFEE9C2FFFEEAC4FFFEEEC9FFFCE0BEFE0B0B0B0C0000 0000000000000000000004040405030303040000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000161616191F1F1F25393939515E5E 5EB35E5E5EB6646566B979726CD1FED3A3FFFECFA2FFFED0A3FFFED0A6FFFED3 A8FFFED4ADFFFED7B0FFFED8B2FFFED9B5FFFEDEBBFFEECDB2FB62615FC25C5D 5DB45E5E5EB43B3B3B571E1E1E24161616190000000000000000000000000000 0000000000000000000055565780555657800000000000000000000000000000 0000000000000000000000000000000000005556578055565780000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000606060733333346949494E0D2D2 D2FFD6D6D6FFBABDBFFF6A5F54FFEEBE90FFE9BB90FFE9BC93FFE9BD95FFE9C0 99FFE9C29EFFE9C4A1FFE9C5A4FFE9C7A9FFECCDAFFFD4B89EFF676563FFD4D5 D6FFD1D1D1FF9F9F9FE939393952040404050000000000000000000000000000 000000000000555657804343C0FF4343C0FF5556578000000000000000000000 0000000000000000000000000000555657804343C0FF4343C0FF555657800000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000004D4D4D82D3D3D3FFD3D3 D3FFD4D4D4FFBDBFC1FF524840FFB9936FFFB59270FFB59272FFB59474FFB596 78FFB59779FFB5977BFFB6997DFFB69984FFB99E88FFA28A74FF555453FFD7D3 D6FFD1CFD0FFCFCFCFFF4D4D4D82000000000000000000000000000000000000 0000555657804343C0FF7272DAFF7171DAFF4343C0FF55565780000000000000 00000000000000000000555657804343C0FF7171DAFF7272DAFF4343C0FF5556 5780000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000057575780CACACAFFD7D7 D7FFD5D5D5FFCCCCCDFF95908FFFB6A8A2FFB5A7A1FFB5A7A1FFB5A7A1FFB4A7 A0FFB4A7A1FFB4A7A1FFB4A6A0FFB4A6A1FFB4A7A1FFAB9E99FF9D9799FF9BC0 B0FFADC5BBFFCAC6C8FF57575780000000000000000000000000000000000000 00004343C0FF7272DAFF9797FEFF8D8DFEFF6767DAFF4343C0FF555657800000 000000000000555657804343C0FF6767DAFF8D8DFEFF9797FEFF7272DAFF4343 C0FF000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000055555580CCCCCCFFE0DF DFFFEAE9EAFFE2E7E5FFE9EFEDFFE3EBEAFFE3EBEAFFE3EBEAFFE3EBE9FFE3EB E9FFE3EBE9FFE3EBE9FFE3EAE9FFE3EAE9FFE2EAE8FFE3EBE9FFEEEFEEFFCDDF D8FFC7D3CEFFCAC8C9FF55555580000000000000000000000000000000000000 00004343C0FF7171DAFF8D8DFEFF7777FEFF7D7DFEFF6464DAFF4343C0FF5556 5780555657804343C0FF6464DAFF7D7DFEFF7777FEFF8D8DFEFF7171DAFF4343 C0FF000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000005454547FD5D1D3FFE6ED EAFF6ABE9CFF2DA372FF37A878FF37A877FF37A777FF37A777FF37A677FF37A7 76FF37A776FF37A676FF38A677FF38A677FF38A677FF38A677FF2DA16FFF7AC3 A5FFECEEEDFFD0CDCEFF5454547F000000000000000000000000000000000000 0000000000004343C0FF6767DAFF7D7DFEFF7272FEFF7878FEFF5E5EDAFF4343 C0FF4343C0FF5E5EDAFF7878FEFF7272FEFF7D7DFEFF6767DAFF4343C0FF0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000004F4F4F74E4DDE0FFBFE1 D2FF28B17CFF44C79BFF3DBF91FF3EBF91FF3EBF91FF3EBF91FF3EBF91FF3EBF 92FF3EBF92FF3EBF92FF3EBF92FF3EBF92FF3EBF92FF3DBE91FF44C89BFF29AD 7AFFC4E1D3FFE1DADDFF50505076000000000000000000000000000000000000 000000000000000000004343C0FF6464DAFF7878FEFF6D6DFEFF6B6BFEFF6F6F FEFF6F6FFEFF6B6BFEFF6D6DFEFF7878FEFF6464DAFF4343C0FF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000004E4E4E71EEE7EAFFBFE4 D6FF28B382FF27B180FF18AA73FF1AAC76FF1AAC76FF1AAC76FF1AAC76FF1AAC 76FF1AAC76FF1AAC76FF1AAC76FF1AAC76FF1AAC76FF18AA73FF27B180FF29AE 7CFFC8E5D9FFEDE6EAFF50505075000000000000000000000000000000000000 00000000000000000000000000004343C0FF5E5EDAFF6B6BFEFF5F5FFEFF5C5C FEFF5C5CFEFF5F5FFEFF6B6BFEFF5E5EDAFF4343C0FF00000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000004E4E4E70F8F1F4FFBBE6 D6FF30C190FF35CA9BFF21C591FF23C794FF23C794FF23C794FF23C794FF23C7 94FF23C794FF23C794FF23C794FF23C794FF23C794FF20C491FF36CC9EFF35BE 8FFFC6E6D8FFFBF3F6FF52525276000000000000000000000000000000000000 0000000000000000000000000000000000004343C0FF6F6FFEFF5C5CFEFF5555 FEFF5555FEFF5C5CFEFF6F6FFEFF4343C0FF0000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000004D4D4D6DFAF3F5FFB0E5 D3FF37CA9CFF71F3CEFF6BF0CBFF6BF1CBFF6BF0CBFF6BF0CBFF6BF1CBFF6BF1 CBFF6BF1CBFF6BF0CBFF6BF0CBFF6BF0CBFF6BF1CBFF6CF0CBFF73F3CFFF39C7 98FFC4E6D9FFFEF5F9FF52525276000000000000000000000000000000000000 0000000000000000000000000000555657804343C0FFB4B4FEFFAAAAFEFFA7A7 FEFFA7A7FEFFAAAAFEFFB4B4FEFF4343C0FF5556578000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000049494967FAF3F5FFACE6 D3FF38CEA0FF67EEC7FF4DD6ACFF4DD4ABFF4DD5ABFF4DD5ABFF4DD4ABFF4DD4 ABFF4DD4ABFF4DD5ABFF4DD5ACFF4DD5ABFF4ED4ABFF4AD6ACFF5EEBC2FF39CA 9BFFC3E9DBFFFEF5F9FF4F4F4F71000000000000000000000000000000000000 00000000000000000000555657804343C0FF7979DAFFBEBEFEFFB8B8FEFFB7B7 FEFFB7B7FEFFB8B8FEFFBEBEFEFF7979DAFF4343C0FF55565780000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000004242425AF3EAEDFEBAEB DBFF2ED1A0FF44D4A5FFA8B489FFB7B48BFFB4B58BFFB4B58BFFB4B58BFFB4B5 8BFFB4B58BFFB4B58BFFB4B58CFFB4B58BFFB7B48BFFA7B68BFF2FC998FF17C1 8CFFC8EEE0FFFAF0F3FF48484865000000000000000000000000000000000000 000000000000555657804343C0FF8282DAFFCECEFEFFCACAFEFFCACAFEFFCBCB FEFFCBCBFEFFCACAFEFFCACAFEFFCECEFEFF8282DAFF4343C0FF555657800000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000060606076B68699D92BB ADF337AE8AF153A78AEFE8C49DFEFECCA4FFF9CBA3FFF9CBA3FFF9CBA3FFF9CB A3FFF9CBA3FFF9CBA3FFF9CBA3FFF9CBA3FFFDCCA4FFECC69EFE58A98BF233A9 85F191B0A6EB716E70A50F0F0F10000000000000000000000000000000000000 0000555657804343C0FF8686DAFFDBDBFEFFD8D8FEFFDADAFEFF8484DAFF4343 C0FF4343C0FF8484DAFFDADAFEFFD8D8FEFFDBDBFEFF8686DAFF4343C0FF5556 5780000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000001818 181B0F0F0F100F0F0F10CAB899EDFBD8B3FFF7D8B3FFF8D8B3FFF7D8B2FFF8D8 B3FFF8D8B3FFF7D8B2FFF8D8B2FFF8D8B3FFFAD9B3FFD4BCA0F01E1E1E230F0F 0F100C0C0C0D0000000000000000000000000000000000000000000000000000 00004343C0FF8B8BDAFFE8E8FEFFE5E5FEFFE6E6FEFF8989DAFF4343C0FF0000 0000000000004343C0FF8989DAFFE6E6FEFFE5E5FEFFE8E8FEFF8B8BDAFF4343 C0FF000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000E0E0E0FDCBB9DEFF8D9B6FFF9D9B5FFF8D8B5FFF9D9B6FFF8DA B6FFF8DAB6FFF8D9B6FFF8D9B6FFF9D9B6FFFAD9B5FFD7BC9FEF0C0C0C0D0000 0000000000000000000000000000000000000000000000000000000000000000 00004343C0FF8E8EDAFFF2F2FEFFF1F1FEFF8D8DDAFF4343C0FF000000000000 000000000000000000004343C0FF8D8DDAFFF1F1FEFFF2F2FEFF8E8EDAFF4343 C0FF000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000F0F0F10D6B99CEFF9DCBAFFF9DBB9FFF9DBB9FFF9DCB9FFF8DB B9FFF9DCB9FFF9DBBAFFF8DAB9FFF9DBB9FFF9DCB9FFD9BB9FEF0F0F0F100000 0000000000000000000000000000000000000000000000000000000000000000 0000000000004343C0FF9090DAFF9090DAFF4343C0FF00000000000000000000 00000000000000000000000000004343C0FF9090DAFF9090DAFF4343C0FF0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000F0F0F10D4B99CEFF9DEBEFFF9DDBDFFF9DCBCFFF9DCBCFFF9DD BDFFF9DDBDFFF9DCBCFFF9DDBCFFF9DDBDFFF9DDBEFFD6BA9FEF0F0F0F100000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004343C0FF4343C0FF0000000000000000000000000000 0000000000000000000000000000000000004343C0FF4343C0FF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000F0F0F10D3B79DEFFAE0C2FFF9DEC0FFF9DEC0FFFADEC0FFFADE C0FFF9DEC1FFFADEC0FFF9DEC0FFF9DEC0FFFADFC1FFD5B99FEF0F0F0F100000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000F0F0F10D3B89DEFFCE4C7FFFAE2C6FFFBE2C5FFFAE2C5FFFAE2 C6FFFAE2C6FFFAE2C6FFFBE2C5FFFBE2C5FFFBE3C7FFD4B89FEF0F0F0F100000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000F0F0F10CBAD93EBE8C6A5FBE8C5A5FBE8C5A4FBE8C6A4FBE8C5 A5FBE8C5A5FBE8C5A5FBE8C5A4FBE8C5A4FBE8C6A5FBCBAD94EB0F0F0F100000 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 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000555657805556578055565780555657800000000000000000000000000000 0000000000000000000000000000000000000000000055565780555657800000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000005556578055565780555657800000 0000000000000000000000000000000000000000000000000000000000000000 0000000000005556578055565780555657800000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000005556578055565780000000000000000000000000000000000000 0000000000000000000000000000000000005556578055565780555657805556 5780000000000000000000000000000000000000000000000000000000000000 000068AD93FF68AD93FF68AD93FF68AD93FF0000000000000000000000000000 0000000000000000000000000000555657805556578068AD93FF68AD93FF5556 5780000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000555657805556578068AD93FF68AD93FF68AD93FF5556 5780000000000000000000000000000000000000000000000000000000000000 00005556578068AD93FF68AD93FF68AD93FF5556578055565780000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005556578068AD93FF68AD93FF555657805556578000000000000000000000 00000000000000000000000000000000000068AD93FF68AD93FF68AD93FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFBEF1E4FFBEF1E4FF68AD93FF0000000000000000000000000000 000000000000555657805556578068AD93FF68AD93FF89C9B3FF8FC9B5FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000555657805556578068AD93FF68AD93FF83C7B1FFA9EDDCFF8DC9B4FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FF8DC9B4FFA9EDDCFF83C7B1FF68AD93FF68AD93FF555657805556 5780000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000068AD93FF8FC9B5FF89C9B3FF68AD93FF68AD93FF55565780555657800000 00000000000000000000000000000000000068AD93FFBEF1E4FFBEF1E4FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFA9EDDCFFA9EDDCFF68AD93FF0000000000000000000000005556 57805556578068AD93FF68AD93FF80C7AFFF90E8D2FF92E9D3FFA7EDDBFF68AD 93FF000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000555657805556 578068AD93FF68AD93FF80C7AFFF8EE8D1FF83E6CDFF8AE7D0FFA3ECDAFF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFA3ECDAFF8AE7D0FF83E6CDFF8EE8D1FF80C7AFFF68AD93FF68AD 93FF555657805556578000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000068AD93FFA7EDDBFF92E9D3FF90E8D2FF80C7AFFF68AD93FF68AD93FF5556 57805556578000000000000000000000000068AD93FFA9EDDCFFA9EDDCFF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FF9FEBD8FF9FEBD8FF68AD93FF00000000555657805556578068AD 93FF68AD93FF80C7AFFF8DE8D1FF7DE5CBFF73E3C7FF7BE5CAFF96E9D4FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000555657805556578068AD93FF68AD 93FF80C7AFFF8DE8D1FF7DE5CBFF72E3C7FF6CE2C4FF76E4C8FF94E9D3FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FF94E9D3FF76E4C8FF6CE2C4FF72E3C7FF7DE5CBFF8DE8D1FF80C7 AFFF68AD93FF68AD93FF55565780555657800000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000068AD93FF96E9D4FF7BE5CAFF73E3C7FF7DE5CBFF8DE8D1FF80C7AFFF68AD 93FF68AD93FF55565780555657800000000068AD93FF9FEBD8FF9FEBD8FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FF9FEBD8FF9FEBD8FF68AD93FF5556578068AD93FF68AD93FF80C7 AFFF8DE8D1FF7DE5CBFF72E3C7FF6BE1C4FF66E0C2FF73E3C7FF90E8D2FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 00000000000000000000555657805556578068AD93FF68AD93FF80C7AFFF8DE8 D1FF7DE5CBFF72E3C7FF6BE1C4FF66E0C2FF65E0C1FF72E3C7FF90E8D2FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FF90E8D2FF72E3C7FF65E0C1FF66E0C2FF6BE1C4FF72E3C7FF7DE5 CBFF8DE8D1FF80C7AFFF68AD93FF68AD93FF5556578055565780000000000000 0000000000000000000000000000000000000000000000000000000000000000 000068AD93FF90E8D2FF73E3C7FF66E0C2FF6BE1C4FF72E3C7FF7DE5CBFF8DE8 D1FF80C7AFFF68AD93FF68AD93FF5556578068AD93FF9FEBD8FF9FEBD8FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FF9FEBD8FF9FEBD8FF68AD93FF68AD93FF80C7AFFF8DE8D1FF7DE5 CBFF72E3C7FF6BE1C4FF66E0C2FF65E0C1FF64E0C1FF72E3C7FF90E8D2FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 0000000000005556578068AD93FF68AD93FF80C7AFFF8DE8D1FF7DE5CBFF72E3 C7FF6BE1C4FF66E0C2FF65E0C1FF64E0C1FF64E0C1FF72E3C7FF90E8D2FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FF90E8D2FF72E3C7FF64E0C1FF64E0C1FF65E0C1FF66E0C2FF6BE1 C4FF72E3C7FF7DE5CBFF8DE8D1FF80C7AFFF68AD93FF68AD93FF555657800000 0000000000000000000000000000000000000000000000000000000000000000 000068AD93FF90E8D2FF72E3C7FF64E0C1FF65E0C1FF66E0C2FF6BE1C4FF72E3 C7FF7DE5CBFF8DE8D1FF80C7AFFF68AD93FF68AD93FF9FEBD8FF9FEBD8FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FF9FEBD8FF9FEBD8FF68AD93FF92E9D2FF7DE5CBFF72E3C7FF6BE1 C4FF66E0C2FF65E0C1FF64E0C1FF64E0C1FF64E0C1FF72E3C7FF90E8D2FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 00005556578068AD93FF86C8B1FF92E9D2FF7DE5CBFF72E3C7FF6BE1C4FF66E0 C2FF65E0C1FF64E0C1FF64E0C1FF64E0C1FF64E0C1FF72E3C7FF90E8D2FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FF90E8D2FF72E3C7FF64E0C1FF64E0C1FF64E0C1FF64E0C1FF65E0 C1FF66E0C2FF6BE1C4FF72E3C7FF7DE5CBFF92E9D2FF86C8B1FF68AD93FF5556 5780000000000000000000000000000000000000000000000000000000000000 000068AD93FF90E8D2FF72E3C7FF64E0C1FF64E0C1FF64E0C1FF65E0C1FF66E0 C2FF6BE1C4FF72E3C7FF7DE5CBFF92E9D2FF68AD93FF9FEBD8FF9FEBD8FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FF9FEBD8FF9FEBD8FF68AD93FF79E4CAFF6CE2C4FF66E0C2FF65E0 C1FF64E0C1FF64E0C1FF64E0C1FF64E0C1FF64E0C1FF72E3C7FF90E8D2FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FF8BC9B4FF95E9D4FF79E4CAFF6CE2C4FF66E0C2FF65E0C1FF64E0 C1FF64E0C1FF64E0C1FF64E0C1FF64E0C1FF64E0C1FF72E3C7FF90E8D2FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FF90E8D2FF72E3C7FF64E0C1FF64E0C1FF64E0C1FF64E0C1FF64E0 C1FF64E0C1FF65E0C1FF66E0C2FF6CE2C4FF79E4CAFF95E9D4FF8BC9B4FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FF90E8D2FF72E3C7FF64E0C1FF64E0C1FF64E0C1FF64E0C1FF64E0 C1FF65E0C1FF66E0C2FF6CE2C4FF79E4CAFF68AD93FF9FEBD8FF9FEBD8FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFD5F0E9FFD5F0E9FF68AD93FFC5EAE1FFBFE8DEFFBDE7DDFFBCE7 DCFFBCE7DCFFBCE7DCFFBCE7DCFFBCE7DCFFBCE7DCFFC2E9DFFFCEEDE5FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FF9BCAB9FFD0EEE7FFC5EAE1FFBFE8DEFFBDE7DDFFBCE7DCFFBCE7 DCFFBCE7DCFFBCE7DCFFBCE7DCFFBCE7DCFFBCE7DCFFC2E9DFFFCEEDE5FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFCEEDE5FFC2E9DFFFBCE7DCFFBCE7DCFFBCE7DCFFBCE7DCFFBCE7 DCFFBCE7DCFFBCE7DCFFBDE7DDFFBFE8DEFFC5EAE1FFD0EEE7FF9BCAB9FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFCEEDE5FFC2E9DFFFBCE7DCFFBCE7DCFFBCE7DCFFBCE7DCFFBCE7 DCFFBCE7DCFFBDE7DDFFBFE8DEFFC5EAE1FF68AD93FFD5F0E9FFD5F0E9FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFDBF1ECFFDBF1ECFF68AD93FFD7F0E9FFD0EDE6FFCCECE4FFCAEB E2FFC8EAE1FFC7EAE1FFC7EAE1FFC7EAE1FFC7EAE1FFCCECE4FFD6F0E9FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 00000000000068AD93FF9BCAB9FFD7F0E9FFD0EDE6FFCCECE4FFCAEBE2FFC8EA E1FFC7EAE1FFC7EAE1FFC7EAE1FFC7EAE1FFC7EAE1FFCCECE4FFD6F0E9FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFD6F0E9FFCCECE4FFC7EAE1FFC7EAE1FFC7EAE1FFC7EAE1FFC7EA E1FFC8EAE1FFCAEBE2FFCCECE4FFD0EDE6FFD7F0E9FF9BCAB9FF68AD93FF0000 0000000000000000000000000000000000000000000000000000000000000000 000068AD93FFD6F0E9FFCCECE4FFC7EAE1FFC7EAE1FFC7EAE1FFC7EAE1FFC8EA E1FFCAEBE2FFCCECE4FFD0EDE6FFD7F0E9FF68AD93FFDBF1ECFFDBF1ECFF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFE2F4EFFFE2F4EFFF68AD93FF68AD93FF9BCAB9FFDDF2ECFFD9F1 EAFFD6F0E8FFD4EFE7FFD3EEE6FFD2EEE6FFD2EEE6FFD6F0E8FFDEF2EDFF68AD 93FF000000000000000000000000000000000000000000000000000000000000 0000000000000000000068AD93FF68AD93FF9BCAB9FFDDF2ECFFD9F1EAFFD6F0 E8FFD4EFE7FFD3EEE6FFD2EEE6FFD2EEE6FFD2EEE6FFD6F0E8FFDEF2EDFF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFDEF2EDFFD6F0E8FFD2EEE6FFD2EEE6FFD2EEE6FFD3EEE6FFD4EF E7FFD6F0E8FFD9F1EAFFDDF2ECFF9BCAB9FF68AD93FF68AD93FF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000068AD93FFDEF2EDFFD6F0E8FFD2EEE6FFD2EEE6FFD3EEE6FFD4EFE7FFD6F0 E8FFD9F1EAFFDDF2ECFF9BCAB9FF68AD93FF68AD93FFE2F4EFFFE2F4EFFF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFE9F6F3FFE9F6F3FF68AD93FF0000000068AD93FF68AD93FF9ECB BBFFE5F4F1FFE2F3EFFFE0F2EEFFDFF2EDFFDEF1ECFFE0F2EEFFE6F5F1FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000068AD93FF68AD93FF9ECBBBFFE5F4 F1FFE2F3EFFFE0F2EEFFDFF2EDFFDEF1ECFFDDF1ECFFE0F2EEFFE6F5F1FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFE6F5F1FFE0F2EEFFDDF1ECFFDEF1ECFFDFF2EDFFE0F2EEFFE2F3 EFFFE5F4F1FF9ECBBBFF68AD93FF68AD93FF0000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000068AD93FFE6F5F1FFE0F2EEFFDEF1ECFFDFF2EDFFE0F2EEFFE2F3EFFFE5F4 F1FF9ECBBBFF68AD93FF68AD93FF0000000068AD93FFE9F6F3FFE9F6F3FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFF0F8F6FFF0F8F6FF68AD93FF00000000000000000000000068AD 93FF68AD93FFA1CCBCFFEDF7F5FFEBF6F4FFE9F6F3FFEBF6F4FFEEF8F6FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000068AD93FF68AD 93FFA1CCBCFFEDF7F5FFEBF6F4FFE9F6F3FFE8F5F3FFEAF6F3FFEEF8F6FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFEEF8F6FFEAF6F3FFE8F5F3FFE9F6F3FFEBF6F4FFEDF7F5FFA1CC BCFF68AD93FF68AD93FF00000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000068AD93FFEEF8F6FFEBF6F4FFE9F6F3FFEBF6F4FFEDF7F5FFA1CCBCFF68AD 93FF68AD93FF00000000000000000000000068AD93FFF0F8F6FFF0F8F6FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFF6FBFAFFF6FBFAFF68AD93FF0000000000000000000000000000 00000000000068AD93FF68AD93FFA3CDBDFFF4FAF9FFF4FAF9FFF6FBFAFF68AD 93FF000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000068AD93FF68AD93FFA3CDBDFFF4FAF9FFF3FAF8FFF3FAF9FFF6FBFAFF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFF6FBFAFFF3FAF9FFF3FAF8FFF4FAF9FFA3CDBDFF68AD93FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000068AD93FFF6FBFAFFF4FAF9FFF4FAF9FFA3CDBDFF68AD93FF68AD93FF0000 00000000000000000000000000000000000068AD93FFF6FBFAFFF6FBFAFF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFFBFDFDFFFBFDFDFF68AD93FF0000000000000000000000000000 000000000000000000000000000068AD93FF68AD93FFA6CEBFFFA6CEBFFF68AD 93FF000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000068AD93FF68AD93FFA6CEBEFFFBFDFCFFA6CEBFFF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFA6CEBFFFFBFDFCFFA6CEBEFF68AD93FF68AD93FF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000068AD93FFA6CEBFFFA6CEBFFF68AD93FF68AD93FF00000000000000000000 00000000000000000000000000000000000068AD93FFFBFDFDFFFBFDFDFF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FF68AD93FF68AD93FF68AD93FF0000000000000000000000000000 0000000000000000000000000000000000000000000068AD93FF68AD93FF0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000068AD93FF68AD93FF68AD93FF0000 0000000000000000000000000000000000000000000000000000000000000000 00000000000068AD93FF68AD93FF68AD93FF0000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000068AD93FF68AD93FF000000000000000000000000000000000000 00000000000000000000000000000000000068AD93FF68AD93FF68AD93FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 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 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000424D3E000000000000003E000000 2800000060000000300000000100010000000000400200000000000000000000 000000000000000000000000FFFFFF0000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000} end object ALMain: TActionList Images = ILMain Left = 56 Top = 54 object ACPageFirst: TAction Hint = 'First page' ImageIndex = 0 OnExecute = ACPageFirstExecute OnUpdate = ACPageFirstUpdate end object ACPagePrevious: TAction Caption = 'Previous page' Hint = 'Previous page' ImageIndex = 1 OnExecute = ACPagePreviousExecute OnUpdate = ACPageFirstUpdate end object ACPageNext: TAction Caption = 'Next page' Hint = 'Next page' ImageIndex = 2 OnExecute = ACPageNextExecute OnUpdate = ACPageNextUpdate end object ACPageLast: TAction Caption = 'Last page' Hint = 'Last page' ImageIndex = 3 OnExecute = ACPageLastExecute OnUpdate = ACPageNextUpdate end object ACPrint: TAction Caption = 'Print' Hint = 'Print' ImageIndex = 4 OnExecute = ACPrintExecute OnUpdate = ACPrintUpdate end object ACClose: TAction Caption = 'Close' Hint = 'Close preview' ImageIndex = 5 OnExecute = ACCloseExecute OnUpdate = ACCloseUpdate end end end tomboy-ng_0.34-1/kcontrols/source/kgraphics.pas0000644000175000017500000036241514125207534021427 0ustar dbannondbannon{ @abstract(This file is part of the KControls component suite for Delphi and Lazarus.) @author(Tomas Krysl) Copyright (c) 2020 Tomas Krysl

License:
This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } unit kgraphics; // lowercase name because of Lazarus/Linux {$include kcontrols.inc} {$IFNDEF REGISTER_PICTURE_FORMATS} {$WEAKPACKAGEUNIT ON} {$ENDIF} interface uses {$IFDEF FPC} // use the LCL interface support whenever possible {$IFDEF MSWINDOWS} Windows, {$ENDIF} GraphType, IntfGraphics, FPImage, LCLType, LCLIntf, LMessages, LResources, {$ELSE} Windows, Messages, JPeg, {$IFDEF USE_PNG_SUPPORT} PngImage, {$ENDIF} {$ENDIF} Classes, Forms, Graphics, Controls, Types, KFunctions, KControls {$IFDEF USE_THEMES} , Themes {$IFNDEF FPC} , UxTheme {$ENDIF} {$ENDIF} ; const { PNG Support } PNGHeader = #137'PNG'#13#10#26#10; MNGHeader = #138'MNG'#13#10#26#10; { Default value for the @link(TKSizingGrips.GripColor) property. } cSizingGripColor = clNavy; { Default value for the @link(TKSizingGrips.GripSize) property. } cSizingGripSize = 8; { Default value for the @link(TKSizingGrips.MidGripConstraint) property. } cSizingMidGripConstraint = (3 * cSizingGripSize + 10); type { Declares possible values for the Style parameter of the @link(BrightColor) function. } TKBrightMode = ( { The Color will be brightened with Percent of its entire luminosity range. } bsAbsolute, { The Color will be brightened with Percent of its current luminosity value. } bsOfBottom, { The Color will be brightened with Percent of the difference of its entire luminosity range and current luminosity value. } bsOfTop ); { Declares RGB + Alpha channel color description allowing both to access single channels and the whole color item. } TKColorRec = packed record case Integer of 0: (R, G, B, A: Byte); 1: (Value: Cardinal); end; { Pointer to TKColorRec. } PKColorRec = ^TKColorRec; { Dynamic array for TKColorRec. } TKColorRecs = array[0..MaxInt div SizeOf(TKColorRec) - 1] of TKColorRec; { Dynamic array for TKColorRecs. } PKColorRecs = ^TKColorRecs; { Dynamic array for TKColorRec. } TKDynColorRecs = array of TKColorRec; { String type for @link(ImageByType) function. } TKImageHeaderString = string[10]; {$IFDEF USE_PNG_SUPPORT} {$IFDEF FPC} { @exclude } TKPngImage = TPortableNetworkGraphic; {$ELSE} {$IFDEF COMPILER12_UP} { @exclude } TKPngImage = TPngImage; {$ELSE} { @exclude } TKPngImage = TPngObject; {$ENDIF} {$ENDIF} {$ENDIF} TKJpegImage = TJpegImage; { Declares possible values for the Attributes parameter in the @link(DrawAlignedText) function. } TKTextAttribute = ( { Bounding rectangle is calculated. No text is drawn. } taCalcRect, { Text will be clipped within the given rectangle. } taClip, { Text will be drawn with end ellipsis if it does not fit within given width. } taEndEllipsis, { Given rectangle will be filled. } taFillRect, { Only the text within given rectangle will be filled. } taFillText, { Include padding created by aligns in the @link(TKTextBox.PointToIndex) calculation. } taIncludePadding, { Text will be drawn as multi-line text if it contains carriage returns and line feeds. } taLineBreak, { Text will be drawn with path ellipsis if it does not fit within given width. } taPathEllipsis, { Text line(s) will be broken between words if they don't fit within given width. } taWordBreak, { Text line(s) will be broken if they don't fit within col width. } taWrapText, //JR:20091229 { White spaces will be trimmed at the beginning or end of text lines. } taTrimWhiteSpaces, { Text will be drawn with start ellipsis if it does not fit within given width. } taStartEllipsis ); { Set type for @link(TKTextAttribute) enumeration. } TKTextAttributes = set of TKTextAttribute; { Declares possible values for the HAlign parameter in the @link(DrawAlignedText) function. } TKHAlign = ( { Text is aligned to the left border of a cell rectangle. } halLeft, { Text is horizontally centered within the cell rectangle. } halCenter, { Text is aligned to the right border of a cell rectangle. } halRight, { Text is aligned to the left and right border of a cell rectangle. } halJustify ); { Declares possible values for the StretchMode parameter in the @link(ExcludeShapeFromBaseRect) function. } TKStretchMode = ( { Shape is not stretched. } stmNone, { Shape is zoomed out. } stmZoomOutOnly, { Shape is zoomed in. } stmZoomInOnly, { Shape is zoomed arbitrary. } stmZoom ); { For backward compatibility. } TKTextHAlign = TKHAlign; { Declares possible values for the VAlign parameter in the @link(DrawAlignedText) function. } TKVAlign = ( { Text is aligned to the upper border of a cell rectangle. } valTop, { Text is vertically centered within the cell rectangle. } valCenter, { Text is aligned to the lower border of a cell rectangle. } valBottom ); { For backward compatibility. } TKTextVAlign = TKVAlign; { Declares possible values for the AStates parameter in the @link(DrawButtonFrame) function. } TKButtonDrawState = ( { Use OS themes/styles to draw button. } bsUseThemes, { Draw disabled button. } bsDisabled, { Draw pressed button. } bsPressed, { Draw normal focused button. } bsFocused, { Draw normal hot button. } bsHot ); { Set of TKButtonState values. } TKButtonDrawStates = set of TKButtonDrawState; { Contains common properties for all KCOntrols TGraphic descendants. } TKGraphic = class(TGraphic) protected FDescription: string; FFileFilter: string; public { Creates the instance. } constructor Create; override; { Gives description for design time loader. } property Description: string read FDescription; { Gives file filter for design time loader. } property FileFilter: string read FFileFilter; end; { A simple platform independent encapsulation for a 32bpp bitmap with alpha channel with the ability to modify it's pixels directly. } { TKAlphaBitmap } TKAlphaBitmap = class(TKGraphic) private FAutoMirror: Boolean; FCanvas: TCanvas; FDirectCopy: Boolean; FHandle: HBITMAP; FHeight: Integer; {$IFNDEF MSWINDOWS} FImage: TLazIntfImage; // Lazarus only FMaskHandle: HBITMAP; {$ENDIF} FOldBitmap: HBITMAP; FPixels: PKColorRecs; FPixelsChanged: Boolean; FUpdateLock: Integer; FWidth: Integer; function GetScanLine(Index: Integer): PKColorRecs; function GetHandle: HBITMAP; function GetHasAlpha: Boolean; function GetPixel(X, Y: Integer): TKColorRec; procedure SetPixel(X, Y: Integer; Value: TKColorRec); protected { Calls OnChanged event. } procedure Changed(Sender: TObject); override; { Paints itself to ACanvas at location ARect. } procedure Draw(ACanvas: TCanvas; const ARect: TRect); override; { Returns True if bitmap is empty. } function GetEmpty: Boolean; override; { Returns the bitmap height. } function GetHeight: Integer; override; { Returns True. Treat alpha bitmap as transparent because of the possible alpha channel. } function GetTransparent: Boolean; override; { Returns the bitmap width. } function GetWidth: Integer; override; { Specifies new bitmap height. } procedure SetHeight(Value: Integer); override; { Specifies new bitmap width. } procedure SetWidth(Value: Integer); override; { Does nothing. Bitmap is never transparent. } procedure SetTransparent(Value: Boolean); override; public { Creates the instance. } constructor Create; override; { Creates the instance from application resources. For Lazarus 'BMP' type is taken, for Delphi RT_RCDATA is taken. } constructor CreateFromRes(const ResName: string); { Destroys the instance. } destructor Destroy; override; { Paints alpha bitmap onto Canvas at position given by X, Y. The alpha bitmap is combined with the background already drawn on Canvas using alpha channel stored in the alpha bitmap. } procedure AlphaDrawTo(ACanvas: TCanvas; X, Y: Integer); { Paints alpha bitmap onto Canvas at position given by ARect. The alpha bitmap is combined with the background already drawn on Canvas using alpha channel stored in the alpha bitmap. } procedure AlphaStretchDrawTo(ACanvas: TCanvas; const ARect: TRect); { Fills the alpha channel with Alpha. If the optional IfEmpty parameter is True, the alpha channel won't be modified unless it has zero value for all pixels. } procedure AlphaFill(Alpha: Byte; IfEmpty: Boolean = False); overload; { Fills the alpha channel according to given parameters. Currently it is used internally by @link(TKDragWindow). } procedure AlphaFill(Alpha: Byte; BlendColor: TColor; Gradient, Translucent: Boolean); overload; { Fills the alpha channel with AAlpha for pixels with AColor. } procedure AlphaFillOnColorMatch(AColor: TColor; AAlpha: Byte); { Modifies the alpha channel with Percent of its current value. If the optional IfEmpty parameter is True, the alpha channel will be set to percent of full scale if it has zero value. } procedure AlphaFillPercent(Percent: Integer; IfEmpty: Boolean); { Copies shareable properties of another instance into this instance of TKAlphaBitmap. } procedure Assign(Source: TPersistent); override; { Copies shareable properties of this instance into another instance of TKAlphaBitmap. } procedure AssignTo(Dest: TPersistent); override; { Brightens the image by given percent and bright mode. } procedure Brighten(APercent: Single; AMode: TKBrightMode = bsAbsolute); { Clears the image. } procedure Clear; {$IFDEF FPC}override;{$ENDIF} { Combines the pixel at given location with the given color. } procedure CombinePixel(X, Y: Integer; Color: TKColorRec); { Takes dimensions and pixels from AGraphic. } procedure CopyFrom(AGraphic: TGraphic); { Takes dimensions and pixels from ABitmap. } procedure CopyFromAlphaBitmap(ABitmap: TKAlphaBitmap); { Takes diemnsions and pixels from APngImage. } procedure CopyFromJpeg(AJpegImage: TJPEGImage); {$IFDEF USE_PNG_SUPPORT} { Takes diemnsions and pixels from APngImage. } procedure CopyFromPng(APngImage: TKPngImage); {$ENDIF} { Takes 90-rotated dimensions and pixels from ABitmap. } procedure CopyFromRotated(ABitmap: TKAlphaBitmap); { Takes portion from AGraphic at position X and Y. } procedure CopyFromXY(X, Y: Integer; AGraphic: TGraphic); { Takes portion from ABitmap at position X and Y. } procedure CopyFromXYAlphaBitmap(X, Y: Integer; ABitmap: TKAlphaBitmap); { Takes portion from AJpegImage at position X and Y. } procedure CopyFromXYJpeg(X, Y: Integer; AJpegImage: TJPEGImage); {$IFDEF USE_PNG_SUPPORT} { Takes portion from APngImage at position X and Y. } procedure CopyFromXYPng(X, Y: Integer; APngImage: TKPngImage); { Takes diemnsions and pixels from APngImage. } procedure CopyToPng(APngImage: TKPngImage); {$ENDIF} { Copies a location specified by ARect from ACanvas to bitmap. } procedure DrawFrom(ACanvas: TCanvas; const ARect: TRect); overload; { Copies a portion of AGraphic to bitmap at position X and Y. } procedure DrawFrom(AGraphic: TGraphic; X, Y: Integer); overload; { Calls @link(TKAlphaBitmap.Draw). } procedure DrawTo(ACanvas: TCanvas; const ARect: TRect); { Fill with Color. } procedure Fill(Color: TKColorRec); { Convert to grayscale. } procedure GrayScale; {$IFNDEF FPC} { Does nothing. } procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle; APalette: HPALETTE); override; {$ENDIF} { Loads the bitmap from a file. Overriden to support PNG as well. } procedure LoadFromFile(const Filename: string); override; { Loads the bitmap from bitmap and mask handles. } procedure LoadFromHandles(ABitmap, AMask: HBITMAP); { Loads the bitmap from another TGraphic instance. } procedure LoadFromGraphic(Image: TGraphic); virtual; { Loads the bitmap from a stream. } procedure LoadFromStream(Stream: TStream); override; { Locks calls to @link(TKAlphaBitmap.Changed). } procedure LockUpdate; virtual; { Mirrors the bitmap pixels horizontally. } procedure MirrorHorz; { Mirrors the bitmap pixels vertically. } procedure MirrorVert; {$IFNDEF FPC} { Does nothing. } procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle; var APalette: HPALETTE); override; {$ENDIF} { Saves the bitmap to a stream. } procedure SaveToStream(Stream: TStream); override; { Specifies the bitmap size. } procedure SetSize(AWidth, AHeight: Integer); {$IFNDEF FPC} reintroduce;{$ENDIF} { Unlocks calls to @link(TKAlphaBitmap.Changed). } procedure UnlockUpdate; virtual; { Updates the bitmap handle from bitmap pixels. } procedure UpdateHandle; dynamic; { Updates the pixels from bitmap handle. } procedure UpdatePixels; dynamic; { Automatically mirrors the bitmap vertically for Linux hosts, when reading/writing from/to a stream. } property AutoMirror: Boolean read FAutoMirror write FAutoMirror default True; { Returns the bitmap memory canvas. } property Canvas: TCanvas read FCanvas; { Temporary flag. Use when copying data directly from another TGraphic to TKAlphaBitmap. } property DirectCopy: Boolean read FDirectCopy write FDirectCopy; { Returns the bitmap handle. } property Handle: HBITMAP read GetHandle; { Returns true if alpha channel is nonzero for at least one pixel. } property HasAlpha: Boolean read GetHasAlpha; { Specifies the pixel color. Does range checking. } property Pixel[X, Y: Integer]: TKColorRec read GetPixel write SetPixel; { Returns the pointer to bitmap pixels. } property Pixels: PKColorRecs read FPixels; { Set this property to True if you have modified the bitmap pixels. } property PixelsChanged: Boolean read FPixelsChanged write FPixelsChanged; { Returns the pointer to a bitmap scan line. } property ScanLine[Index: Integer]: PKColorRecs read GetScanLine; end; {$IFDEF MSWINDOWS} { A simple encapsulation for a Windows or Enhanced metafile. It runs only under Windows and does not use shared images. However, it is possible to release metafile handles on assigning to another TKMetafile. } TKMetafile = class(TGraphic) private FCopyOnAssign: Boolean; FEmfHandle: HENHMETAFILE; FEnhanced: Boolean; FWmfHandle: HMETAFILE; procedure SetEMFHandle(const Value: HENHMETAFILE); procedure SetEnhanced(const Value: Boolean); procedure SetWMFHandle(const Value: HMETAFILE); protected FRequiredHeight, FRequiredWidth: Integer; procedure Draw(ACanvas: TCanvas; const Rect: TRect); override; function GetEmpty: Boolean; override; function GetHeight: Integer; override; function GetTransparent: Boolean; override; function GetWidth: Integer; override; procedure SetHeight(Value: Integer); override; procedure SetWidth(Value: Integer); override; public constructor Create; override; destructor Destroy; override; procedure Assign(Source: TPersistent); override; procedure Clear; virtual; procedure LoadFromStream(Stream: TStream); override; procedure Release(out AWmfHandle: HMETAFILE; out AEmfHandle: HENHMETAFILE); procedure SaveToStream(Stream: TStream); override; property CopyOnAssign: Boolean read FCopyOnAssign write FCopyOnAssign; property EMFHandle: HENHMETAFILE read FEMFHandle write SetEMFHandle; property Enhanced: Boolean read FEnhanced write SetEnhanced; property WMFHandle: HMETAFILE read FWMFHandle write SetWMFHandle; end; {$ENDIF} { Declares possible values for the AFunction parameter in the @link(TKTextBox.Process) function. } TKTextBoxFunction = ( { Measure text box contents. } tbfMeasure, { Get text index for coordinates stored in FPoint. } tbfGetIndex, { Get boundary rectangle for index stored in FIndex. } tbfGetRect, { Draw text box contents. } tbfDraw ); { Implements advanced text block rendering. Formerly implemented as @link(DrawAlignedText) function. } TKTextBox = class(TObject) private FAttributes: TKTextAttributes; FBackColor: TColor; FHAlign: TKHAlign; FHPadding: Integer; FSelBkgnd: TColor; FSelColor: TColor; FSelEnd: Integer; FSelStart: Integer; FSpacesForTab: Integer; FText: TKString; FVAlign: TKVAlign; FVPadding: Integer; procedure SetText(const AText: TKString); protected FCanvas: TCanvas; FClipRect: TRect; FFontHeight: Integer; FHasTabs: Boolean; FIndex: Integer; FCalcRect: TRect; function GetHorzPos(ATextWidth: Integer): Integer; function GetVertPos: Integer; virtual; procedure Initialize(ACanvas: TCanvas; const ARect: TRect); virtual; procedure Process(Y: Integer; AFunction: TKTextBoxFunction); procedure TextTrim(const AText: TKString; var AStart, ALen: Integer); virtual; public constructor Create; procedure Draw(ACanvas: TCanvas; const ARect: TRect); virtual; function IndexToRect(ACanvas: TCanvas; const ARect: TRect; AIndex: Integer): TRect; virtual; procedure Measure(ACanvas: TCanvas; const ARect: TRect; var AWidth, AHeight: Integer); virtual; function PointToIndex(ACanvas: TCanvas; const ARect: TRect; APoint: TPoint): Integer; virtual; class function TextExtent(ACanvas: TCanvas; const AText: TKString; AStart, ALen: Integer; AExpandTabs: Boolean = False; ASpacesForTab: Integer = 2): TSize; class procedure TextOutput(ACanvas: TCanvas; X, Y: Integer; const AText: TKString; AStart, ALen: Integer; AExpandTabs: Boolean = False; ASpacesForTab: Integer = 2); property Attributes: TKTextAttributes read FAttributes write FAttributes; property BackColor: TColor read FBackColor write FBackColor; property HAlign: TKHAlign read FHAlign write FHAlign; property HPadding: Integer read FHPadding write FHPadding; property SelBkgnd: TColor read FSelBkgnd write FSelBkgnd; property SelColor: TColor read FSelColor write FSelColor; property SelEnd: Integer read FSelEnd write FSelEnd; property SelStart: Integer read FSelStart write FSelStart; property SpacesForTab: Integer read FSpacesForTab write FSpacesForTab; property Text: TKString read FText write SetText; property VAlign: TKVAlign read FVAlign write FVAlign; property VPadding: Integer read FVPadding write FVPadding; end; {$IFDEF MSWINDOWS} TUpdateLayeredWindowProc = function(Handle: THandle; hdcDest: HDC; pptDst: PPoint; _psize: PSize; hdcSrc: HDC; pptSrc: PPoint; crKey: COLORREF; pblend: PBLENDFUNCTION; dwFlags: DWORD): Boolean; stdcall; {$ENDIF} { @abstract(Encapsulates the drag window) Drag window is top level window used for dragging with mouse. It displays some portion of associated control. It can be translucent under Windows. } TKDragWindow = class(TObject) private FActive: Boolean; FAlphaEffects: Boolean; FBitmap: TKAlphaBitmap; FBitmapFilled: Boolean; FControl: TCustomControl; FGradient: Boolean; FInitialPos: TPoint; FLayered: Boolean; FMasterAlpha: Byte; FRect: TRect; {$IFDEF MSWINDOWS} FBlend: TBlendFunction; FUpdateLayeredWindow: TUpdateLayeredWindowProc; FWindow: HWND; {$ELSE} FDragForm: TCustomForm; {$ENDIF} public { Creates the instance. } constructor Create; { Destroys the instance. } destructor Destroy; override; { Shows the drag window on screen. Takes a rectangular part as set by ARect from IniCtrl's Canvas and displays it at position InitialPos. MasterAlpha and Gradient are used to premaster the copied image with a specific fading effect. } procedure Init(IniCtrl: TCustomControl; const ARect: TRect; const AInitialPos: TPoint; AMasterAlpha: Byte; AGradient: Boolean); { Moves the drag window to a new location. } procedure Move(ARect: PRect; const ACurrentPos: TPoint; AShowAlways: Boolean); { Hides the drag window. } procedure Hide; { Returns True if the drag window is shown. } property Active: Boolean read FActive; { Returns the pointer to the bitmap that holds the copied control image. } property Bitmap: TKAlphaBitmap read FBitmap; { Returns True if the control already copied itself to the bitmap. } property BitmapFilled: Boolean read FBitmapFilled; end; { @abstract(Base class for KControls hints) This class extends the standard THintWindow class. It adds functionality common to all hints used in KControls. } { TKHintWindow } TKHintWindow = class(THintWindow) private FExtent: TPoint; procedure WMEraseBkGnd(var Msg: TLMessage); message LM_ERASEBKGND; public { Creates the instance. } constructor Create(AOwner: TComponent); override; { Shows the hint at given position. This is an IDE independent implementation. } procedure ShowAt(const Origin: TPoint); { Hides the hint. } procedure Hide; { Returns the extent of the hint. } property Extent: TPoint read FExtent; end; { @abstract(Hint window to display formatted text) This class implements the textual hint window. The text is displayed . } TKTextHint = class(TKHintWindow) private FText: TKString; procedure SetText(const Value: TKString); protected { Overriden method. Paints the hint. } procedure Paint; override; public { Creates the instance. } constructor Create(AOwner: TComponent); override; { Text to show in the hint. } property Text: TKString read FText write SetText; end; { @abstract(Hint window to display graphic) This class implements the hint window to show an image. } TKGraphicHint = class(TKHintWindow) private FGraphic: TGraphic; procedure SetGraphic(const Value: TGraphic); protected { Overriden method. Paints the hint. } procedure Paint; override; public { Creates the instance. } constructor Create(AOwner: TComponent); override; { Image to show in the hint. } property Graphic: TGraphic read FGraphic write SetGraphic; end; TKSizingGripPosition = ( sgpNone, sgpLeft, sgpRight, sgpTop, sgpBottom, sgpTopLeft, sgpTopRight, sgpBottomLeft, sgpBottomRight ); TKSizingGrips = class private FBoundsRect: TRect; FGripColor: TColor; FGripSize: Integer; FMidGripConstraint: Integer; protected function GripRect(APosition: TKSizingGripPosition): TRect; public constructor Create; class procedure ClsAffectRect(APosition: TKSizingGripPosition; ADX, ADY: Integer; var ARect: TRect); procedure DrawTo(ACanvas: TCanvas); function HitTest(const APoint: TPoint): TKSizingGripPosition; function CursorAt(const APoint: TPoint): TCursor; function CursorFor(APosition: TKSizingGripPosition): TCursor; property BoundsRect: TRect read FBoundsRect write FBoundsRect; property GripColor: TColor read FGripColor write FGripColor default cSizingGripColor; property GripSize: Integer read FGripSize write FGripSize default cSizingGripSize; property MidGripConstraint: Integer read FMidGripConstraint write FMidGripConstraint default cSizingMidGripConstraint; end; { Draws Src to Dest with per pixel weighting by alpha channel saved in Src. } procedure BlendLine(Src, Dest: PKColorRecs; Count: Integer); { Calculates a brighter color of given color based on the HSL color space. } function BrightColor(Color: TColor; Percent: Single; Mode: TKBrightMode = bsAbsolute): TColor; { Returns current canvas window/wiewport scaling. } procedure CanvasGetScale(ACanvas: TCanvas; out MulX, MulY, DivX, DivY: Integer); { Selects the default window/wiewport scaling to given canvas for both axes. } procedure CanvasResetScale(ACanvas: TCanvas); { Returns True if the ACanvas's device context has been mapped to anything else than MM_TEXT. } function CanvasScaled(ACanvas: TCanvas): Boolean; { Selects the window/wiewport scaling to given canvas for both axes. } procedure CanvasSetScale(ACanvas: TCanvas; MulX, MulY, DivX, DivY: Integer); { Selects the wiewport offset to given canvas for both axes. } procedure CanvasSetOffset(ACanvas: TCanvas; OfsX, OfsY: Integer); { Converts TKColorRec to TColor. } function ColorRecToColor(Color: TKColorRec): TColor; { Converts TColor to TKColorRec. } function ColorToColorRec(Color: TColor): TKColorRec; {$IFDEF FPC} { Converts TKColorRec to TFPColor. } function ColorRecToFPColor(Color: TKColorRec): TFPColor; { Converts TFPColor to TKColorRec. } function FPColorToColorRec(Color: TFPColor): TKColorRec; {$ENDIF} { Makes a grayscale representation of the given color. } function ColorToGrayScale(Color: TColor): TColor; { Returns True if properties of the two brushes are equal. } function CompareBrushes(ABrush1, ABrush2: TBrush): Boolean; { Returns True if properties of the two fonts are equal. } function CompareFonts(AFont1, AFont2: TFont): Boolean; { Calls BitBlt. } procedure CopyBitmap(DestDC: HDC; DestRect: TRect; SrcDC: HDC; SrcX, SrcY: Integer); { Creates an empty point. } function CreateEmptyPoint: TPoint; { Creates an empty point. } function CreateEmptyPoint64: TKPoint64; { Creates an empty rectangle. } function CreateEmptyRect: TRect; { Creates an empty rectangle. } function CreateEmptyRect64: TKRect64; { Creates an empty rectangular region. } function CreateEmptyRgn: HRGN; { Draws Text to the Canvas at location given by ARect. This function is here for backward compatibility. HAlign and VAlign specify horizontal resp. vertical alignment of the text within ARect. HPadding and VPadding specify horizontal (both on left and right side) and vertical (both on top and bottom side) padding of the Text from ARect. BackColor specifies the fill color for brush gaps if a non solid Brush is defined in Canvas. Attributes specift various text output attributes. } procedure DrawAlignedText(Canvas: TCanvas; var ARect: TRect; HAlign: TKHAlign; VAlign: TKVAlign; HPadding, VPadding: Integer; const AText: TKString; BackColor: TColor = clWhite; Attributes: TKTextAttributes = []); { Draws standard button frame } procedure DrawButtonFrame(ACanvas: TCanvas; const ARect: TRect; AStates: TKButtonDrawStates); { Simulates WinAPI DrawEdge with customizable colors. } procedure DrawEdges(Canvas: TCanvas; const R: TRect; HighlightColor, ShadowColor: TColor; Flags: Cardinal); { Draws a rectangle to Canvas. The rectangle coordinates are given by Rect. The rectangle is filled by Brush. If Brush is not solid, its gaps are filled with BackColor. If BackColor is clNone these gaps are not filled and the Brush appears transparent. } procedure DrawFilledRectangle(Canvas: TCanvas; const ARect: TRect; BackColor: TColor); { Fills rectangle with linear gradient. Parameters should be self explaining. } procedure DrawGradientRect(Canvas: TCanvas; const ARect: TRect; AStartColor, AEndColor: TColor; AColorStep: Integer; AHorizontal: Boolean); { This helper function excludes a rectangular area occupied by a shape from BaseRect and calculates the shape area rectangles Bounds and Interior. The shape area is specified by the shape extent (ShapeWidth and ShapeHeight), padding (HPadding and VPadding) and stretching mode (StretchMode). The returned Bounds includes (possibly stretched) shape + padding, and Interior includes only the (possibly stretched) shape. HAlign specifies the horizontal alignment of shape area within BaseRect. VAlign specifies the vertical alignment of shape area within BaseRect. The shape area is always excluded horizontally from BaseRect, as needed by cell data calculations in KGrid. } procedure ExcludeShapeFromBaseRect(var BaseRect: TRect; ShapeWidth, ShapeHeight: Integer; HAlign: TKHAlign; VAlign: TKVAlign; HPadding, VPadding: Integer; StretchMode: TKStretchMode; out Bounds, Interior: TRect); { Selects ARect into device context. Returns previous clipping region. } function ExtSelectClipRect(DC: HDC; ARect: TRect; Mode: Integer; var PrevRgn: HRGN): Boolean; { Selects ARect into device context. Combines with CurRgn and returns previous clipping region. Both regions have to be created first. } function ExtSelectClipRectEx(DC: HDC; ARect: TRect; Mode: Integer; CurRgn, PrevRgn: HRGN): Boolean; { Fills the area specified by the difference Boundary - Interior on ACanvas with current Brush. If Brush is not solid, its gaps are filled with BackColor. If BackColor is clNone these gaps are not filled and the Brush appears transparent. } procedure FillAroundRect(ACanvas: TCanvas; const Boundary, Interior: TRect; BackColor: TColor); { Determine the height (ascent + descent) of the font currently selected into given DC. } function GetFontHeight(DC: HDC): Integer; { Determine the ascent of the font currently selected into given DC. } function GetFontAscent(DC: HDC): Integer; { Determine the descent of the font currently selected into given DC. } function GetFontDescent(DC: HDC): Integer; { Determine average character size for given DC. } function GetAveCharSize(DC: HDC): TSize; { Determine checkbox frame size. } function GetCheckBoxSize: TSize; { Try to determine image DPI. } function GetImageDPI(AGraphic: Tgraphic): TPoint; { Raises an exception if GDI resource has not been created. } function GDICheck(Value: Integer): Integer; { Returns horizontal position of shape within ABoundary according to AAlignment. Shape has size defined by AShapeSize. } function HorizontalShapePosition(AAlignment: TKHAlign; const ABoundary: TRect; const AShapeSize: TPoint): Integer; { Creates a TGraphic instance according to the image file header. Currently supported images are BMP, PNG, MNG, JPG, ICO. } function ImageByType(const Header: TKImageHeaderString): TGraphic; { Calls the IntersectClipRect function. } function IntersectClipRectIndirect(DC: HDC; ARect: TRect): Boolean; { Determines if given color has lightness > 0.5. } function IsBrightColor(Color: TColor): Boolean; { Loads a custom mouse cursor. } procedure LoadCustomCursor(Cursor: TCursor; const ResName: string); { Loads graphic from resource. } procedure LoadGraphicFromResource(Graphic: TGraphic; const ResName: string; ResType: PChar); { Loads picture from clipboard. Clipboard should have CF_PICTURE format. } procedure LoadPictureFromClipboard(APicture: TPicture; APreferredFormat: TKClipboardFormat); { Builds a TKColorRec structure. } function MakeColorRec(R, G, B, A: Byte): TKColorRec; overload; { Builds a TKColorRec structure. } function MakeColorRec(Value: LongWord): TKColorRec; overload; { Returns a pixel format that matches Bpp. } function PixelFormatFromBpp(Bpp: Cardinal): TPixelFormat; { In Lazarus this WinAPI function is missing. } function RectInRegion(Rgn: HRGN; ARect: TRect): Boolean; { Creates the region and copies the device context's current region into it. } function RgnCreateAndGet(DC: HDC): HRGN; { Selects the region into given device context and deletes the region. } procedure RgnSelectAndDelete(DC: HDC; Rgn: HRGN); { Paints rectangle with rounded corners. } procedure RoundRectangle(ACanvas: TCanvas; const ARect: TRect; AXRadius, AYRadius: Integer); { Paints an image so that it fits in ARect. Performs double buffering and fills the background with current brush for mapped device contexts. } procedure SafeStretchDraw(ACanvas: TCanvas; ARect: TRect; AGraphic: TGraphic; ABackColor: TColor = clWhite); { Selects ARect as new clipping region into the device context. } procedure SelectClipRect(DC: HDC; const ARect: TRect); { Calls StretchBlt. } procedure StretchBitmap(DestDC: HDC; DestRect: TRect; SrcDC: HDC; SrcRect: TRect); { Swaps the color format from RGB to BGR and vice versa. } function SwitchRGBToBGR(Value: TColor): TColor; { Subtracts the current device context offset from ARect. } procedure TranslateRectToDevice(DC: HDC; var ARect: TRect); { Returns vertical position of shape within ABoundary according to AAlignment. Shape has size defined by AShapeSize. } function VerticalShapePosition(AAlignment: TKVAlign; const ABoundary: TRect; const AShapeSize: TPoint): Integer; implementation uses ClipBrd, Math, SysUtils, KRes; procedure BlendLine(Src, Dest: PKColorRecs; Count: Integer); var I: Integer; R, G, B, A1, A2: Integer; begin // without assembler for I := 0 to Count - 1 do begin A1 := Src[I].A; A2 := 255 - A1; Inc(A1); Inc(A2); R := Src[I].R * A1 + Dest[I].R * A2; G := Src[I].G * A1 + Dest[I].G * A2; B := Src[I].B * A1 + Dest[I].B * A2; Dest[I].R := R shr 8; Dest[I].G := G shr 8; Dest[I].B := B shr 8; end; end; function CalcLightness(Color: TColor): Single; var X: TKColorRec; begin X := ColorToColorRec(Color); Result := (X.R + X.G + X.B) / (3 * 256); end; function BrightColor(Color: TColor; Percent: Single; Mode: TKBrightMode): TColor; var L, Tmp: Single; function Func1(Value: Single): Single; begin Result := Value * (L + Percent) / L; end; function Func2(Value: Single): Single; begin Result := 1 - (0.5 - Tmp) * (1 - Value) / (1 - L); { this is the shorter form of Value := 1 - 0.5 * (1 - Value) / (1 - L) ; // get color with L = 0.5 Result := 1 - (0.5 - Tmp) * (1 - Value) / 0.5; // get corresponding color } end; function Rd(Value: Single): Byte; begin Result := Min(Integer(Round(Value * 255)), 512); end; var R, G, B, Cmax, Cmin: Single; X: TKColorRec; begin X := ColorToColorRec(Color); R := X.R / 255; G := X.G / 255; B := X.B / 255; Cmax := Max(R, Max(G, B)); Cmin := Min(R, Min(G, B)); L := (Cmax + Cmin) / 2; if L < 1 then begin case Mode of bsOfBottom: Percent := L * Percent; bsOfTop: Percent := (1 - L) * Percent; end; Percent := Min(Percent, 1 - L); if L = 0 then begin // zero length singularity R := R + Percent; G := G + Percent; B := B + Percent; end else begin Tmp := L + Percent - 0.5; // lumination below 0.5 if L < 0.5 then begin // if L + Percent is >= 0.5, get color with L = 0.5 Percent := Min(Percent, 0.5 - L); R := Func1(R); G := Func1(G); B := Func1(B); L := 0.5; end; // lumination above 0.5 if Tmp > 0 then begin R := Func2(R); G := Func2(G); B := Func2(B); end; end; X.R := Rd(R); X.G := Rd(G); X.B := Rd(B); end; Result := X.Value; end; procedure CanvasGetScale(ACanvas: TCanvas; out MulX, MulY, DivX, DivY: Integer); {$IFDEF USE_DC_MAPPING} var WindowExt, ViewPortExt: TSize; {$ENDIF} begin {$IFDEF USE_DC_MAPPING} if Boolean(GetWindowExtEx(ACanvas.Handle, {$IFDEF FPC}@{$ENDIF}WindowExt)) and Boolean(GetViewPortExtEx(ACanvas.Handle, {$IFDEF FPC}@{$ENDIF}ViewPortExt)) then begin DivX := WindowExt.cx; DivY := WindowExt.cy; MulX := ViewPortExt.cx; MulY := ViewPortExt.cy; end else {$ENDIF} begin MulX := 1; DivX := 1; MulY := 1; DivY := 1; end; end; procedure CanvasResetScale(ACanvas: TCanvas); begin {$IFDEF USE_DC_MAPPING} SetMapMode(ACanvas.Handle, MM_TEXT); {$ENDIF} end; function CanvasScaled(ACanvas: TCanvas): Boolean; begin {$IFDEF USE_DC_MAPPING} Result := not (GetMapMode(ACanvas.Handle) in [0, MM_TEXT]); {$ELSE} Result := False; {$ENDIF} end; procedure CanvasSetScale(ACanvas: TCanvas; MulX, MulY, DivX, DivY: Integer); begin {$IFDEF USE_DC_MAPPING} SetMapMode(ACanvas.Handle, MM_ANISOTROPIC); SetWindowExtEx(ACanvas.Handle, DivX, DivY, nil); SetViewPortExtEx(ACanvas.Handle, MulX, MulY, nil); {$ELSE} {$WARNING 'Device context window/viewport transformations not working!'} {$ENDIF} end; procedure CanvasSetOffset(ACanvas: TCanvas; OfsX, OfsY: Integer); begin {$IFDEF USE_DC_MAPPING} SetMapMode(ACanvas.Handle, MM_ANISOTROPIC); SetViewPortOrgEx(ACanvas.Handle, OfsX, OfsY, nil); {$ENDIF} end; function ColorToGrayScale(Color: TColor): TColor; var GreyValue: Integer; X: TKColorRec; begin X := ColorToColorRec(Color); GreyValue := (Integer(21) * X.R + Integer(72) * X.G + Integer(7) * X.B) div 100; X.R := GreyValue; X.G := GreyValue; X.B := GreyValue; Result := X.Value; end; function ColorRecToColor(Color: TKColorRec): TColor; begin Result := Color.Value and $FFFFFF; end; function ColorToColorRec(Color: TColor): TKColorRec; begin Result.Value := ColorToRGB(Color); end; {$IFDEF FPC} function ColorRecToFPColor(Color: TKColorRec): TFPColor; begin Result.Red := Color.R; Result.Red := Result.Red + (Result.Red shl 8); Result.Green := Color.G; Result.Green := Result.Green + (Result.Green shl 8); Result.Blue := Color.B; Result.Blue := Result.Blue + (Result.Blue shl 8); Result.Alpha := Color.A; Result.Alpha := Result.Alpha + (Result.Alpha shl 8); end; function FPColorToColorRec(Color: TFPColor): TKColorRec; begin Result.R := Color.Red shr 8; Result.G := Color.Green shr 8; Result.B := Color.Blue shr 8; Result.A := Color.Alpha shr 8; end; {$ENDIF} function CompareBrushes(ABrush1, ABrush2: TBrush): Boolean; begin Result := (ABrush1.Color = ABrush2.Color) and (ABrush1.Style = ABrush2.Style); end; function CompareFonts(AFont1, AFont2: TFont): Boolean; begin Result := (AFont1.Charset = AFont2.Charset) and (AFont1.Color = AFont2.Color) and (AFont1.Name = AFont2.Name) and (AFont1.Pitch = AFont2.Pitch) and (AFont1.Size = AFont2.Size) and (AFont1.Style = AFont2.Style); end; procedure CopyBitmap(DestDC: HDC; DestRect: TRect; SrcDC: HDC; SrcX, SrcY: Integer); begin {$IFDEF MSWINDOWS}Windows.{$ENDIF}BitBlt(DestDC, DestRect.Left, DestRect.Top, DestRect.Right - DestRect.Left, DestRect.Bottom - DestRect.Top, SrcDC, 0, 0, SRCCOPY); end; function CreateEmptyPoint: TPoint; begin Result := Point(0,0); end; function CreateEmptyPoint64: TKPoint64; begin Result := Point64(0,0); end; function CreateEmptyRect: TRect; begin Result := Rect(0,0,0,0); end; function CreateEmptyRect64: TKRect64; begin Result := Rect64(0,0,0,0); end; function CreateEmptyRgn: HRGN; begin Result := CreateRectRgn(0,0,0,0); end; procedure DrawAlignedText(Canvas: TCanvas; var ARect: TRect; HAlign: TKHAlign; VAlign: TKVAlign; HPadding, VPadding: Integer; const AText: TKString; BackColor: TColor; Attributes: TKTextAttributes); var TextBox: TKTextBox; Width, Height: Integer; begin TextBox := TKTextBox.Create; try TextBox.Attributes := Attributes; TextBox.BackColor := BackColor; TextBox.HAlign := HAlign; TextBox.HPadding := HPadding; TextBox.Text := AText; TextBox.VAlign := VAlign; TextBox.VPadding := VPadding; if taCalcRect in Attributes then begin TextBox.Measure(Canvas, ARect, Width, Height); ARect.Right := ARect.Left + Width; ARect.Bottom := ARect.Top + Height; end else TextBox.Draw(Canvas, ARect); finally TextBox.Free; end; end; procedure DrawButtonFrame(ACanvas: TCanvas; const ARect: TRect; AStates: TKButtonDrawStates); var BM: TBitmap; TmpCanvas: TCanvas; TmpRect: TRect; ButtonState: Integer; {$IFDEF USE_THEMES} ButtonTheme: TThemedButton; {$ENDIF} begin // a LOT of tweaking here... {$IF DEFINED(MSWINDOWS) OR DEFINED(LCLQT) } // GTK2 cannot strech and paint on bitmap canvas, grrr.. if CanvasScaled(ACanvas) {$IFDEF MSWINDOWS}and (bsUseThemes in AStates){$ENDIF} then begin BM := TBitmap.Create; BM.Width := ARect.Right - ARect.Left; BM.Height := ARect.Bottom - ARect.Top; BM.Canvas.Brush.Assign(ACanvas.Brush); TmpRect := Rect(0, 0, BM.Width, BM.Height); BM.Canvas.FillRect(TmpRect); TmpCanvas := BM.Canvas; end else {$IFEND} begin BM := nil; TmpRect := ARect; TmpCanvas := ACanvas; end; try {$IFDEF USE_THEMES} if bsUseThemes in AStates then begin if bsDisabled in AStates then ButtonTheme := tbPushButtonDisabled else if bsPressed in AStates then ButtonTheme := tbPushButtonPressed else if bsHot in AStates then ButtonTheme := tbPushButtonHot else if bsFocused in AStates then ButtonTheme := tbPushButtonDefaulted else ButtonTheme := tbPushButtonNormal; ThemeServices.DrawElement(TmpCanvas.Handle, ThemeServices.GetElementDetails(ButtonTheme), TmpRect); end else {$ENDIF} begin ButtonState := DFCS_BUTTONPUSH; if bsDisabled in AStates then ButtonState := ButtonState or DFCS_INACTIVE else if bsPressed in AStates then ButtonState := ButtonState or DFCS_PUSHED else if bsHot in AStates then ButtonState := ButtonState or DFCS_HOT; DrawFrameControl(TmpCanvas.Handle, TmpRect, DFC_BUTTON, ButtonState); end; if BM <> nil then ACanvas.Draw(ARect.Left, ARect.Top, BM); finally BM.Free; end; end; procedure DrawEdges(Canvas: TCanvas; const R: TRect; HighlightColor, ShadowColor: TColor; Flags: Cardinal); begin with Canvas do begin Brush.Style := bsSolid; Brush.Color := HighlightColor; if Flags and BF_LEFT <> 0 then FillRect(Rect(R.Left, R.Top + 1, R.Left + 1, R.Bottom)); if Flags and BF_TOP <> 0 then FillRect(Rect(R.Left, R.Top, R.Right, R.Top + 1)); Brush.Color := ShadowColor; if Flags and BF_RIGHT <> 0 then FillRect(Rect(R.Right - 1, R.Top + 1, R.Right, R.Bottom)); if Flags and BF_BOTTOM <> 0 then FillRect(Rect(R.Left + 1, R.Bottom - 1, R.Right - 1, R.Bottom)); end; end; procedure DrawFilledRectangle(Canvas: TCanvas; const ARect: TRect; BackColor: TColor); var DC: HDC; begin DC := Canvas.Handle; if BackColor <> clNone then begin SetBkMode(DC, OPAQUE); SetBkColor(DC, ColorToRGB(BackColor)); end; FillRect(DC, ARect, Canvas.Brush.Handle); end; procedure DrawGradientRect(Canvas: TCanvas; const ARect: TRect; AStartColor, AEndColor: TColor; AColorStep: Integer; AHorizontal: Boolean); var J, OldJ, Extent, Num: Integer; L: Byte; CS, CE: TKColorRec; RCnt, GCnt, BCnt: Longint; RInc, GInc, BInc: Longint; B: Boolean; R: TRect; function NumToRGB(Num: Cardinal): TKColorRec; begin Result.R := Byte(Num shr 16); Result.G := Byte(Num shr 8); Result.B := Byte(Num); end; function RGBToNum(Col: TKColorRec): Cardinal; begin Result := Cardinal(Col.R) shl 16 + Cardinal(Col.G) shl 8 + Col.B; end; begin with Canvas do begin if AHorizontal then Extent := ARect.Right - ARect.Left - 1 else Extent := ARect.Bottom - ARect.Top - 1; Num := Max(Extent div AColorStep, 1); CS := NumToRGB(AStartColor); CE := NumToRGB(AEndColor); // colors per pixel RInc := (Integer(CE.R - CS.R) shl 16) div Extent; GInc := (Integer(CE.G - CS.G) shl 16) div Extent; Binc := (Integer(CE.B - CS.B) shl 16) div Extent; // start colors RCnt := CS.R shl 16; GCnt := CS.G shl 16; BCnt := CS.B shl 16; // drawing bar Brush.Color := RGBToNum(CS); OldJ := 0; B := False; for J := 0 to Extent do begin Inc(RCnt, RInc); L := Byte(RCnt shr 16); if L <> CS.R then begin CS.R := L; B := True; end; Inc(GCnt, GInc); L := Byte(GCnt shr 16); if L <> CS.G then begin CS.G := L; B := True; end; Inc(BCnt, BInc); L := Byte(BCnt shr 16); if L <> CS.B then begin CS.B := L; B := True; end; if B and (J mod Num = 0) then begin if AHorizontal then R := Rect(ARect.Left + OldJ, ARect.Top, ARect.Left + J, ARect.Bottom) else R := Rect(ARect.Left, ARect.Top + OldJ, ARect.Right, ARect.Top + J); FillRect(R); Brush.Color := RGBToNum(CS); OldJ := J; B := False; end; end; end; end; procedure ExcludeShapeFromBaseRect(var BaseRect: TRect; ShapeWidth, ShapeHeight: Integer; HAlign: TKHAlign; VAlign: TKVAlign; HPadding, VPadding: Integer; StretchMode: TKStretchMode; out Bounds, Interior: TRect); var MaxHeight, MaxWidth, StretchHeight, StretchWidth: Integer; RatioX, RatioY: Single; begin MaxHeight := BaseRect.Bottom - BaseRect.Top - 2 * VPadding; MaxWidth := BaseRect.Right - BaseRect.Left - HPadding; if ((MaxWidth <> ShapeWidth) or (MaxHeight <> ShapeHeight)) and ( (StretchMode = stmZoom) or (StretchMode = stmZoomInOnly) and (MaxWidth >= ShapeWidth) and (MaxHeight >= ShapeHeight) or (StretchMode = stmZoomOutOnly) and ((MaxWidth < ShapeWidth) or (MaxHeight < ShapeHeight)) ) then begin RatioX := MaxWidth / ShapeWidth; RatioY := MaxHeight / ShapeHeight; if RatioY >= RatioX then begin StretchWidth := MaxWidth; StretchHeight := ShapeHeight * StretchWidth div ShapeWidth; end else begin StretchHeight := MaxHeight; StretchWidth := ShapeWidth * StretchHeight div ShapeHeight; end; end else begin StretchHeight := ShapeHeight; StretchWidth := ShapeWidth; end; Bounds := BaseRect; Interior := BaseRect; case HAlign of halCenter: begin BaseRect.Right := BaseRect.Left; // BaseRect empty, no space for next item! // Bounds remains unchanged Inc(Interior.Left, HPadding + (MaxWidth - StretchWidth) div 2); end; halRight: begin Dec(BaseRect.Right, StretchWidth + HPadding); Bounds.Left := BaseRect.Right; // Bounds.Right remains unchanged Interior.Left := BaseRect.Right; end; else Inc(BaseRect.Left, StretchWidth + HPadding); // Bounds.Left remains unchanged Bounds.Right := BaseRect.Left; Inc(Interior.Left, HPadding); end; Interior.Right := Interior.Left + StretchWidth; case VAlign of valCenter: Inc(Interior.Top, VPadding + (MaxHeight - StretchHeight) div 2); valBottom: Interior.Top := BaseRect.Bottom - VPadding - StretchHeight; else Inc(Interior.Top, VPadding); end; Interior.Bottom := Interior.Top + StretchHeight; end; function ExtSelectClipRect(DC: HDC; ARect: TRect; Mode: Integer; var PrevRgn: HRGN): Boolean; var TmpRgn: HRGN; begin TmpRgn := CreateEmptyRgn; try Result := ExtSelectClipRectEx(DC, ARect, Mode, TmpRgn, PrevRgn) finally DeleteObject(TmpRgn); end; end; function ExtSelectClipRectEx(DC: HDC; ARect: TRect; Mode: Integer; CurRgn, PrevRgn: HRGN): Boolean; var RectRgn: HRGN; // R1, R2: TRect; begin RectRgn := CreateRectRgnIndirect(ARect); try // GetRgnBox(PrevRgn, R1); // debug line // GetRgnBox(RectRgn, R2); // debug line Result := CombineRgn(CurRgn, PrevRgn, RectRgn, Mode) <> NULLREGION; if Result then SelectClipRgn(DC, CurRgn) finally DeleteObject(RectRgn); end; end; procedure FillAroundRect(ACanvas: TCanvas; const Boundary, Interior: TRect; BackColor: TColor); var R: TRect; begin R := Rect(Boundary.Left, Boundary.Top, Boundary.Right, Interior.Top); if not IsRectEmpty(R) then DrawFilledRectangle(ACanvas, R, BackColor); R := Rect(Boundary.Left, Interior.Top, Interior.Left, Interior.Bottom); if not IsRectEmpty(R) then DrawFilledRectangle(ACanvas, R, BackColor); R := Rect(Interior.Right, Interior.Top, Boundary.Right, Interior.Bottom); if not IsRectEmpty(R) then DrawFilledRectangle(ACanvas, R, BackColor); R := Rect(Boundary.Left, Interior.Bottom, Boundary.Right, Boundary.Bottom); if not IsRectEmpty(R) then DrawFilledRectangle(ACanvas, R, BackColor); end; function GetFontHeight(DC: HDC): Integer; var TM: TTextMetric; begin FillChar(TM, SizeOf(TTextMetric), 0); GetTextMetrics(DC, TM); Result := TM.tmHeight; end; function GetFontAscent(DC: HDC): Integer; var TM: TTextMetric; begin FillChar(TM, SizeOf(TTextMetric), 0); GetTextMetrics(DC, TM); Result := TM.tmAscent; end; function GetFontDescent(DC: HDC): Integer; var TM: TTextMetric; begin FillChar(TM, SizeOf(TTextMetric), 0); GetTextMetrics(DC, TM); Result := TM.tmDescent; end; function GetAveCharSize(DC: HDC): TSize; var TM: TTextMetric; const Buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'; begin FillChar(TM, SizeOf(TTextMetric), 0); GetTextMetrics(DC, TM); GetTextExtentPoint32(DC, Buffer, 52, Result); Result.cx := (Result.cx div 26 + 1) div 2; //div uses trunc rounding; we want arithmetic rounding Result.cy := tm.tmHeight; end; function GetCheckBoxSize: TSize; {$IFDEF MSWINDOWS} var Bm: HBITMAP; BmSize: BITMAP; {$ENDIF} {$IFDEF FPC} {$ELSE} var Theme: HTHEME; {$ENDIF} begin Result.cx := 0; Result.cy := 0; {$IFDEF USE_THEMES} if ThemeServices.ThemesEnabled and ThemeServices.ThemesAvailable then begin {$IFDEF FPC} Result := ThemeServices.GetDetailSize(ThemeServices.GetElementDetails(tbCheckBoxCheckedNormal)); Exit; {$ELSE} Theme := ThemeServices.Theme[teButton]; if GetThemePartSize(Theme, 0, BP_CHECKBOX, CBS_CHECKEDNORMAL, nil, TS_TRUE, Result) = S_OK then Exit; {$ENDIF} end; {$ENDIF} {$IFDEF MSWINDOWS} Bm := LoadBitmap(0, PChar(OBM_CHECKBOXES)); if Bm <> 0 then try if GetObject(Bm, SizeOf(BmSize), @BmSize) = SizeOf(BmSize) then begin Result.cx := BmSize.bmWidth div 4; Result.cy := BmSize.bmHeight div 3; end; finally DeleteObject(Bm); end; {$ELSE} // just guessed here Result.cx := 13; Result.cy := 13; {$ENDIF} end; function GetImageDPI(AGraphic: Tgraphic): TPoint; procedure GetDPIFromJPeg(AJPeg: TJPegImage); const cInchesPerCM = (1 / 2.54); cBufferSize = 50; var MS: TMemoryStream; Index: Integer; Buffer: AnsiString; resUnits: Byte; xResolution: Word; yResolution: Word; begin // seek for XDensity and YDensity fields in JPEG header MS := TMemoryStream.Create; try AJPeg.SaveToStream(MS); MS.Seek(0, soFromBeginning); SetLength(Buffer, cBufferSize); MS.Read(Buffer[1], cBufferSize); Index := Pos(AnsiString('JFIF'+#$00), Buffer); if Index > 0 then begin MS.Seek(Index + 6, soFromBeginning); MS.Read(resUnits, 1); MS.Read(xResolution, 2); MS.Read(yResolution, 2); xResolution := Swap(xResolution); yResolution := Swap(yResolution); case resUnits of 1: // dots per inch begin Result.X := xResolution; Result.Y := yResolution; end; 2: // dots per cm begin Result.X := Round(xResolution / cInchesPerCM); Result.Y := Round(yResolution / cInchesPerCM); end; else Result.X := 96; Result.Y := MulDiv(96, yResolution, xResolution); end; end; finally MS.Free; end; end; {$IFDEF USE_PNG_SUPPORT} procedure GetDPIFromPng(APng: TKPngImage); const cInchesPerMeter = (100 / 2.54); {$IFDEF FPC} type TPngChunkCode = array[0..3] of AnsiChar; TPngChunkHdr = packed record clength: LongWord; ctype: TPngChunkCode; end; var MS: TMemoryStream; CLen, PPUnitX, PPUnitY: Cardinal; CHdr: TPngChunkHdr; CPHYsData: array[0..8] of Byte; {$ELSE} var Chunk: TChunk; {$ENDIF} begin {$IFDEF FPC} MS := TMemoryStream.Create; try APng.SaveToStream(MS); MS.Seek(8, soFromBeginning); // skip PNG header while MS.Position < MS.Size do begin // traverse the PNG chunks until pHYs chunk is found MS.Read(CHdr, SizeOf(CHdr)); CLen := SwapEndian(CHdr.clength); // suppose little endian if CHdr.ctype = 'pHYs' then begin MS.Read(CPHYsData, 9); // pHYs chunk is always 9 bytes long if CPHYsData[8] = 1 then // dots per meter begin PPUnitX := SwapEndian(PCardinal(@CPHYsData[0])^); // suppose little endian PPUnitY := SwapEndian(PCardinal(@CPHYsData[4])^); // suppose little endian Result.X := Round(PPUnitX / cInchesPerMeter); Result.Y := Round(PPUnitY / cInchesPerMeter); end; Exit; end else MS.Seek(CLen + SizeOf(LongWord), soFromCurrent); end; finally MS.Free; end; {$ELSE} // in Delphi we have the pHYs chunk directly accessible Chunk := APng.Chunks.FindChunk(TChunkpHYs); if Assigned(Chunk) then begin if (TChunkPhys(Chunk).UnitType = utMeter) then begin Result.X := Round(TChunkPhys(Chunk).PPUnitX / cInchesPerMeter); Result.Y := Round(TChunkPhys(Chunk).PPUnitY / cInchesPerMeter); end; end {$ENDIF} end; {$ENDIF} begin Result := Point(96, 96); // for unimplemented image types set screen dpi if AGraphic is TJPegImage then GetDPIFromJPeg(TJpegImage(AGraphic)) {$IFDEF USE_PNG_SUPPORT} else if AGraphic is TKPngImage then GetDPIFromPng(TKPngImage(AGraphic)); {$ENDIF} end; function GDICheck(Value: Integer): Integer; begin if Value = 0 then raise EOutOfResources.Create(sGDIError); Result := Value; end; function HorizontalShapePosition(AAlignment: TKHAlign; const ABoundary: TRect; const AShapeSize: TPoint): Integer; begin case AAlignment of halCenter: Result := ABoundary.Left + (ABoundary.Right - ABoundary.Left - AShapeSize.X) div 2; halRight: Result := ABoundary.Right - AShapeSize.X; else Result := ABoundary.Left; end; end; function ImageByType(const Header: TKImageHeaderString): TGraphic; begin if Pos('BM', {$IFDEF COMPILER12_UP}string{$ENDIF}(Header)) = 1 then Result := TBitmap.Create {$IFDEF USE_PNG_SUPPORT } else if (Pos(#$89'PNG', {$IFDEF COMPILER12_UP}string{$ENDIF}(Header)) = 1) or (Pos(#$8A'MNG', {$IFDEF COMPILER12_UP}string{$ENDIF}(Header)) = 1) then Result := TKPngImage.Create {$ENDIF } else if (Pos(#$FF#$D8, {$IFDEF COMPILER12_UP}string{$ENDIF}(Header)) = 1) then Result := TJPegImage.Create else if (Pos(#$00#$00, {$IFDEF COMPILER12_UP}string{$ENDIF}(Header)) = 1) then Result := TIcon.Create else Result := nil; end; function IntersectClipRectIndirect(DC: HDC; ARect: TRect): Boolean; begin with ARect do Result := IntersectClipRect(DC, Left, Top, Right, Bottom) <> NULLREGION; end; function IsBrightColor(Color: TColor): Boolean; begin Result := CalcLightness(Color) > 0.5; end; function MakeColorRec(R, G, B, A: Byte): TKColorRec; begin Result.R := R; Result.G := G; Result.B := B; Result.A := A; end; function MakeColorRec(Value: LongWord): TKColorRec; begin Result.Value := Value; end; procedure LoadCustomCursor(Cursor: TCursor; const ResName: string); begin Screen.Cursors[Cursor] := {$IFDEF FPC} LoadCursorFromLazarusResource(ResName); {$ELSE} LoadCursor(HInstance, PChar(ResName)); {$ENDIF} end; procedure LoadGraphicFromResource(Graphic: TGraphic; const ResName: string; ResType: PChar); {$IFNDEF FPC} var Stream: TResourceStream; {$ENDIF} begin if Graphic <> nil then try {$IFDEF FPC} try Graphic.LoadFromResourceName(HInstance, ResName); except Graphic.LoadFromLazarusResource(ResName); end; {$ELSE} Stream := TResourceStream.Create(HInstance, ResName, ResType); try Graphic.LoadFromStream(Stream); finally Stream.Free; end; {$ENDIF} except Error(sErrGraphicsLoadFromResource); end; end; procedure LoadPictureFromClipboard(APicture: TPicture; APreferredFormat: TKClipboardFormat); begin try {$IFDEF FPC} APicture.LoadFromClipboardFormat(APreferredFormat); {$ELSE} APicture.LoadFromClipboardFormat(APreferredFormat, Clipboard.GetAsHandle(APreferredFormat), 0); {$ENDIF} except APicture.Assign(ClipBoard); end; end; function PixelFormatFromBpp(Bpp: Cardinal): TPixelFormat; begin case Bpp of 1: Result := pf1bit; 2..4: Result := pf4bit; 5..8: Result := pf8bit; 9..16: Result := pf16bit; else Result := pf32bit; end; end; function RectInRegion(Rgn: HRGN; ARect: TRect): Boolean; {$IFDEF FPC} var RectRgn, TmpRgn: HRGN; {$ENDIF} begin {$IFDEF FPC} RectRgn := CreateRectRgnIndirect(ARect); try TmpRgn := CreateEmptyRgn; try Result := CombineRgn(TmpRgn, RectRgn, Rgn, RGN_AND) <> NULLREGION; finally DeleteObject(TmpRgn); end; finally DeleteObject(RectRgn); end; {$ELSE} Result := Windows.RectInRegion(Rgn, ARect); {$ENDIF} end; function RgnCreateAndGet(DC: HDC): HRGN; //var // R: TRect; begin Result := CreateEmptyRgn; GetClipRgn(DC, Result); // GetRgnBox(Result, R); // debug line end; procedure RgnSelectAndDelete(DC: HDC; Rgn: HRGN); begin SelectClipRgn(DC, Rgn); DeleteObject(Rgn); end; procedure RoundRectangle(ACanvas: TCanvas; const ARect: TRect; AXRadius, AYRadius: Integer); begin {$IF DEFINED(COMPILER12_UP) OR DEFINED(FPC)} ACanvas.RoundRect(ARect, AXRadius, AYRadius) {$ELSE} ACanvas.RoundRect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, AXRadius, AYRadius) {$IFEND} end; procedure SafeStretchDraw(ACanvas: TCanvas; ARect: TRect; AGraphic: TGraphic; ABackColor: TColor); {$IFDEF MSWINDOWS} {var BM: TBitmap; W, H, MulX, MulY, DivX, DivY: Integer; R: TRect;} {$ENDIF} begin {$IFDEF MSWINDOWS} // tk: I cannot see problem with StretchBlt anymore, perhaps it was in old Windows XP? // Even if so, following implementation is buggy: {if AGraphic.Transparent then begin // WinAPI StretchBlt function does not read properly from screen buffer // so we have to append double buffering CanvasGetScale(ACanvas, MulX, MulY, DivX, DivY); W := MulDiv(ARect.Right - ARect.Left, MulX, DivX); H := MulDiv(ARect.Bottom - ARect.Top, MulY, DivY); BM := TBitmap.Create; try BM.Width := W; BM.Height := H; BM.Canvas.Brush := ACanvas.Brush; R := Rect(0, 0, W, H); DrawFilledRectangle(BM.Canvas, R, ABackColor); BM.Canvas.StretchDraw(R, AGraphic); ACanvas.StretchDraw(ARect, BM); finally BM.Free; end; end else} {$ENDIF} ACanvas.StretchDraw(ARect, AGraphic); end; procedure SelectClipRect(DC: HDC; const ARect: TRect); var Rgn: HRGN; begin Rgn := CreateRectRgnIndirect(ARect); try SelectClipRgn(DC, Rgn); finally DeleteObject(Rgn); end; end; procedure StretchBitmap(DestDC: HDC; DestRect: TRect; SrcDC: HDC; SrcRect: TRect); begin {$IFDEF MSWINDOWS} SetStretchBltMode(DestDC, HALFTONE); {$ENDIF} {$IFDEF MSWINDOWS}Windows.{$ENDIF}StretchBlt(DestDC, DestRect.Left, DestRect.Top, DestRect.Right - DestRect.Left, DestRect.Bottom - DestRect.Top, SrcDC, SrcRect.Left, SrcRect.Top, SrcRect.Right - SrcRect.Left, SrcRect.Bottom - SrcRect.Top, SRCCOPY); end; procedure SwapBR(var ColorRec: TKColorRec); var Tmp: Byte; begin Tmp := ColorRec.R; ColorRec.R := ColorRec.B; ColorRec.B := Tmp; end; function SwitchRGBToBGR(Value: TColor): TColor; var B: Byte; begin Result := Value; B := PKColorRec(@Value).B; PKColorRec(@Result).B := PKColorRec(@Result).R; PKColorRec(@Result).R := B; end; procedure TranslateRectToDevice(DC: HDC; var ARect: TRect); var WindowOrg, ViewportOrg: TPoint; {$IFDEF USE_DC_MAPPING} {$IFNDEF LCLQT} WindowExt, ViewportExt: TSize; {$ENDIF} {$ENDIF} begin if Boolean(GetWindowOrgEx(DC, {$IFDEF FPC}@{$ENDIF}WindowOrg)) then KFunctions.OffsetRect(ARect, -WindowOrg.X, -WindowOrg.Y); {$IFDEF USE_DC_MAPPING} {$IFNDEF LCLQT} if not (GetMapMode(DC) in [0, MM_TEXT]) and Boolean(GetWindowExtEx(DC, {$IFDEF FPC}@{$ENDIF}WindowExt)) and Boolean(GetViewportExtEx(DC, {$IFDEF FPC}@{$ENDIF}ViewportExt)) then begin ARect.Left := MulDiv(ARect.Left, ViewportExt.cx, WindowExt.cx); ARect.Right := MulDiv(ARect.Right, ViewportExt.cx, WindowExt.cx); ARect.Top := MulDiv(ARect.Top, ViewportExt.cy, WindowExt.cy); ARect.Bottom := MulDiv(ARect.Bottom, ViewportExt.cy, WindowExt.cy); end; if Boolean(GetViewPortOrgEx(DC, {$IFDEF FPC}@{$ENDIF}ViewportOrg)) then KFunctions.OffsetRect(ARect, ViewportOrg); {$ENDIF} {$ENDIF} end; function VerticalShapePosition(AAlignment: TKVAlign; const ABoundary: TRect; const AShapeSize: TPoint): Integer; begin case AAlignment of valCenter: Result := ABoundary.Top + (ABoundary.Bottom - ABoundary.Top - AShapeSize.Y) div 2; valBottom: Result := ABoundary.Bottom - AShapeSize.Y; else Result := ABoundary.Top; end; end; { TKGraphic } constructor TKGraphic.Create; begin inherited; FDescription := ''; FFileFilter := ''; end; { TKAlphaBitmap } constructor TKAlphaBitmap.Create; begin inherited; FCanvas := TCanvas.Create; FCanvas.Handle := CreateCompatibleDC(0); FUpdateLock := 0; FAutoMirror := True; FDescription := 'KControls alpha bitmap'; FDirectCopy := False; FFileFilter := '*.bma;*.bmp;*.png;*.jpg'; FHandle := 0; {$IFNDEF MSWINDOWS} FImage := TLazIntfImage.Create(0, 0); {$ENDIF} FHeight := 0; FOldBitmap := 0; FPixels := nil; FPixelsChanged := False; FWidth := 0; end; constructor TKAlphaBitmap.CreateFromRes(const ResName: string); var Stream: {$IFDEF FPC}TLazarusResourceStream{$ELSE}TResourceStream{$ENDIF}; begin Create; try {$IFDEF FPC} Stream := TLazarusResourceStream.Create(LowerCase(ResName), 'BMP'); {$ELSE} Stream := TResourceStream.Create(HInstance, ResName, RT_RCDATA); {$ENDIF} try LoadFromStream(Stream); finally Stream.Free; end; except Error(sErrGraphicsLoadFromResource); end; end; destructor TKAlphaBitmap.Destroy; var DC: HDC; begin LockUpdate; SetSize(0, 0); {$IFNDEF MSWINDOWS} FImage.Free; {$ENDIF} DC := FCanvas.Handle; FCanvas.Handle := 0; DeleteDC(DC); FCanvas.Free; inherited; end; procedure TKAlphaBitmap.AlphaDrawTo(ACanvas: TCanvas; X, Y: Integer); begin AlphaStretchDrawTo(ACanvas, Rect(X, Y, X + FWidth, Y + FHeight)); end; procedure TKAlphaBitmap.AlphaFill(Alpha: Byte; IfEmpty: Boolean); var I: Integer; LocHasAlpha: Boolean; begin LocHasAlpha := False; if IfEmpty then LocHasAlpha := HasAlpha; if not LocHasAlpha then begin LockUpdate; try for I := 0 to FWidth * FHeight - 1 do FPixels[I].A := Alpha; finally UnlockUpdate; end; end; end; procedure TKAlphaBitmap.AlphaFillOnColorMatch(AColor: TColor; AAlpha: Byte); var I: Integer; CS: TKColorRec; begin LockUpdate; try CS := ColorToColorRec(AColor); SwapBR(CS); for I := 0 to FWidth * FHeight - 1 do if (FPixels[I].R = CS.R) and (FPixels[I].G = CS.G) and (FPixels[I].B = CS.B) then FPixels[I].A := AAlpha; finally UnlockUpdate; end; end; procedure TKAlphaBitmap.AlphaFillPercent(Percent: Integer; IfEmpty: Boolean); var I: Integer; begin LockUpdate; try for I := 0 to FWidth * FHeight - 1 do if FPixels[I].A <> 0 then FPixels[I].A := Percent * FPixels[I].A div 100 else if IfEmpty then FPixels[I].A := Percent * 255 div 100; finally UnlockUpdate; end; end; procedure TKAlphaBitmap.AlphaFill(Alpha: Byte; BlendColor: TColor; Gradient, Translucent: Boolean); var I, J, A1, A2, AR, AG, AB, HAlpha: Integer; HStep, HSum, VStep, VSum: Single; Scan: PKColorRecs; CS: TKColorRec; begin LockUpdate; try VSum := 0; VStep := 0; HSum := 0; HStep := 0; if Gradient then begin VStep := Alpha / FHeight; VSum := Alpha; end; CS := ColorToColorRec(BlendColor); {$IFNDEF MSWINDOWS} for I := 0 to FHeight - 1 do {$ELSE} for I := FHeight - 1 downto 0 do {$ENDIF} begin Scan := ScanLine[I]; HAlpha := Alpha; if Gradient then begin HStep := HAlpha / FWidth; HSum := HAlpha; end; for J := 0 to FWidth - 1 do with Scan[J] do begin A1 := HAlpha; A2 := 255 - HAlpha; AR := R * A1 + CS.R * A2; AG := G * A1 + CS.G * A2; AB := B * A1 + CS.B * A2; R := AR shr 8; G := AG shr 8; B := AB shr 8; if Translucent then A := HAlpha else A := 255; if Gradient then begin HAlpha := Round(HSum); HSum := HSum - HStep; end; end; if Gradient then begin Alpha := Round(VSum); VSum := VSum - VStep; end; end; finally UnlockUpdate; end; end; procedure TKAlphaBitmap.AlphaStretchDrawTo(ACanvas: TCanvas; const ARect: TRect); {$IF DEFINED(MSWINDOWS) OR DEFINED(LCLGTK) OR DEFINED(LCLGTK2)} var I: Integer; Tmp: TKAlphaBitmap; Ps, Pd: PKColorRecs; {$IFEND} begin {$IF DEFINED(MSWINDOWS) OR DEFINED(LCLGTK) OR DEFINED(LCLGTK2)} Tmp := TKAlphaBitmap.Create; try Tmp.SetSize(FWidth, FHeight); Tmp.Fill(MakeColorRec(255, 255, 255, 0)); Tmp.DrawFrom(ACanvas, ARect); for I := 0 to FHeight - 1 do begin Ps := ScanLine[I]; Pd := Tmp.ScanLine[I]; BlendLine(Ps, Pd, FWidth); end; Tmp.PixelsChanged := True; Tmp.DrawTo(ACanvas, ARect); finally Tmp.Free; end; {$ELSE} DrawTo(ACanvas, ARect); {$IFEND} end; procedure TKAlphaBitmap.Assign(Source: TPersistent); begin if Source = nil then SetSize(0, 0) else if Source is TKAlphaBitmap then TKAlphaBitmap(Source).AssignTo(Self) else if Source is TGraphic then LoadFromGraphic(TGraphic(Source)) else inherited; end; procedure TKAlphaBitmap.AssignTo(Dest: TPersistent); begin if Dest is TKAlphaBitmap then with TKAlphaBitmap(Dest) do begin AutoMirror := Self.AutoMirror; DirectCopy := Self.DirectCopy; CopyFrom(Self); end end; procedure TKAlphaBitmap.Clear; var I: Integer; begin LockUpdate; try for I := 0 to FWidth * FHeight - 1 do FPixels[I].Value := 0; finally UnlockUpdate; end; end; procedure TKAlphaBitmap.Changed(Sender: TObject); begin inherited; FPixelsChanged := True; end; procedure TKAlphaBitmap.CombinePixel(X, Y: Integer; Color: TKColorRec); var Index, A1, A2, AR, AG, AB: Integer; begin if (X >= 0) and (X < FWidth) and (Y >= 0) and (Y < FHeight) then begin LockUpdate; try SwapBR(Color); {$IFDEF MSWINDOWS} Index := (FHeight - Y - 1) * FWidth + X; {$ELSE} Index := Y * FWidth + X; {$ENDIF} A2 := Color.A; if A2 = 255 then FPixels[Index] := Color else if A2 <> 0 then begin A1 := 255 - Color.A; AR := FPixels[Index].R * A1 + Color.R * A2; AG := FPixels[Index].G * A1 + Color.G * A2; AB := FPixels[Index].B * A1 + Color.B * A2; FPixels[Index].R := AR shr 8; FPixels[Index].G := AG shr 8; FPixels[Index].B := AB shr 8; FPixels[Index].A := 255; end; finally UnlockUpdate; end; end; end; procedure TKAlphaBitmap.CopyFrom(AGraphic: TGraphic); begin if AGraphic is TKAlphaBitmap then CopyFromAlphaBitmap(AGraphic as TKAlphaBitmap) {$IFDEF USE_PNG_SUPPORT} else if AGraphic is TKPngImage then CopyFromPng(AGraphic as TKPngImage) {$ENDIF} else if AGraphic is TJpegImage then CopyFromJpeg(AGraphic as TJpegImage) else DrawFrom(AGraphic, 0, 0); end; procedure TKAlphaBitmap.CopyFromAlphaBitmap(ABitmap: TKAlphaBitmap); var I, Size: Integer; begin LockUpdate; try SetSize(ABitmap.Width, ABitmap.Height); Size := FWidth * SizeOf(TKColorRec); for I := 0 to FHeight - 1 do Move(ABitmap.ScanLine[I]^, ScanLine[I]^, Size); finally UnlockUpdate; end; end; procedure TKAlphaBitmap.CopyFromJpeg(AJpegImage: TJPEGImage); {$IFDEF FPC} var I, J: Integer; C: TKColorRec; IM: TLazIntfImage; FC: TFPColor; {$ENDIF} begin LockUpdate; try SetSize(AJpegImage.Width, AJpegImage.Height); {$IFDEF FPC} IM := AJpegImage.CreateIntfImage; try for I := 0 to AJpegImage.Width - 1 do begin for J := 0 to AJpegImage.Height - 1 do begin FC := IM.Colors[I, J]; C := FPColorToColorRec(FC); Pixel[I, J] := C; end; end; finally IM.Free; end; {$ELSE} // no access to JPEG pixels under Delphi DrawFrom(AJpegImage, 0, 0); DirectCopy := not HasAlpha; AlphaFill(255, True); {$ENDIF} finally UnlockUpdate; end; end; {$IFDEF USE_PNG_SUPPORT} procedure TKAlphaBitmap.CopyFromPng(APngImage: TKPngImage); var I, J: Integer; C: TKColorRec; {$IFDEF FPC} IM: TLazIntfImage; FC: TFPColor; {$ENDIF} begin LockUpdate; try SetSize(APngImage.Width, APngImage.Height); {$IFDEF FPC} IM := APngImage.CreateIntfImage; try {$ENDIF} for I := 0 to APngImage.Width - 1 do begin for J := 0 to APngImage.Height - 1 do begin {$IFDEF FPC} FC := IM.Colors[I, J]; C := FPColorToColorRec(FC); {$ELSE} C.Value := APngImage.Pixels[I, J]; if APngImage.AlphaScanline[J] <> nil then C.A := APngImage.AlphaScanline[J][I] else C.A := 255; {$ENDIF} Pixel[I, J] := C; end; end; {$IFDEF FPC} finally IM.Free; end; {$ENDIF} finally UnlockUpdate; end; end; {$ENDIF} procedure TKAlphaBitmap.CopyFromRotated(ABitmap: TKAlphaBitmap); var I, J: Integer; SrcScan, DstScan: PKColorRecs; begin LockUpdate; try SetSize(ABitmap.Height, ABitmap.Width); for J := 0 to ABitmap.Height - 1 do begin SrcScan := ABitmap.ScanLine[J]; for I := 0 to ABitmap.Width - 1 do begin DstScan := ScanLine[ABitmap.Width - I - 1]; DstScan[J] := SrcScan[I]; end; end; finally UnlockUpdate; end; end; procedure TKAlphaBitmap.CopyFromXY(X, Y: Integer; AGraphic: TGraphic); begin if AGraphic is TKAlphaBitmap then CopyFromXYAlphaBitmap(X, Y, AGraphic as TKAlphaBitmap) {$IFDEF USE_PNG_SUPPORT} else if AGraphic is TKPngImage then CopyFromXYPng(X, Y, AGraphic as TKPngImage) {$ENDIF} else if AGraphic is TJpegImage then CopyFromXYJpeg(X, Y, AGraphic as TJpegImage) else DrawFrom(AGraphic, X, Y); end; procedure TKAlphaBitmap.CopyFromXYAlphaBitmap(X, Y: Integer; ABitmap: TKAlphaBitmap); var I, J: Integer; begin LockUpdate; try for I := X to X + ABitmap.Width - 1 do for J := Y to Y + ABitmap.Height - 1 do if (I >= 0) and (I < FWidth) and (J >= 0) and (J < FHeight) then Pixels[J * FWidth + I] := ABitmap.Pixels[(J - Y) * ABitmap.Width + (I - X)]; finally UnlockUpdate; end; end; procedure TKAlphaBitmap.CopyFromXYJpeg(X, Y: Integer; AJpegImage: TJPEGImage); {$IFDEF FPC} var I, J: Integer; C: TKColorRec; IM: TLazIntfImage; FC: TFPColor; {$ENDIF} begin LockUpdate; try {$IFDEF FPC} IM := AJpegImage.CreateIntfImage; try for I := X to X + AJpegImage.Width - 1 do begin for J := Y to Y + AJpegImage.Height - 1 do begin if (I >= 0) and (I < FWidth) and (J >= 0) and (J < FHeight) then begin FC := IM.Colors[I - X, J - Y]; C := FPColorToColorRec(FC); Pixel[I, J] := C; end; end; end; finally IM.Free; end; {$ELSE} // no access to JPEG pixels under Delphi DrawFrom(AJpegImage, X, Y); DirectCopy := not HasAlpha; AlphaFill(255, True); {$ENDIF} finally UnlockUpdate; end; end; {$IFDEF USE_PNG_SUPPORT} procedure TKAlphaBitmap.CopyFromXYPng(X, Y: Integer; APngImage: TKPngImage); var I, J: Integer; C: TKColorRec; {$IFDEF FPC} IM: TLazIntfImage; FC: TFPColor; {$ENDIF} begin LockUpdate; try {$IFDEF FPC} IM := APngImage.CreateIntfImage; try {$ENDIF} for I := X to X + APngImage.Width - 1 do begin for J := Y to Y + APngImage.Height - 1 do begin if (I >= 0) and (I < FWidth) and (J >= 0) and (J < FHeight) then begin {$IFDEF FPC} FC := IM.Colors[I - X, J - Y]; C := FPColorToColorRec(FC); {$ELSE} C.Value := APngImage.Pixels[I - X, J - Y]; if APngImage.AlphaScanline[J - Y] <> nil then C.A := APngImage.AlphaScanline[J - Y][I - X] else C.A := 255; {$ENDIF} Pixel[I, J] := C; end; end; end; {$IFDEF FPC} finally IM.Free; end; {$ENDIF} finally UnlockUpdate; end; end; procedure TKAlphaBitmap.CopyToPng(APngImage: TKPngImage); var I, J: Integer; C: TKColorRec; {$IFDEF FPC} IM: TLazIntfImage; FC: TFPColor; {$ELSE} IM: TKPngImage; {$ENDIF} begin UpdatePixels; {$IFDEF FPC} IM := TLazIntfImage.Create(0, 0, [riqfRGB, riqfAlpha]); {$ELSE} IM := TKPngImage.CreateBlank(COLOR_RGBALPHA, 8, FWidth, FHeight); {$ENDIF} try {$IFDEF FPC} IM.SetSize(FWidth, FHeight); {$ENDIF} for I := 0 to FWidth - 1 do begin for J := 0 to FHeight - 1 do begin C := Pixel[I, J]; {$IFDEF FPC} FC := ColorRecToFPColor(C); IM.Colors[I, J] := FC; {$ELSE} IM.Pixels[I, J] := C.Value; if IM.AlphaScanline[J] <> nil then IM.AlphaScanline[J][I] := C.A; {$ENDIF} end; end; {$IFDEF FPC} APngImage.LoadFromIntfImage(IM); {$ELSE} APngImage.Assign(IM); {$ENDIF} finally IM.Free; end; end; {$ENDIF} procedure TKAlphaBitmap.Draw(ACanvas: TCanvas; const ARect: TRect); begin if FDirectCopy then DrawTo(ACanvas, ARect) else AlphaStretchDrawTo(ACanvas, ARect); end; procedure TKAlphaBitmap.DrawFrom(ACanvas: TCanvas; const ARect: TRect); begin if not Empty then begin if not CanvasScaled(ACanvas) then StretchBitmap(FCanvas.Handle, Rect(0, 0, FWidth, FHeight), ACanvas.Handle, ARect) else begin FCanvas.Brush := ACanvas.Brush; DrawFilledRectangle(FCanvas, Rect(0, 0, FWidth, FHeight), {$IFDEF MSWINDOWS}GetBkColor(ACanvas.Handle){$ELSE}clWindow{$ENDIF}); end; UpdatePixels; end; end; procedure TKAlphaBitmap.DrawFrom(AGraphic: TGraphic; X, Y: Integer); begin if not Empty then begin UpdateHandle; FCanvas.Draw(X, Y, AGraphic); UpdatePixels; end; end; procedure TKAlphaBitmap.DrawTo(ACanvas: TCanvas; const ARect: TRect); begin if not Empty then begin UpdateHandle; StretchBitmap(ACanvas.Handle, ARect, FCanvas.Handle, Rect(0, 0, FWidth, FHeight)) end; end; procedure TKAlphaBitmap.Fill(Color: TKColorRec); var I: Integer; begin LockUpdate; try for I := 0 to FWidth * FHeight - 1 do FPixels[I].Value := Color.Value; finally UnlockUpdate; end; end; function TKAlphaBitmap.GetEmpty: Boolean; begin Result := (FWidth = 0) and (FHeight = 0); end; function TKAlphaBitmap.GetHeight: Integer; begin Result := FHeight; end; function TKAlphaBitmap.GetPixel(X, Y: Integer): TKColorRec; begin if (X >= 0) and (X < FWidth) and (Y >= 0) and (Y < FHeight) then begin {$IFDEF MSWINDOWS} Result := FPixels[(FHeight - Y - 1) * FWidth + X]; {$ELSE} Result := FPixels[Y * FWidth + X]; {$ENDIF} SwapBR(Result); end else Result := MakeColorRec(0,0,0,0); end; function TKAlphaBitmap.GetTransparent: Boolean; begin Result := True; end; function TKAlphaBitmap.GetScanLine(Index: Integer): PKColorRecs; begin // no checks here Result := @FPixels[Index * FWidth]; end; function TKAlphaBitmap.GetHandle: HBITMAP; begin Result := FHandle; end; function TKAlphaBitmap.GetHasAlpha: Boolean; var I: Integer; begin Result := False; for I := 0 to FWidth * FHeight - 1 do if FPixels[I].A <> 0 then begin Result := True; Break; end; end; function TKAlphaBitmap.GetWidth: Integer; begin Result := FWidth; end; procedure TKAlphaBitmap.GrayScale; var I, Average: Integer; begin LockUpdate; try for I := 0 to FWidth * FHeight - 1 do begin // R and B are swapped Average := (Integer(7) * FPixels[I].R + Integer(72) * FPixels[I].G + Integer(21) * FPixels[I].B) div 100; FPixels[I].R := Average; FPixels[I].G := Average; FPixels[I].B := Average; end; finally UnlockUpdate; end; end; procedure TKAlphaBitmap.Brighten(APercent: Single; AMode: TKBrightMode); var I: Integer; X: TKColorRec; begin LockUpdate; try for I := 0 to FWidth * FHeight - 1 do begin X.Value := BrightColor(ColorRecToColor(FPixels[I]), APercent, AMode); FPixels[I].R := X.R; FPixels[I].G := X.G; FPixels[I].B := X.B; end; finally UnlockUpdate; end; end; {$IFNDEF FPC} procedure TKAlphaBitmap.LoadFromClipboardFormat(AFormat: Word; AData: THandle; APalette: HPALETTE); begin // does nothing end; {$ENDIF} procedure TKAlphaBitmap.LoadFromFile(const Filename: string); var IM: TPicture; begin IM := TPicture.Create; try IM.LoadFromFile(FileName); LoadFromGraphic(IM.Graphic); finally IM.Free; end; end; procedure TKAlphaBitmap.LoadFromHandles(ABitmap, AMask: HBITMAP); begin // todo end; procedure TKAlphaBitmap.LoadFromGraphic(Image: TGraphic); begin LockUpdate; try SetSize(Image.Width, Image.Height); {$IFDEF MSWINDOWS} Canvas.Draw(0, 0, Image); {$ELSE} if Image is TRasterImage then FImage.Assign(TRasterImage(Image).CreateIntfImage); {$ENDIF} // if bitmap has no alpha channel, create full opacity AlphaFill($FF, True); finally UnlockUpdate; end; end; procedure TKAlphaBitmap.LoadFromStream(Stream: TStream); var BF: TBitmapFileHeader; BI: TBitmapInfoHeader; begin Stream.Read(BF, SizeOf(TBitmapFileHeader)); if BF.bfType = $4D42 then begin Stream.Read(BI, SizeOf(TBitmapInfoHeader)); if BI.biBitCount = 32 then begin LockUpdate; try SetSize(BI.biWidth, BI.biHeight); Stream.Read(FPixels^, BI.biSizeImage); // if bitmap has no alpha channel, create full opacity AlphaFill($FF, True); {$IFnDEF MSWINDOWS} if FAutoMirror then MirrorVert; {$ENDIF} finally UnlockUpdate; end; end; end; end; procedure TKAlphaBitmap.LockUpdate; begin Inc(FUpdateLock); end; procedure TKAlphaBitmap.MirrorHorz; var I, J, Index: Integer; SrcScan: PKColorRecs; Buf: TKColorRec; begin LockUpdate; try for I := 0 to FHeight - 1 do begin SrcScan := ScanLine[I]; Index := FWidth - 1; for J := 0 to (FWidth shr 1) - 1 do begin Buf := SrcScan[Index]; SrcScan[Index] := SrcScan[J]; SrcScan[J] := Buf; Dec(Index); end; end; finally UnlockUpdate; end; end; procedure TKAlphaBitmap.MirrorVert; var I, Size, Index: Integer; SrcScan, DstScan: PKColorRecs; Buf: PKColorRec; begin LockUpdate; try Size:= FWidth * SizeOf(TKColorRec); Index := FHeight - 1; GetMem(Buf, Size); try for I := 0 to (FHeight shr 1) - 1 do begin SrcScan := ScanLine[I]; DstScan := ScanLine[Index]; Move(SrcScan^, Buf^, Size); Move(DstScan^, SrcScan^, Size); Move(Buf^, DstScan^, Size); Dec(Index); end; finally FreeMem(Buf); end; finally UnlockUpdate; end; end; {$IFNDEF FPC} procedure TKAlphaBitmap.SaveToClipboardFormat(var AFormat: Word; var AData: THandle; var APalette: HPALETTE); begin // does nothing end; {$ENDIF} procedure TKAlphaBitmap.SaveToStream(Stream: TStream); var Size: Integer; BF: TBitmapFileHeader; BI: TBitmapInfoHeader; begin {$IFnDEF MSWINDOWS} if FAutoMirror then MirrorVert; {$ENDIF} Size := FWidth * FHeight * 4; FillChar(BF, SizeOf(TBitmapFileHeader), 0); BF.bfType := $4D42; BF.bfSize := SizeOf(TBitmapFileHeader) + SizeOf(TBitmapInfoHeader) + Size; BF.bfOffBits := SizeOf(TBitmapFileHeader) + SizeOf(TBitmapInfoHeader); Stream.Write(BF, SizeOf(TBitmapFileHeader)); FillChar(BI, SizeOf(TBitmapInfoHeader), 0); BI.biSize := SizeOf(TBitmapInfoHeader); BI.biWidth := FWidth; BI.biHeight := FHeight; BI.biPlanes := 1; BI.biBitCount := 32; BI.biCompression := BI_RGB; BI.biSizeImage := Size; Stream.Write(BI, SizeOf(TBitmapInfoHeader)); Stream.Write(FPixels^, Size); {$IFnDEF MSWINDOWS} if FAutoMirror then MirrorVert; {$ENDIF} end; procedure TKAlphaBitmap.SetHeight(Value: Integer); begin SetSize(FWidth, Value); end; procedure TKAlphaBitmap.SetPixel(X, Y: Integer; Value: TKColorRec); begin if (X >= 0) and (X < FWidth) and (Y >= 0) and (Y < FHeight) then begin LockUpdate; try SwapBR(Value); {$IFDEF MSWINDOWS} FPixels[(FHeight - Y - 1) * FWidth + X] := Value; {$ELSE} FPixels[Y * FWidth + X] := Value; {$ENDIF} finally UnlockUpdate; end; end; end; procedure TKAlphaBitmap.SetSize(AWidth, AHeight: Integer); var {$IFNDEF MSWINDOWS} ImgFormatDescription: TRawImageDescription; {$ELSE} BI: TBitmapInfoHeader; {$ENDIF} begin AWidth := Max(AWidth, 0); AHeight := Max(AHeight, 0); if (AWidth <> FWidth) or (AHeight <> FHeight) then begin LockUpdate; try FWidth := AWidth; FHeight := AHeight; if FHandle <> 0 then begin SelectObject(FCanvas.Handle, FOldBitmap); DeleteObject(FHandle); FHandle := 0; {$IFNDEF MSWINDOWS} DeleteObject(FMaskHandle); FMaskHandle := 0; {$ENDIF} end; {$IFNDEF MSWINDOWS} FImage.SetSize(0, 0); {$ENDIF} FPixels := nil; if (FWidth <> 0) and (FHeight <> 0) then begin {$IFNDEF MSWINDOWS} ImgFormatDescription.Init_BPP32_B8G8R8A8_BIO_TTB(FWidth,FHeight); FImage.DataDescription := ImgFormatDescription; FPixelsChanged := True; UpdateHandle; {$ELSE} FillChar(BI, SizeOf(TBitmapInfoHeader), 0); BI.biSize := SizeOf(TBitmapInfoHeader); BI.biWidth := FWidth; BI.biHeight := FHeight; BI.biPlanes := 1; BI.biBitCount := 32; BI.biCompression := BI_RGB; FHandle := GDICheck(CreateDIBSection(FCanvas.Handle, PBitmapInfo(@BI)^, DIB_RGB_COLORS, Pointer(FPixels), 0, 0)); FOldBitmap := SelectObject(FCanvas.Handle, FHandle); {$ENDIF} end; finally UnlockUpdate; end; end; end; procedure TKAlphaBitmap.SetWidth(Value: Integer); begin SetSize(Value, FWidth); end; procedure TKAlphaBitmap.SetTransparent(Value: Boolean); begin // does nothing end; procedure TKAlphaBitmap.UnlockUpdate; begin if FUpdateLock > 0 then begin Dec(FUpdateLock); if FUpdateLock = 0 then Changed(Self); end; end; procedure TKAlphaBitmap.UpdateHandle; begin {$IFNDEF MSWINDOWS} if FPixelsChanged then begin PixelsChanged := False; if FHandle <> 0 then begin DeleteObject(FMaskHandle); DeleteObject(SelectObject(FCanvas.Handle, FOldBitmap)); end; FImage.CreateBitmaps(FHandle, FMaskHandle, False); FOldBitmap := SelectObject(FCanvas.Handle, FHandle); FPixels := PKColorRecs(FImage.PixelData); end; {$ENDIF} end; procedure TKAlphaBitmap.UpdatePixels; begin {$IFNDEF MSWINDOWS} FImage.LoadFromDevice(FCanvas.Handle); FPixelsChanged := True; UpdateHandle; {$ENDIF} end; { TKMetafile } {$IFDEF MSWINDOWS} constructor TKMetafile.Create; begin inherited; FCopyOnAssign := True; FEmfHandle := 0; FRequiredHeight := 0; FRequiredWidth := 0; FWmfHandle := 0; end; destructor TKMetafile.Destroy; begin Clear; inherited; end; procedure TKMetafile.Assign(Source: TPersistent); var Stream: TMemoryStream; begin if Source is TKMetafile then begin Clear; FEnhanced := TKMetafile(Source).Enhanced; if TKMetafile(Source).CopyOnAssign then begin Stream := TMemoryStream.Create; try TKMetafile(Source).SaveToStream(Stream); Stream.Seek(0, soFromBeginning); LoadFromStream(Stream); finally Stream.Free; end; end else begin // here, the source loses the images! TKMetafile(Source).Release(FWmfHandle, FEmfHandle); end; FRequiredHeight := TKMetafile(Source).Height; FRequiredWidth := TKMetafile(Source).Width; end; end; procedure TKMetafile.Clear; begin if FWmfHandle <> 0 then begin DeleteMetafile(FWmfHandle); FWmfHandle := 0; end; if FEmfHandle <> 0 then begin DeleteEnhMetafile(FEmfHandle); FEmfHandle := 0; end; end; procedure TKMetafile.Draw(ACanvas: TCanvas; const Rect: TRect); var BM: TKAlphaBitmap; begin inherited; if FWMfHandle <> 0 then begin if FRequiredWidth * FRequiredHeight > 0 then begin BM := TKAlphaBitmap.Create; try BM.DirectCopy := True; BM.SetSize(FRequiredWidth, FRequiredHeight); BM.Fill(MakeColorRec(255,255,255,255)); PlayMetafile(BM.Canvas.Handle, FWmfHandle); BM.DirectCopy := False; BM.DrawTo(ACanvas, Rect); finally BM.Free; end; end; end else if FEMFHandle <> 0 then begin PlayEnhMetafile(ACanvas.Handle, FEmfHandle, Rect); end; end; function TKMetafile.GetEmpty: Boolean; begin Result := (FWmfHandle = 0) and (FEmfHandle = 0); end; function TKMetafile.GetHeight: Integer; begin Result := FRequiredHeight; end; function TKMetafile.GetTransparent: Boolean; begin Result := False; end; function TKMetafile.GetWidth: Integer; begin Result := FRequiredWidth; end; procedure TKMetafile.LoadFromStream(Stream: TStream); var S: AnsiString; EHDR: TEnhMetaheader; MFP: TMetaFilePict; begin SetLength(S, Stream.Size - Stream.Position); if S <> '' then begin Stream.Read(EHDR, SizeOf(TEnhMetaHeader)); Stream.Seek(-SizeOf(TEnhMetaHeader), soFromCurrent); Stream.Read(S[1], Length(S)); if FEnhanced and (EHDR.iType = EMR_HEADER) then begin FEmfHandle := SetEnhMetafileBits(Length(S), @S[1]); FRequiredWidth := EHDR.rclBounds.Right - EHDR.rclBounds.Left; FRequiredHeight := EHDR.rclBounds.Bottom - EHDR.rclBounds.Top; end else begin FWmfHandle := SetMetafileBitsEx(Length(S), @S[1]); if FWmfHandle <> 0 then begin // obtain width and height with MFP do begin MM := MM_ANISOTROPIC; xExt := 0; yExt := 0; hmf := 0; end; FEmfHandle := SetWinMetaFileBits(Length(S), @S[1], 0, MFP); if FEmfHandle <> 0 then begin if GetEnhMetaFileHeader(FEmfHandle, SizeOf(TEnhMetaHeader), @EHDR) > 0 then begin FRequiredWidth := EHDR.rclBounds.Right - EHDR.rclBounds.Left; FRequiredHeight := EHDR.rclBounds.Bottom - EHDR.rclBounds.Top; end; DeleteEnhMetafile(FEmfHandle); FEmfHandle := 0; end; end; end; end; end; procedure TKMetafile.Release(out AWmfHandle: HMETAFILE; out AEmfHandle: HENHMETAFILE); begin AWmfHandle := FWmfHandle; FWmfHandle := 0; AEmfHandle := FEmfHandle; FEmfHandle := 0; end; procedure TKMetafile.SaveToStream(Stream: TStream); var S: AnsiString; Size: Integer; begin S := ''; if FWmfHandle <> 0 then begin Size := GetMetaFileBitsEx(FWmfHandle, 0, nil); if Size > 0 then begin SetLength(S, Size); GetMetafileBitsEx(FWmfHandle, Size, @S[1]); end; end else if FEmfHandle <> 0 then begin Size := GetEnhMetaFileBits(FEmfHandle, 0, nil); if Size > 0 then begin SetLength(S, Size); GetEnhMetafileBits(FEmfHandle, Size, @S[1]); end; end; if S <> '' then Stream.Write(S[1], Length(S)); end; procedure TKMetafile.SetEMFHandle(const Value: HENHMETAFILE); begin Clear; FEMFHandle := Value; end; procedure TKMetafile.SetEnhanced(const Value: Boolean); begin FEnhanced := Value; end; procedure TKMetafile.SetHeight(Value: Integer); begin FRequiredHeight := Value; end; procedure TKMetafile.SetWidth(Value: Integer); begin FRequiredWidth := Value; end; procedure TKMetafile.SetWMFHandle(const Value: HMETAFILE); begin Clear; FWMFHandle := Value; end; {$ENDIF} { TKTextBox } constructor TKTextBox.Create; begin inherited; FAttributes := []; FBackColor := clWhite; FHAlign := halLeft; FHasTabs := False; FHPadding := 0; FSelBkgnd := clHighlight; FSelColor := clHighlightText; FSelEnd := 0; FSelStart := 0; FSpacesForTab := 8; FText := ''; FVAlign := valCenter; FVPadding := 0; end; procedure TKTextBox.Draw(ACanvas: TCanvas; const ARect: TRect); var Y: Integer; TmpRect: TRect; PrevRgn: HRGN; begin if not IsRectEmpty(ARect) then begin if taFillRect in Attributes then DrawFilledRectangle(ACanvas, ARect, BackColor); if FText <> '' then begin Initialize(ACanvas, ARect); if not IsRectEmpty(FClipRect) then begin Y := GetVertPos; TmpRect := FClipRect; if taClip in Attributes then begin TranslateRectToDevice(ACanvas.Handle, TmpRect); PrevRgn := RgnCreateAndGet(ACanvas.Handle); try if ExtSelectClipRect(ACanvas.Handle, TmpRect, RGN_AND, PrevRgn) then begin if not (taFillText in Attributes) then SetBkMode(ACanvas.Handle, TRANSPARENT); Process(Y, tbfDraw); end; finally RgnSelectAndDelete(ACanvas.Handle, PrevRgn); end; end else begin if not (taFillText in Attributes) then SetBkMode(ACanvas.Handle, TRANSPARENT); Process(Y, tbfDraw); end; end; end; end; end; function TKTextBox.GetHorzPos(ATextWidth: Integer): Integer; begin case HAlign of halCenter: Result := Max(FClipRect.Left, (FClipRect.Left + FClipRect.Right - ATextWidth) div 2); halRight: Result := FClipRect.Right - ATextWidth; else Result := FClipRect.Left; end; end; function TKTextBox.GetVertPos: Integer; begin case VAlign of valCenter: begin Process(0, tbfMeasure); Result := Max(FClipRect.Top, (FClipRect.Bottom + FClipRect.Top - FCalcRect.Top) div 2); end; valBottom: begin Process(0, tbfMeasure); Result := FClipRect.Bottom - FCalcRect.Top; end else Result := FClipRect.Top; end; end; function TKTextBox.IndexToRect(ACanvas: TCanvas; const ARect: TRect; AIndex: Integer): TRect; var Y: Integer; begin Initialize(ACanvas, ARect); Y := GetVertPos; FIndex := AIndex; Process(Y, tbfGetRect); Result := FCalcRect; end; procedure TKTextBox.Initialize(ACanvas: TCanvas; const ARect: TRect); begin FCanvas := ACanvas; FClipRect := ARect; InflateRect(FClipRect, -HPadding, -VPadding); FFontHeight := GetFontHeight(FCanvas.Handle); end; procedure TKTextBox.Measure(ACanvas: TCanvas; const ARect: TRect; var AWidth, AHeight: Integer); begin Initialize(ACanvas, ARect); Process(0, tbfMeasure); AWidth := FCalcRect.Left; AHeight := FCalcRect.Top; end; procedure TKTextBox.Process(Y: Integer; AFunction: TKTextBoxFunction); var StartEllipsis, EndEllipsis, PathEllipsis: Boolean; Width, EllipsisWidth: Integer; NormalColor, NormalBkgnd: TColor; procedure Measure(AStart, ALen: Integer); begin FCalcRect.Left := Max(FCalcRect.Left, TextExtent(FCanvas, FText, AStart, ALen, FHasTabs, FSpacesForTab).cx); end; procedure GetIndex(Y: Integer; AStart, ALen: Integer); var Index, NewIndex, X, Width: Integer; begin if FIndex < 0 then begin if not (taIncludePadding in Attributes) and (Y <= FCalcRect.Top) and (FCalcRect.Top < Y + FFontHeight) or (taIncludePadding in Attributes) and ( (AStart = 1) and (FClipRect.Top <= FCalcRect.Top) and (FCalcRect.Top < Y + FFontHeight) or (AStart + ALen = Length(FText) + 1) and (Y <= FCalcRect.Top) and (FCalcRect.Top < FClipRect.Bottom) ) then begin Width := TextExtent(FCanvas, FText, AStart, ALen, FHasTabs, FSpacesForTab).cx; X := GetHorzPos(Width); if not (taIncludePadding in Attributes) and (X <= FCalcRect.Left) and (FCalcRect.Left < X + Width) or (taIncludePadding in Attributes) and (FClipRect.Left <= FCalcRect.Left) and (FCalcRect.Left < FClipRect.Right) then begin Index := AStart; while (FIndex < 0) and (Index <= AStart + ALen - 1) do begin NewIndex := StrNextCharIndex(FText, Index); Inc(X, TextExtent(FCanvas, FText, Index, NewIndex - Index, FHasTabs, FSpacesForTab).cx); if FCalcRect.Left < X then FIndex := Index; Index := NewIndex; end; if (taIncludePadding in Attributes) and (FIndex < 0) and (FCalcRect.Left < FClipRect.Right) then FIndex := Index; end; end; end; end; procedure GetRect(Y: Integer; AStart, ALen: Integer); var Index, NewIndex, X, Width: Integer; begin if (FIndex >= AStart) and (FIndex <= ALen) then begin Index := AStart; Width := TextExtent(FCanvas, FText, AStart, ALen, FHasTabs, FSpacesForTab).cx; X := GetHorzPos(Width); while Index < FIndex do begin NewIndex := StrNextCharIndex(FText, Index); Inc(X, TextExtent(FCanvas, FText, Index, NewIndex - Index, FHasTabs, FSpacesForTab).cx); Index := NewIndex; end; NewIndex := StrNextCharIndex(FText, Index); FCalcRect := Rect(X, Y, X + TextExtent(FCanvas, FText, Index, NewIndex - Index, FHasTabs, FSpacesForTab).cx, Y + FFontHeight); end end; procedure Draw(Y: Integer; AStart, ALen: Integer); var DrawEllipsis, DrawFileName, SetNormalColors, SetSelectionColors: Boolean; AWidth, Index, NewIndex, SlashPos, FileNameLen, EllipsisMaxX, X: Integer; S: TKString; begin if (Y >= FClipRect.Top - FFontHeight) and (Y <= FClipRect.Bottom) then begin DrawEllipsis := False; DrawFileName := False; SlashPos := 0; FileNameLen := 0; if (StartEllipsis or EndEllipsis or PathEllipsis) and (ALen > 1) then begin AWidth := TextExtent(FCanvas, FText, AStart, ALen, FHasTabs, FSpacesForTab).cx; if AWidth > Width then begin AWidth := 0; Index := AStart; if EndEllipsis or StartEllipsis then begin EllipsisMaxX := Width - EllipsisWidth; if EndEllipsis then begin while Index <= AStart + ALen - 1 do begin NewIndex := StrNextCharIndex(FText, Index); Inc(AWidth, TextExtent(FCanvas, FText, Index, NewIndex - Index, FHasTabs, FSpacesForTab).cx); if (AWidth >= EllipsisMaxX) and (Index > AStart) then Break else Index := NewIndex; end; ALen := Index - AStart; end else begin Index := AStart + ALen - 1; while Index > AStart do begin NewIndex := StrPreviousCharIndex(FText, Index); Inc(AWidth, TextExtent(FCanvas, FText, Index, Index - NewIndex, FHasTabs, FSpacesForTab).cx); if AWidth >= EllipsisMaxX then Break else Index := NewIndex; end; if Index = AStart + ALen - 1 then begin AStart := Index; ALen := 1; end else begin Dec(ALen, Index - AStart); AStart := Index + 1; end; end; DrawEllipsis := True; end else if PathEllipsis then begin SlashPos := AStart + ALen - 1; while (SlashPos > 0) and not CharInSetEx(FText[SlashPos], ['/', '\']) do Dec(SlashPos); Dec(SlashPos); if SlashPos > 0 then begin DrawEllipsis := True; DrawFileName := True; FileNameLen := AStart + ALen - SlashPos; EllipsisMaxX := Width - TextExtent(FCanvas, FText, SlashPos, FileNameLen, FHasTabs, FSpacesForTab).cx - EllipsisWidth; while (Index <= SlashPos) do begin NewIndex := StrNextCharIndex(FText, Index); Inc(AWidth, TextExtent(FCanvas, FText, Index, NewIndex - Index, FHasTabs, FSpacesForTab).cx); if AWidth >= EllipsisMaxX then Break else Index := NewIndex; end; ALen := Index - AStart; end; end; end; end; if DrawEllipsis then begin if DrawFileName then S := Copy(FText, AStart, ALen) + cEllipsis + Copy(FText, AStart + SlashPos, FileNameLen) else if EndEllipsis then S := Copy(FText, AStart, ALen) + cEllipsis else S := cEllipsis + Copy(FText, AStart, ALen); AStart := 1; ALen := Length(S); end else S := FText; X := GetHorzPos(TextExtent(FCanvas, S, AStart, ALen, FHasTabs, FSpacesForTab).cx); if DrawEllipsis or (SelStart = SelEnd) then TextOutput(FCanvas, X, Y, S, AStart, ALen, FHasTabs, FSpacesForTab) else begin AWidth := 0; Index := AStart; SlashPos := Index; // reuse while (Index <= AStart + ALen) do begin DrawFileName := False; // reuse SetNormalColors := False; SetSelectionColors := False; if Index = SelStart then begin DrawFileName := True; SetSelectionColors := True; end else if Index = SelEnd then begin DrawFileName := True; SetNormalColors := True; end else if Index = AStart + ALen then begin DrawFileName := True; end; if DrawFileName then begin if Index > SlashPos then begin if SetNormalColors then DrawFilledRectangle(FCanvas, Rect(X, Y, X + AWidth, Y + FFontHeight), FBackColor); if not (taFillText in Attributes) then SetBkMode(FCanvas.Handle, TRANSPARENT); TextOutput(FCanvas, X, Y, S, SlashPos, Index - SlashPos, FHasTabs, FSpacesForTab); end; Inc(X, AWidth); AWidth := 0; SlashPos := Index; end; if Index < AStart + ALen then begin NewIndex := StrNextCharIndex(FText, Index); Inc(AWidth, TextExtent(FCanvas, FText, Index, NewIndex - Index, FHasTabs, FSpacesForTab).cx); Index := NewIndex; end else Inc(Index); if SetNormalColors then begin FCanvas.Font.Color := NormalColor; FCanvas.Brush.Color := NormalBkgnd; end else if SetSelectionColors then begin FCanvas.Font.Color := SelColor; FCanvas.Brush.Color := SelBkgnd; end; end; end; end; end; var I, Index, TextLen, LineBegin, LineBreaks, Vert, TrimStart, TrimLen: Integer; WordBreak, LineBreak, WhiteSpace, PrevWhiteSpace, FirstWord, WasLineBreak, WrapText: Boolean; Size: TSize; begin case AFunction of tbfMeasure: FCalcRect := CreateEmptyRect; tbfGetIndex: FIndex := -1; tbfGetRect: FCalcRect := CreateEmptyRect; tbfDraw: ; end; Vert := Y; if FText <> '' then begin LineBegin := 1; LineBreaks := 0; TextLen := Length(FText); Width := FClipRect.Right - FClipRect.Left; WordBreak := taWordBreak in Attributes; LineBreak := taLineBreak in Attributes; WrapText := taWrapText in Attributes; //JR:20091229 if AFunction = tbfDraw then begin StartEllipsis := taStartEllipsis in Attributes; EndEllipsis := taEndEllipsis in Attributes; PathEllipsis := taPathEllipsis in Attributes; EllipsisWidth := TextExtent(FCanvas, cEllipsis, 1, Length(cEllipsis)).cx; NormalColor := FCanvas.Font.Color; NormalBkgnd := FCanvas.Brush.Color; end; if WordBreak or LineBreak then begin I := LineBegin; Index := LineBegin; WhiteSpace := True; FirstWord := True; WasLineBreak := False; while I <= TextLen + 1 do begin PrevWhiteSpace := WhiteSpace; WhiteSpace := CharInSetEx(FText[I], cWordBreaks + cLineBreaks); if (not PrevWhiteSpace and WhiteSpace and (I > LineBegin)) or (not PrevWhiteSpace and WrapText and (I > LineBegin)) then //JR:20091229 begin if (WordBreak or WrapText) and (LineBreaks = 0) and not FirstWord then begin TrimStart := LineBegin; TrimLen := I - LineBegin; TextTrim(FText, TrimStart, TrimLen); Size := TextExtent(FCanvas, FText, TrimStart, TrimLen, FHasTabs, FSpacesForTab); if Size.cx > Width then Inc(LineBreaks); end; if LineBreaks > 0 then begin if Index > LineBegin then begin TrimStart := LineBegin; TrimLen := Index - LineBegin; TextTrim(FText, TrimStart, TrimLen); case AFunction of tbfMeasure: Measure(TrimStart, TrimLen); tbfGetIndex: GetIndex(Vert, TrimStart, TrimLen); tbfGetRect: GetRect(Vert, TrimStart, TrimLen); tbfDraw: Draw(Vert, TrimStart, TrimLen); end; LineBegin := Index; end; Inc(Vert, FFontHeight * LineBreaks); LineBreaks := 0; end; Index := I; FirstWord := False; end; if LineBreak then if CharInSetEx(FText[I], cLineBreaks) then begin if not WasLineBreak then begin Inc(LineBreaks); WasLineBreak := True; end; end else WasLineBreak := False; Inc(I); end; end; if LineBegin <= TextLen then begin TrimStart := LineBegin; TrimLen := TextLen - LineBegin + 1; TextTrim(FText, TrimStart, TrimLen); case AFunction of tbfMeasure: Measure(TrimStart, TrimLen); tbfGetIndex: GetIndex(Vert, TrimStart, TrimLen); tbfGetRect: GetRect(Vert, TrimStart, TrimLen); tbfDraw: Draw(Vert, TrimStart, TrimLen) end; Inc(Vert, FFontHeight * (1 + LineBreaks)); end; end; case AFunction of tbfMeasure: begin if FText = '' then FCalcRect.Top := FFontHeight else FCalcRect.Top := Vert - Y; end; tbfGetIndex: ; tbfGetRect: if FText = '' then begin I := GetHorzPos(0); FCalcRect := Rect(I, Y, I, Y + FFontHeight); end; tbfDraw: ; end; end; procedure TKTextBox.SetText(const AText: TKString); begin if AText <> FText then begin FText := AText; FHasTabs := Pos(cTAB, FText) > 0; end; end; function TKTextBox.PointToIndex(ACanvas: TCanvas; const ARect: TRect; APoint: TPoint): Integer; var Y: Integer; begin Initialize(ACanvas, ARect); Y := GetVertPos; FCalcRect.TopLeft := APoint; Process(Y, tbfGetIndex); Result := FIndex; end; class function TKTextBox.TextExtent(ACanvas: TCanvas; const AText: TKString; AStart, ALen: Integer; AExpandTabs: Boolean; ASpacesForTab: Integer): TSize; var S: TKString; TextPtr: PKText; begin S := ''; if AExpandTabs then begin S := Copy(AText, AStart, ALen); ConvertTabsToSpaces(S, ASpacesForTab); TextPtr := @S[1]; ALen := Length(S); end else TextPtr := @AText[AStart]; {$IFDEF STRING_IS_UNICODE} {$IFDEF FPC} {$IFDEF USE_CANVAS_METHODS} if not AExpandTabs then S := Copy(AText, AStart, ALen); Result := ACanvas.TextExtent(S); // little slower but more secure in Lazarus {$ELSE} GetTextExtentPoint32(ACanvas.Handle, TextPtr, ALen, Result); {$ENDIF} {$ELSE} GetTextExtentPoint32(ACanvas.Handle, TextPtr, ALen, Result); {$ENDIF} {$ELSE} GetTextExtentPoint32W(ACanvas.Handle, TextPtr, ALen, Result); {$ENDIF} end; class procedure TKTextBox.TextOutput(ACanvas: TCanvas; X, Y: Integer; const AText: TKString; AStart, ALen: Integer; AExpandTabs: Boolean; ASpacesForTab: Integer); var S: TKString; TextPtr: PKText; begin if AExpandTabs then begin S := Copy(AText, AStart, ALen); ConvertTabsToSpaces(S, ASpacesForTab); TextPtr := @S[1]; ALen := Length(S); end else begin TextPtr := @AText[AStart]; S := AText; end; {$IFDEF STRING_IS_UNICODE} {$IFDEF FPC} {$IFDEF USE_CANVAS_METHODS} if not AExpandTabs then S := Copy(S, AStart, ALen); ACanvas.TextOut(X, Y, S); // little slower but more secure in Lazarus {$ELSE} TextOut(ACanvas.Handle, X, Y, TextPtr, ALen); {$ENDIF} {$ELSE} TextOut(ACanvas.Handle, X, Y, TextPtr, ALen); {$ENDIF} {$ELSE} TextOutW(ACanvas.Handle, X, Y, TextPtr, ALen); {$ENDIF} end; procedure TKTextBox.TextTrim(const AText: TKString; var AStart, ALen: Integer); begin if taLineBreak in Attributes then TrimWhiteSpaces(AText, AStart, ALen, cLineBreaks); if taTrimWhiteSpaces in Attributes then TrimWhiteSpaces(AText, AStart, ALen, cWordBreaks); end; { TKDragWindow } {$IFDEF MSWINDOWS} const cLayeredWndClass = 'KControls drag window'; function DragWndProc(Window: HWnd; Msg, WParam, LParam: Longint): Longint; stdcall; var DC: HDC; PS: TPaintStruct; AWindow: TKDragWindow; begin case Msg of WM_PAINT: begin AWindow := TKDragWindow(GetWindowLong(Window, GWL_USERDATA)); if (AWindow <> nil) and AWindow.BitmapFilled then begin if wParam = 0 then DC := BeginPaint(Window, PS) else DC := wParam; try BitBlt(DC, 0, 0, AWindow.Bitmap.Width, AWindow.Bitmap.Height, AWindow.Bitmap.Canvas.Handle, 0, 0, SRCCOPY); finally if wParam = 0 then EndPaint(Window, PS); end; end; Result := 1; end; else Result := DefWindowProc(Window, Msg, WParam, LParam); end; end; {$ELSE} type { TKDragForm } TKDragForm = class(THintWindow) private FWindow: TKDragWindow; procedure WMEraseBkGnd(var Msg: TLMessage); message LM_ERASEBKGND; protected procedure Paint; override; public constructor CreateDragForm(AWindow: TKDragWindow); end; { TKDragForm } constructor TKDragForm.CreateDragForm(AWindow: TKDragWindow); begin inherited Create(nil); FWindow := AWindow; ShowInTaskBar := stNever; end; procedure TKDragForm.Paint; begin if FWindow.Active and FWindow.BitmapFilled then Canvas.Draw(0, 0, FWindow.FBitmap); end; procedure TKDragForm.WMEraseBkGnd(var Msg: TLMessage); begin Msg.Result := 1; end; {$ENDIF} constructor TKDragWindow.Create; {$IFDEF MSWINDOWS} var Cls: Windows.TWndClass; ExStyle: Cardinal; {$ENDIF} begin inherited; FActive := False; FBitmap := TKAlphaBitmap.Create; FInitialPos := CreateEmptyPoint; {$IFDEF MSWINDOWS} FUpdateLayeredWindow := GetProcAddress(GetModuleHandle('user32.dll'), 'UpdateLayeredWindow'); FLayered := Assigned(FUpdateLayeredWindow); Cls.style := CS_SAVEBITS; Cls.lpfnWndProc := @DragWndProc; Cls.cbClsExtra := 0; Cls.cbWndExtra := 0; Cls.hInstance := HInstance; Cls.hIcon := 0; Cls.hCursor := 0; Cls.hbrBackground := 0; Cls.lpszMenuName := nil; Cls.lpszClassName := cLayeredWndClass; Windows.RegisterClass(Cls); ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST; if FLayered then ExStyle := ExStyle or WS_EX_LAYERED or WS_EX_TRANSPARENT; FWindow := CreateWindowEx(ExStyle, cLayeredWndClass, '', WS_POPUP, Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), 0, 0, HInstance, nil); Windows.SetWindowLong(FWindow, GWL_USERDATA, Integer(Self)); {$ELSE} FDragForm := TKDragForm.CreateDragForm(Self); FLayered := False; {$ENDIF} end; destructor TKDragWindow.Destroy; begin inherited; Hide; {$IFDEF MSWINDOWS} DestroyWindow(FWindow); Windows.UnregisterClass(cLayeredWndClass, HInstance); {$ELSE} FDragForm.Free; {$ENDIF} FBitmap.Free; end; procedure TKDragWindow.Hide; begin if FActive then begin {$IFDEF MSWINDOWS} ShowWindow(FWindow, SW_HIDE); {$ELSE} FDragForm.Hide; {$ENDIF} FActive := False; end; end; procedure TKDragWindow.Init(IniCtrl: TCustomControl; const ARect: TRect; const AInitialPos: TPoint; AMasterAlpha: Byte; AGradient: Boolean); var Org: TPoint; W, H: Integer; ScreenDC: HDC; begin if not FActive and ((IniCtrl = nil) or (IniCtrl is TKCustomControl)) then begin FActive := True; FBitmapFilled := False; FControl := IniCtrl; FMasterAlpha := AMasterAlpha; FGradient := AGradient; FInitialPos := AInitialPos; FRect := ARect; W := ARect.Right - ARect.Left; H := ARect.Bottom - ARect.Top; FBitmap.SetSize(W, H); ScreenDC := GetDC(0); try FAlphaEffects := GetDeviceCaps(ScreenDC, BITSPIXEL) >= 15; // because alpha blending is not nice elsewhere finally ReleaseDC(0, ScreenDC); end; if FControl <> nil then begin Org := FControl.ClientToScreen(ARect.TopLeft); // to be compatible with all LCL widgetsets we must copy the control's part // while painting in TKCustomControl.Paint! TKCustomControl(FControl).MemoryCanvas := FBitmap.Canvas; TKCustomControl(FControl).MemoryCanvasRect := ARect; TKCustomControl(FControl).Repaint; end else Org := ARect.TopLeft; {$IFDEF MSWINDOWS} if FLayered then with FBlend do begin BlendOp := AC_SRC_OVER; BlendFlags := 0; SourceConstantAlpha := 255; if FAlphaEffects then AlphaFormat := AC_SRC_ALPHA else AlphaFormat := 0; end; SetWindowPos(FWindow, HWND_TOP, Org.X, Org.Y, W, H, SWP_NOACTIVATE); {$ELSE} FDragForm.SetBounds(Org.X, Org.Y, W, H); {$ENDIF} end; end; procedure TKDragWindow.Move(ARect: PRect; const ACurrentPos: TPoint; AShowAlways: Boolean); var R: TRect; DX, DY: Integer; BlendColor: TColor; ChangedPos: Boolean; {$IFDEF MSWINDOWS} ScreenDC: HDC; CanvasOrigin: TPoint; {$ENDIF} begin if FActive then begin ChangedPos := False; DX := ACurrentPos.X - FInitialPos.X; DY := ACurrentPos.Y - FInitialPos.Y; if (DX <> 0) or (DY <> 0) then begin FInitialPos := ACurrentPos; ChangedPos := True; end; if ARect <> nil then ChangedPos := ChangedPos or not EqualRect(ARect^, FRect); if ((FControl = nil) or (TKCustomControl(FControl).MemoryCanvas = nil)) and not FBitmapFilled or (ARect <> nil) then begin FBitmapFilled := True; if ARect <> nil then FBitmap.SetSize(ARect.Right - ARect.Left, ARect.Bottom - ARect.Top); FBitmap.UpdatePixels; if FAlphaEffects then begin if FLayered then BlendColor := clBlack else BlendColor := clWhite; FBitmap.AlphaFill(FMasterAlpha, BlendColor, FGradient, FLayered); FBitmap.UpdateHandle; end; end; if ChangedPos or AShowAlways then begin {$IFDEF MSWINDOWS} if ARect <> nil then R := ARect^ else GetWindowRect(FWindow, R); KFunctions.OffsetRect(R, DX, DY); if FLayered then begin R.Right := FBitmap.Width; R.Bottom := FBitmap.Height; CanvasOrigin := CreateEmptyPoint; ScreenDC := GetDC(0); try if FUpdateLayeredWindow(FWindow, ScreenDC, @R.TopLeft, PSize(@R.BottomRight), FBitmap.Canvas.Handle, @CanvasOrigin, clNone, @FBlend, ULW_ALPHA) then if FBitmapFilled then ShowWindow(FWindow, SW_SHOWNOACTIVATE); finally ReleaseDC(0, ScreenDC); end; end else if FBitmapFilled then SetWindowPos(FWindow, 0, R.Left, R.Top, 0, 0, SWP_NOACTIVATE or SWP_NOSIZE or SWP_NOZORDER or SWP_SHOWWINDOW); {$ELSE} if ARect <> nil then R := ARect^ else R := FDragForm.BoundsRect; OffsetRect(R, DX, DY); FDragForm.BoundsRect := R; if FBitmapFilled then begin FDragForm.Visible := True; if FControl <> nil then SetCaptureControl(FControl); end; {$ENDIF} end; end; end; { TKHintWindow } constructor TKHintWindow.Create(AOwner: TComponent); begin inherited; {$IFDEF FPC} ShowInTaskBar := stNever; {$ENDIF} DoubleBuffered := True; end; procedure TKHintWindow.ShowAt(const Origin: TPoint); begin ActivateHint(Rect(Origin.X, Origin.Y, Origin.X + FExtent.X + 10, Origin.Y + FExtent.Y + 10), ''); // ActivateWithBounds(Rect(Origin.X, Origin.Y, Origin.X + FExtent.X + 10, Origin.Y + FExtent.Y + 10), ''); end; procedure TKHintWindow.Hide; begin {$IFDEF FPC} inherited Hide; {$ELSE} Self.DestroyHandle; {$ENDIF} end; procedure TKHintWindow.WMEraseBkGnd(var Msg: TLMessage); begin Msg.Result := 1; end; { TKTextHint } constructor TKTextHint.Create(AOwner: TComponent); begin inherited; FText := ''; {$IFDEF FPC} Font := Screen.HintFont; {$ENDIF} end; procedure TKTextHint.Paint; var TextBox: TKTextBox; begin Canvas.Font := Font; Canvas.Brush.Style := bsSolid; Canvas.Brush.Color := clInfoBk; Canvas.FillRect(ClientRect); Canvas.Brush.Style := bsClear; TextBox := TKTextBox.Create; try TextBox.Attributes := [taEndEllipsis, taWordBreak, taLineBreak]; TextBox.HPadding := 5; TextBox.VPadding := 5; TextBox.Text := FText; TextBox.Draw(Canvas, Rect(0, 0, FExtent.X + 10, FExtent.Y + 10)); finally TextBox.Free; end; end; procedure TKTextHint.SetText(const Value: TKString); var R: TRect; TextBox: TKTextBox; begin if Value <> FText then begin FText := Value; R := Rect(0, 0, 300, 0); TextBox := TKTextBox.Create; try TextBox.Attributes := [taWordBreak, taLineBreak]; TextBox.Text := FText; TextBox.Measure(Canvas, R, FExtent.X, FExtent.Y); finally TextBox.Free; end; end; end; { TKGraphicHint } constructor TKGraphicHint.Create(AOwner: TComponent); begin inherited; FGraphic := nil; {$IFDEF FPC} ShowInTaskBar := stNever; {$ENDIF} DoubleBuffered := True; end; procedure TKGraphicHint.Paint; begin Canvas.Brush.Style := bsSolid; Canvas.Brush.Color := clInfoBk; Canvas.FillRect(ClientRect); if Assigned(FGraphic) then Canvas.Draw(5, 5, FGraphic) end; procedure TKGraphicHint.SetGraphic(const Value: TGraphic); begin if Value <> FGraphic then begin FGraphic := Value; FExtent.X := FGraphic.Width; FExtent.Y := FGraphic.Height; end; end; { TKSizingGrips } constructor TKSizingGrips.Create; begin FBoundsRect := CreateEmptyRect; FGripColor := cSizingGripColor; FGripSize := cSizingGripSize; FMidGripConstraint := cSizingMidGripConstraint; end; class procedure TKSizingGrips.ClsAffectRect(APosition: TKSizingGripPosition; ADX, ADY: Integer; var ARect: TRect); begin case APosition of sgpLeft: Inc(ARect.Left, ADX); sgpRight: Inc(ARect.Right, ADX); sgpTop: Inc(ARect.Top, ADY); sgpBottom: Inc(ARect.Bottom, ADY); sgpTopLeft: begin Inc(ARect.Left, ADX); Inc(ARect.Top, ADY); end; sgpTopRight: begin Inc(ARect.Right, ADX); Inc(ARect.Top, ADY); end; sgpBottomLeft: begin Inc(ARect.Left, ADX); Inc(ARect.Bottom, ADY); end; sgpBottomRight: begin Inc(ARect.Right, ADX); Inc(ARect.Bottom, ADY); end; else KFunctions.OffsetRect(ARect, ADX, ADY); end; end; function TKSizingGrips.CursorAt(const APoint: TPoint): TCursor; begin Result := CursorFor(HitTest(APoint)); end; function TKSizingGrips.CursorFor(APosition: TKSizingGripPosition): TCursor; begin case APosition of sgpLeft, sgpRight: Result := crSizeWE; sgpTop, sgpBottom: Result := crSizeNS; sgpTopLeft, sgpBottomRight: Result := crSizeNWSE; sgpTopRight, sgpBottomLeft: Result := crSizeNESW; else Result := crDefault; end; end; procedure TKSizingGrips.DrawTo(ACanvas: TCanvas); begin with ACanvas do begin Brush.Style := bsSolid; Brush.Color := FGripColor; // take the corners first ACanvas.FillRect(GripRect(sgpTopLeft)); ACanvas.FillRect(GripRect(sgpTopRight)); ACanvas.FillRect(GripRect(sgpBottomLeft)); ACanvas.FillRect(GripRect(sgpBottomRight)); // take middle grips if FBoundsRect.Right - FBoundsRect.Left >= FMidGripConstraint then begin ACanvas.FillRect(GripRect(sgpTop)); ACanvas.FillRect(GripRect(sgpBottom)); end; if FBoundsRect.Bottom - FBoundsRect.Top >= FMidGripConstraint then begin ACanvas.FillRect(GripRect(sgpLeft)); ACanvas.FillRect(GripRect(sgpRight)); end; end; end; function TKSizingGrips.GripRect(APosition: TKSizingGripPosition): TRect; begin case APosition of sgpLeft: begin Result.Left := FBoundsRect.Left; Result.Top := FBoundsRect.Top + (FBoundsRect.Bottom - FBoundsRect.Top - FGripSize) div 2; end; sgpRight: begin Result.Left := FBoundsRect.Right - FGripSize; Result.Top := FBoundsRect.Top + (FBoundsRect.Bottom - FBoundsRect.Top - FGripSize) div 2; end; sgpTop: begin Result.Left := FBoundsRect.Left + (FBoundsRect.Right - FBoundsRect.Left - FGripSize) div 2; Result.Top := FBoundsRect.Top; end; sgpBottom: begin Result.Left := FBoundsRect.Left + (FBoundsRect.Right - FBoundsRect.Left - FGripSize) div 2; Result.Top := FBoundsRect.Bottom - FGripSize; end; sgpTopLeft: begin Result.Left := FBoundsRect.Left; Result.Top := FBoundsRect.Top; end; sgpTopRight: begin Result.Left := FBoundsRect.Right - FGripSize; Result.Top := FBoundsRect.Top; end; sgpBottomLeft: begin Result.Left := FBoundsRect.Left; Result.Top := FBoundsRect.Bottom - FGripSize; end; sgpBottomRight: begin Result.Left := FBoundsRect.Right - FGripSize; Result.Top := FBoundsRect.Bottom - FGripSize; end else Result := CreateEmptyRect; end; if APosition <> sgpNone then begin Result.Right := Result.Left + FGripSize; Result.Bottom := Result.Top + FGripSize; end; end; function TKSizingGrips.HitTest(const APoint: TPoint): TKSizingGripPosition; var I: TKSizingGripPosition; R: TRect; begin Result := sgpNone; for I := Low(TKSizingGripPosition) to High(TKSizingGripPosition) do if I <> sgpNone then begin R := GripRect(I); if PtInRect(R, APoint) then begin Result := I; Break; end; end; end; procedure RegisterAlphaBitmap; begin TPicture.RegisterFileFormat('BMA', sGrAlphaBitmap, TKAlphaBitmap); end; procedure UnregisterAlphaBitmap; begin TPicture.UnregisterGraphicClass(TKAlphaBitmap); end; {$IFDEF REGISTER_PICTURE_FORMATS} initialization RegisterAlphaBitmap; finalization //not necessary, but... UnregisterAlphaBitmap; {$ENDIF} end. tomboy-ng_0.34-1/kcontrols/source/kedits.res0000644000175000017500000000156414125207534020740 0ustar dbannondbannon (,OPENDIR0(rpnnnnnnno}))))))))))8X~))`7o))`|)W})h)`{rh7o)[)`quvuqkd[)X})KR)``a`]YRKK:u)`e)))))))))))~))u)֤)))))֤))֡xto)))֤}n{zyqtomboy-ng_0.34-1/kcontrols/source/kcontrols.pas0000644000175000017500000041341614125207534021470 0ustar dbannondbannon{ @abstract(This file is part of the KControls component suite for Delphi and Lazarus.) @author(Tomas Krysl) Copyright (c) 2020 Tomas Krysl

License:
This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } unit kcontrols; // lowercase name because of Lazarus/Linux {$include kcontrols.inc} {$WEAKPACKAGEUNIT ON} interface uses {$IFDEF FPC} LCLType, LCLIntf, LMessages, LCLProc, LResources, {$ELSE} Windows, Messages, {$ENDIF} SysUtils, Classes, Graphics, Controls, Contnrs, Printers, Forms, KFunctions {$IFDEF USE_THEMES} , Themes {$IFNDEF FPC} , UxTheme {$ENDIF} {$ENDIF} ; type { This array serves as storage place for all colors. } TKColorArray = array of TColor; { Declares possible indexes for colors available in @link(TKPreviewColors). } TKPreviewColorIndex = Integer; { Declares print options - possible values for the @link(TKPrintPageSetup.Options) property. } TKPrintOption = ( { If there are more printed copies these will be collated. } poCollate, { The printed shape will be scaled to fit on page. } poFitToPage, { Every even page will be printed with mirrored (swapped) margins. } poMirrorMargins, { Page numbers will be added to the bottom of each printed page. } poPageNumbers, { Paints the selection in control's specific manner. } poPaintSelection, { Title will be printed to the top of each printed page. } poTitle, { Color page will be printed instead of B/W page. } poUseColor, { Print line numbers if applicable. } poLineNumbers, { Wrap long lines if applicable. } poWrapLines ); { Print options can be arbitrary combined. } TKPrintOptions = set of TKPrintOption; { Declares possible values for the @link(TKPrintPageSetup.Range) property. } TKPrintRange = ( { All pages will be printed. } prAll, { Only selected block will be printed. } prSelectedOnly, { Only given range of pages will be printed. } prRange ); { Declares measurement units for KControls printing system. } TKPrintUnits = ( { Corresponding value is given in millimeters. } puMM, { Corresponding value is given in centimeters. } puCM, { Corresponding value is given in inches. } puInch, { Corresponding value is given in hundredths of inches. } puHundredthInch ); const {$IFNDEF FPC} { @exclude } KM_MOUSELEAVE = WM_MOUSELEAVE; { @exclude } LM_USER = WM_USER; { @exclude } LM_CANCELMODE = WM_CANCELMODE; { @exclude } LM_CHAR = WM_CHAR; { @exclude } LM_CLEAR = WM_CLEAR; { @exclude } LM_CLOSEQUERY = WM_CLOSE; { @exclude } LM_COPY = WM_COPY; { @exclude } LM_CUT = WM_CUT; { @exclude } LM_DROPFILES = WM_DROPFILES; { @exclude } LM_ERASEBKGND = WM_ERASEBKGND; { @exclude } LM_GETDLGCODE = WM_GETDLGCODE; { @exclude } LM_HSCROLL = WM_HSCROLL; { @exclude } LM_KEYDOWN = WM_KEYDOWN; { @exclude } LM_KILLFOCUS = WM_KILLFOCUS; { @exclude } LM_LBUTTONDOWN = WM_LBUTTONDOWN; { @exclude } LM_LBUTTONUP = WM_LBUTTONUP; { @exclude } LM_MOUSEMOVE = WM_MOUSEMOVE; { @exclude } LM_MOVE = WM_MOVE; { @exclude } LM_PASTE = WM_PASTE; { @exclude } LM_PAINT = WM_PAINT; { @exclude } LM_SETFOCUS = WM_SETFOCUS; { @exclude } LM_SIZE = WM_SIZE; { @exclude } LM_VSCROLL = WM_VSCROLL; { @exclude } LCL_MAJOR = 0; { @exclude } LCL_MINOR = 0; { @exclude } LCL_RELEASE = 0; {$ELSE} { @exclude } KM_MOUSELEAVE = LM_MOUSELEAVE; // LCL 0.9.27+, for older it was LM_LEAVE { @exclude } //WM_CTLCOLORBTN = Messages.WM_CTLCOLORBTN; { @exclude } //WM_CTLCOLORSTATIC = Messages.WM_CTLCOLORSTATIC; {$ENDIF} { Base for custom messages used by KControls suite. } KM_BASE = LM_USER + 1024; { Custom message. } KM_LATEUPDATE = KM_BASE + 1; { Recalculate scroll box size and scrollbars. } KM_SCROLL = KM_BASE + 2; { Constant for horizontal resize cursor. } crHResize = TCursor(101); { Constant for vertical resize cursor. } crVResize = TCursor(102); { Constant for uncaptured dragging cursor. } crDragHandFree = TCursor(103); { Constant for captured dragging cursor. } crDragHandGrip = TCursor(104); { Default value for the @link(TKCustomControl.BorderStyle) property. } cBorderStyleDef = bsSingle; cRectBottomDef = 0; cRectLeftDef = 0; cRectRightDef = 0; cRectTopDef = 0; { Minimum for the @link(TKPrintPageSetup.Copies) property } cCopiesMin = 1; { Maximum for the @link(TKPrintPageSetup.Copies) property } cCopiesMax = 1000; { Default value for the @link(TKPrintPageSetup.Copies) property } cCopiesDef = 1; { Default value for the @link(TKPrintPageSetup.UnitMarginBottom) property } cMarginBottomDef = 2.0; { Default value for the @link(TKPrintPageSetup.UnitMarginLeft) property } cMarginLeftDef = 1.5; { Default value for the @link(TKPrintPageSetup.UnitMarginRight) property } cMarginRightDef = 1.5; { Default value for the @link(TKPrintPageSetup.UnitMarginTop) property } cMarginTopDef = 1.8; { Default value for the @link(TKPrintPageSetup.Options) property. } cOptionsDef = [poFitToPage, poPageNumbers, poUseColor]; cOptionsAll = [Low(TKPrintOption)..High(TKPrintOption)]; { Default value for the @link(TKPrintPageSetup.Options) property. } cRangeDef = prAll; { Default value for the @link(TKPrintPageSetup.Scale) property } cScaleDef = 100; { Minimum for the @link(TKPrintPageSetup.Scale) property } cScaleMin = 10; { Maximum for the @link(TKPrintPageSetup.Scale) property } cScaleMax = 500; { Default DPI value } cDPIDef = 96; { Minimum DPI value } cDPIMin = 50; { Maximum DPI value } cDPIMax = 1000; { Default value for the @link(TKPrintPageSetup.Units) property. } cUnitsDef = puCM; { Default value for the @link(TKPreviewColors.Paper) color property. } cPaperDef = clWhite; { Default value for the @link(TKPreviewColors.BkGnd) color property. } cBkGndDef = clAppWorkSpace; { Default value for the @link(TKPreviewColors.Border) color property. } cBorderDef = clBlack; { Default value for the @link(TKPreviewColors.SelectedBorder) color property. } cSelectedBorderDef = clNavy; { Index for the @link(TKPreviewColors.Paper) property. } ciPaper = TKPreviewColorIndex(0); { Index for the @link(TKPreviewColors.BkGnd) property. } ciBkGnd = TKPreviewColorIndex(1); { Index for the @link(TKPreviewColors.Border) property. } ciBorder = TKPreviewColorIndex(2); { Index for the @link(TKPreviewColors.SelectedBorder) property. } ciSelectedBorder = TKPreviewColorIndex(3); { Maximum color array index } ciPreviewColorsMax = ciSelectedBorder; { Constant for control scrollbars. It means: Leave that scrollbar untouched. } cScrollNoAction = -1; { Constant for control scrollbars. It means: Use given Delta to update scrollbar. } cScrollDelta = -2; { Internal flag for TKPrintPreview. } cPF_Dragging = $00000001; { Internal flag for TKPrintPreview. } cPF_UpdateRange = $00000002; type {$IFNDEF FPC} { @exclude } TLMessage = TMessage; { @exclude } TLMCopy = TWMCopy; { @exclude } TLMMouse = TWMMouse; { @exclude } TLMNoParams = TWMNoParams; { @exclude } TLMKey = TWMKey; { @exclude } TLMChar = TWMChar; { @exclude } TLMEraseBkGnd = TWMEraseBkGnd; { @exclude } TLMHScroll = TWMHScroll; { @exclude } TLMKillFocus = TWMKillFocus; { @exclude } TLMMove = TWMMove; { @exclude } TLMPaint = TWMPaint; { @exclude } TLMPaste = TWMPaste; { @exclude } TLMSetFocus = TWMSetFocus; { @exclude } TLMSize = TWMSize; { @exclude } TLMVScroll = TWMVScroll; {$IFNDEF COMPILER17_UP} { Support for Win64 messaging. } LONG_PTR = Longint; {$ENDIF} {$ENDIF} {$IFDEF FPC} TKClipboardFormat = TClipboardFormat; {$ELSE} TKClipboardFormat = Word; {$ENDIF} { Declares possible values for the @link(ScaleMode) property } TKPreviewScaleMode = ( { Apply scale defined by the @link(Scale) property } smScale, { Scale the page so that it horizontally fits to the window client area } smPageWidth, { Scale the page so that it fits to the window client area } smWholePage); { @abstract(Declares @link(TKPrintPreview.OnChanged) event handler) } TKPreviewChangedEvent = procedure(Sender: TObject) of object; { @abstract(Declares the information structure for the @link(TKCustomControl.MeasurePages) method) } TKPrintMeasureInfo = record OutlineWidth: Integer; OutlineHeight: Integer; ControlHorzPageCount: Integer; ControlVertPageCount: Integer; ExtraLeftHorzPageCount: Integer; ExtraLeftVertPageCount: Integer; ExtraRightHorzPageCount: Integer; ExtraRightVertPageCount: Integer; end; { Declares possible values for the Status parameter in the @link(TKPrintNotifyEvent) event } TKPrintStatus = ( { This event occurs at the beginning of the print job - you may show an Abort dialog here } epsBegin, { This event occurs after each page has been printed - you may update the Page/Copy information in the Abort dialog } epsNewPage, { This event occurs at the end of the print job - you may hide the Abort dialog here } epsEnd ); { @abstract(Declares @link(TKCustomControl.OnPrintNotify) event handler) Remark: At certain time slots, the print spooler allows the message queue to be processed for the thread where the print job is running. This e.g. allows the user to press a button on the Abort dialog. Because this message loop can be invoked e.g. during a Printer.Canvas.TextRect function and any painting messages may hover in the message queue, any functions used both to print a job and to process particular messages should be reentrant to avoid conflicts. Perhaps should print jobs be run in seperate threads? } TKPrintNotifyEvent = procedure(Sender: TObject; Status: TKPrintStatus; var Abort: Boolean) of object; { @abstract(Declares @link(TKCustomControl.OnPrintPaint) event handler) } TKPrintPaintEvent = procedure(Sender: TObject) of object; TKPrintPageSetup = class; TKPrintPreview = class; TKRect = class(TPersistent) private FLeft, FTop, FRight, FBottom: Integer; FOnChanged: TNotifyEvent; procedure SetBottom(const Value: Integer); procedure SetLeft(const Value: Integer); procedure SetRight(const Value: Integer); procedure SetTop(const Value: Integer); procedure SetAll(const Value: Integer); function GetHeight: Integer; function GetWidth: Integer; protected procedure Changed; public constructor Create; procedure Assign(Source: TPersistent); override; procedure AssignFromRect(const ARect: TRect); procedure AssignFromValues(ALeft, ATop, ARight, ABottom: Integer); function ContainsPoint(const APoint: TPoint): Boolean; function EqualProperties(const ARect: TKRect): Boolean; function NonZero: Boolean; function OffsetRect(ARect: TKRect): TRect; overload; function OffsetRect(const ARect: TRect): TRect; overload; property All: Integer write SetAll; property OnChanged: TNotifyEvent read FOnChanged write FOnChanged; published property Left: Integer read FLeft write SetLeft default cRectLeftDef; property Top: Integer read FTop write SetTop default cRectTopDef; property Right: Integer read FRight write SetRight default cRectRightDef; property Bottom: Integer read FBottom write SetBottom default cRectBottomDef; property Width: Integer read GetWidth; property Height: Integer read GetHeight; end; { Base class for all visible controls in KControls. } { TKCustomControl } TKCustomControl = class(TCustomControl) private {$IF DEFINED(FPC) OR NOT DEFINED(COMPILER10_UP)} FParentBackground: Boolean; FParentDoubleBuffered: Boolean; {$IFEND} {$IFNDEF FPC} FBorderStyle: TBorderStyle; {$ENDIF} {$IFNDEF COMPILER10_UP} FMouseInClient: Boolean; {$ENDIF} FMemoryCanvas: TCanvas; FMemoryCanvasRect: TRect; FPageSetup: TKPrintPageSetup; FUpdateLock: Integer; FOnPrintNotify: TKPrintNotifyEvent; FOnPrintPaint: TKPrintPaintEvent; {$IFNDEF FPC} procedure CMCancelMode(var Msg: TMessage); message CM_CANCELMODE; procedure CMCtl3DChanged(var Msg: TMessage); message CM_CTL3DCHANGED; {$ENDIF} procedure CMMouseLeave(var Msg: TLMessage); message CM_MOUSELEAVE; function GetCanPrint: Boolean; function GetPageSetup: TKPrintPageSetup; function GetPageSetupAllocated: Boolean; procedure KMLateUpdate(var Msg: TLMessage); message KM_LATEUPDATE; {$IFNDEF FPC} procedure SetBorderStyle(Value: TBorderStyle); {$ENDIF} procedure SetPageSetup(Value: TKPrintPageSetup); {$IFNDEF FPC} procedure WMCancelMode(var Msg: TWMCancelMode); message WM_CANCELMODE; {$ENDIF} {$IFNDEF COMPILER10_UP} procedure WMMouseLeave(var Msg: TLMessage); message KM_MOUSELEAVE; {$ENDIF} {$IFNDEF FPC} procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT; procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR; {$ENDIF} procedure WMSize(var Msg: TLMSize); message LM_SIZE; {$IFNDEF FPC} {$IFDEF USE_THEMES} procedure WMThemeChanged(var Msg: TMessage); message WM_THEMECHANGED; {$ENDIF} {$ENDIF} protected { Holds the mutually inexclusive state as cXF... flags. } FFlags: Cardinal; { Defines the message queue for late update. } FMessages: array of TLMessage; { Previous size of control client area. } FOldClientSize: TPoint; { Gains access to the list of associated previews. } FPreviewList: TList; FResizeCalled: Boolean; { Adds a preview control to the internal list of associated previews. } procedure AddPreview(APreview: TKPrintPreview); { Gives the descendant the possibility to adjust the associated TKPrintPageSetup instance just before printing. } procedure AdjustPageSetup; virtual; { Calls @link(TKCustomControl.UpdateSize) only when the control client area has been really modified. } procedure CallUpdateSize; virtual; { Cancels any dragging or resizing operations performed by mouse. } procedure CancelMode; virtual; { Overriden method. Calls @link(TKCustomControl.UpdateSize). } procedure CreateHandle; override; { Defines additional styles. } procedure CreateParams(var Params: TCreateParams); override; {$IFDEF FPC} { Overriden method. Calls @link(TKCustomControl.UpdateSize). } procedure DoOnChangeBounds; override; {$ENDIF} { If Value is True, includes the flag specified by AFLag to @link(FFlags). If Value is False, excludes the flag specified by AFLag from @link(FFlags). } procedure FlagAssign(AFlag: Cardinal; Value: Boolean); { Excludes the flag specified by AFLag from @link(FFlags). } procedure FlagClear(AFlag: Cardinal); { Includes the flag specified by AFLag to @link(FFlags). } procedure FlagSet(AFlag: Cardinal); { If the flag specified by AFLag is included in @link(FFlags), FlagToggle excludes it and vice versa. } procedure FlagToggle(AFlag: Cardinal); { Invalidates the page setup settings. If page setup is required again, it's UpdateSettings method is called. } procedure InvalidatePageSetup; { Invalidates a rectangular part of the client area if control updating is not locked by @link(TKCustomControl.LockUpdate). } procedure InvalidateRectArea(const R: TRect); virtual; { Returns True if the control has a selection. } function InternalGetSelAvail: Boolean; virtual; { Called in UnlockUpdate. Allows the changes to be reflected. } procedure InternalUnlockUpdate; virtual; { Determines if control can be painted with OS themes. } function IsThemed: Boolean; virtual; { Called from KM_LATEUPDATE. Performs late update. Override to adapt. } procedure LateUpdate(var Msg: TLMessage); virtual; { Updates information about printed shape. } procedure MeasurePages(var Info: TKPrintMeasureInfo); virtual; { Retrieves a message from message queue if there is one. Used for late update.} function MessagePeek(out Msg: TLMessage): Boolean; { Puts a new message into the message queue. Used for late update.} procedure MessagePoke(const Msg: TLMessage); { Searches the message queue for given message code. } function MessageSearch(MsgCode: Cardinal): Boolean; { Responds to WM_MOUSELEAVE message. } procedure MouseFormLeave; virtual; { Overriden method - see Delphi help. } procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; { Notifies all associated previews about a change in the associated page setup. } procedure NotifyPreviews; { Overriden method - see Delphi help. Paints the entire control client area. } procedure Paint; override; { Paints a page to a printer/preview canvas. } procedure PaintPage; virtual; { Paints the control to the specified canvas. Must always be overriden. } procedure PaintToCanvas(ACanvas: TCanvas); virtual; abstract; { Adds a message to message queue for late update. Set IfNotExists to True to add that message only if the specified message code does not exist in the message queue at this moment. } procedure PostLateUpdate(const Msg: TLMessage; IfNotExists: Boolean = False); { Calls the @link(TKCustomControl.OnPrintNotify) event } procedure PrintNotify(Status: TKPrintStatus; var Abort: Boolean); virtual; { Calls the @link(TKCustomControl.OnPrintPaint) event } procedure PrintPaint; virtual; { Allows descendant to make necessary adjustments before printing or painting to preview starts. } procedure PrintPaintBegin; virtual; { Allows descendant to make necessary adjustments after printing or painting to preview ended. } procedure PrintPaintEnd; virtual; { Remove a preview control to the internal list of associated previews. } procedure RemovePreview(APreview: TKPrintPreview); { Respond to resize calls} procedure Resize; override; { Updates mouse cursor according to the state determined from current mouse position. Returns True if cursor has been changed. } function SetMouseCursor(X, Y: Integer): Boolean; virtual; { Updates the control size. Responds to WM_SIZE under Delphi and similar notifications under Lazarus. } procedure UpdateSize; virtual; public { Creates the instance. Assigns default values to properties, allocates default column, row and cell data. } constructor Create(AOwner: TComponent); override; { Destroys the instance along with all allocated column, row and cell data. See TObject.Destroy in Delphi help. } destructor Destroy; override; { Determines whether a flag specified by AFlag is included in @link(FFlags). } function Flag(AFlag: Cardinal): Boolean; { Invalidates the entire control if control updating is not locked by @link(TKCustomControl.LockUpdate). } procedure Invalidate; override; { Locks control updating so that all possibly slow operations such as all Invalidate... methods will not be performed. This is useful e.g. when assigning many properties at one time. Every LockUpdate call must have a corresponding @link(TKCustomControl.UnlockUpdate) call, please use a try-finally section. } procedure LockUpdate; virtual; { Prints the control. } procedure PrintOut; { Unlocks back to normal control updating and calls InternalUnlockUpdate to reflect (possible) multiple changes made. Each @link(LockUpdate) call must be always followed by the UnlockUpdate call. } procedure UnlockUpdate; virtual; { Returns True if control updating is not locked, i.e. there is no open LockUpdate and UnlockUpdate pair. } function UpdateUnlocked: Boolean; virtual; { Determines whether a single line border is drawn around the control. Set BorderStyle to bsSingle to add a single line border around the control. Set BorderStyle to bsNone to omit the border. } {$IFDEF FPC} property BorderStyle default cBorderStyleDef; {$ELSE} property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default cBorderStyleDef; {$ENDIF} { Returns True if the control has anything to print and a printer is installed. } property CanPrint: Boolean read GetCanPrint; {$IFNDEF COMPILER10_UP} { This property has the same meaning as the MouseInClient property introduced into TWinControl in BDS 2006. } property MouseInClient: Boolean read FMouseInClient; {$ENDIF} { Setting this property causes the control to be painted to MemoryCanvas in it's Paint method. This approach replaces PaintTo as it does not work good for all LCL widget sets. The control is painted normally on it's Canvas and then copied only once to MemoryCanvas. MemoryCanvas is then set to nil (not freed) to indicate the copying is complete. } property MemoryCanvas: TCanvas read FMemoryCanvas write FMemoryCanvas; { Specifies what rectangular part of the control should be copied on MemoryCanvas. } property MemoryCanvasRect: TRect read FMemoryCanvasRect write FMemoryCanvasRect; { This event is called at certain phases of the actually running print job. } property OnPrintNotify: TKPrintNotifyEvent read FOnPrintNotify write FOnPrintNotify; { This event is called after the shape was drawn onto the printer canvas. } property OnPrintPaint: TKPrintPaintEvent read FOnPrintPaint write FOnPrintPaint; { Specifies the page setup component used for this control. } property PageSetup: TKPrintPageSetup read GetPageSetup write SetPageSetup; {Returns True if page setup component is allocated for this control. } property PageSetupAllocated: Boolean read GetPageSetupAllocated; { Just to be compatible with Delphi. } {$IF DEFINED(FPC) OR NOT DEFINED(COMPILER10_UP)} property ParentBackground: Boolean read FParentBackground write FParentBackground default True; property ParentDoubleBuffered: Boolean read FParentDoubleBuffered write FParentDoubleBuffered default True; {$IFEND} end; { Declares possible values for the @link(TKCustomColors.ColorScheme) property. } TKColorScheme = ( { GetColor returns normal color currently defined for each item } csNormal, { GetColor returns gray for text and line colors and white for background colors } csGrayed, { GetColor returns brighter version of normal color } csBright, { GetColor returns grayscaled color versions } csGrayScale ); { Declares possible indexes e.g. for the @link(TKCustomColors.Color) property. } TKColorIndex = Integer; { @abstract(Declares the color description structure returned by @link(TKCustomColors.ColorData) property) } TKColorData = record Index: TKColorIndex; Color: TColor; Default: TColor; Name: string; end; { @abstract(Declares @link(TKCustomColors) color item description) } TKColorSpec = record Def: TColor; Name: string; end; { @abstract(Container for all colors used by specific control) This container allows to group many colors into one item in object inspector. Colors are accessible via published properties or several public Color* properties. } TKCustomColors = class(TPersistent) private function GetColorData(Index: TKColorIndex): TKColorData; function GetColorEx(Index: TKColorIndex): TColor; function GetColorName(Index: TKColorIndex): string; function GetDefaultColor(Index: TKColorIndex): TColor; procedure SetColorEx(Index: TKColorIndex; Value: TColor); procedure SetColors(const Value: TKColorArray); protected FControl: TKCustomControl; FColorScheme: TKColorScheme; FBrightColors: TKColorArray; FColors: TKColorArray; { Returns the specific color. Use for property assignments. } function GetColor(Index: TKColorIndex): TColor; { Returns color specification structure for given index. } function GetColorSpec(Index: TKColorIndex): TKColorSpec; virtual; { Returns maximum color index. } function GetMaxIndex: Integer; virtual; { Initializes the color array. } procedure Initialize; virtual; { Returns the specific color according to ColorScheme. } function InternalGetColor(Index: TKColorIndex): TColor; virtual; { Replaces the specific color. } procedure InternalSetColor(Index: TKColorIndex; Value: TColor); virtual; { Replaces the specific color. Use for property assignments. } procedure SetColor(Index: TKColorIndex; Value: TColor); public { Creates the instance. You can create a custom instance and pass it e.g. to a @link(TKCustomGrid.Colors) property. The AGrid parameter has no meaning in this case and you may set it to nil. } constructor Create(AControl: TKCustomControl); virtual; { Copies the properties of another instance that inherits from TPersistent into this TKGridColors instance. } procedure Assign(Source: TPersistent); override; { Clears cached brighter colors. } procedure ClearBrightColors; virtual; { Returns always normal color - regardless of the ColorScheme setting. } property Color[Index: TKColorIndex]: TColor read GetColorEx write SetColorEx; { Returns always a complete color description } property ColorData[Index: TKColorIndex]: TKColorData read GetColorData; { Returns (localizable) color name. } property ColorName[Index: TKColorIndex]: string read GetColorName; { Returns array of normal colors. } property Colors: TKColorArray read FColors write SetColors; { Specifies color scheme for reading of published properties - see GetColor in source code. } property ColorScheme: TKColorScheme read FColorScheme write FColorScheme; { Returns default color. } property DefaultColor[Index: TKColorIndex]: TColor read GetDefaultColor; end; { @abstract(Declares @link(TKPrintPageSetup.OnPrintMeasure) event handler) } TKPrintMeasureEvent = procedure(Sender: TObject; var Info: TKPrintMeasureInfo) of object; { @abstract(Class to specify the print job parameters) } TKPrintPageSetup = class(TKPersistent) private FActive: Boolean; FCanvas: TCanvas; FControl: TKCustomControl; FControlHorzPageCount: Integer; FControlPageCount: Integer; FControlVertPageCount: Integer; FCopies: Integer; FCurrentCopy: Integer; FCurrentPage: Integer; FCurrentScale: Double; FDesktopPixelsPerInchX: Integer; FDesktopPixelsPerInchY: Integer; FEndPage: Integer; FExtraLeftHorzPageCount: Integer; FExtraLeftPageCount: Integer; FExtraLeftVertPageCount: Integer; FExtraRightHorzPageCount: Integer; FExtraRightPageCount: Integer; FExtraRightVertPageCount: Integer; FIsValid: Boolean; FMappedControlPaintAreaWidth: Integer; FMappedExtraSpaceLeft: Integer; FMappedExtraSpaceRight: Integer; FMappedFooterSpace: Integer; FMappedHeaderSpace: Integer; FMappedMarginBottom: Integer; FMappedMarginLeft: Integer; FMappedMarginLeftMirrored: Integer; FMappedMarginRight: Integer; FMappedMarginRightMirrored: Integer; FMappedMarginTop: Integer; FMappedOutlineHeight: Integer; FMappedOutlineWidth: Integer; FMappedPaintAreaHeight: Integer; FMappedPaintAreaWidth: Integer; FMappedPageHeight: Integer; FMappedPageWidth: Integer; FOptions: TKPrintOptions; FOrientation: TPrinterOrientation; FPageCount: Integer; FPreviewing: Boolean; FPrinterControlPaintAreaWidth: Integer; FPrinterExtraSpaceLeft: Integer; FPrinterExtraSpaceRight: Integer; FPrinterFooterSpace: Integer; FPrinterHeaderSpace: Integer; FPrinterMarginBottom: Integer; FPrinterMarginLeft: Integer; FPrinterMarginLeftMirrored: Integer; FPrinterMarginRight: Integer; FPrinterMarginRightMirrored: Integer; FPrinterMarginTop: Integer; FPrinterName: string; FPrinterPageHeight: Integer; FPrinterPageWidth: Integer; FPrinterPaintAreaHeight: Integer; FPrinterPaintAreaWidth: Integer; FPrinterPixelsPerInchX: Integer; FPrinterPixelsPerInchY: Integer; FPrintingMapped: Boolean; FRange: TKPrintRange; FStartPage: Integer; FScale: Integer; FTitle: string; FUnitControlPaintAreaWidth: Double; FUnitExtraSpaceLeft: Double; FUnitExtraSpaceRight: Double; FUnitFooterSpace: Double; FUnitHeaderSpace: Double; FUnitMarginBottom: Double; FUnitMarginLeft: Double; FUnitMarginRight: Double; FUnitMarginTop: Double; FUnitPaintAreaHeight: Double; FUnitPaintAreaWidth: Double; FUnits: TKPrintUnits; FValidating: Boolean; FOnPrintMeasure: TKPrintMeasureEvent; FOnUpdateSettings: TNotifyEvent; function GetCurrentPageControl: Integer; function GetCurrentPageExtraLeft: Integer; function GetCurrentPageExtraRight: Integer; function GetIsDefaultPrinter: Boolean; procedure SetCopies(Value: Integer); procedure SetEndPage(Value: Integer); procedure SetUnitExtraSpaceLeft(Value: Double); procedure SetUnitExtraSpaceRight(Value: Double); procedure SetUnitFooterSpace(Value: Double); procedure SetUnitHeaderSpace(Value: Double); procedure SetUnitMarginBottom(Value: Double); procedure SetUnitMarginLeft(Value: Double); procedure SetUnitMarginRight(Value: Double); procedure SetUnitMarginTop(Value: Double); procedure SetOptions(Value: TKPrintOptions); procedure SetOrientation(AValue: TPrinterOrientation); procedure SetPrinterName(const Value: string); procedure SetPrintingMapped(Value: Boolean); procedure SetRange(Value: TKPrintRange); procedure SetScale(Value: Integer); procedure SetStartPage(Value: Integer); procedure SetUnits(Value: TKPrintUnits); protected function GetCanPrint: Boolean; virtual; function GetSelAvail: Boolean; virtual; { Called before new Units are set. Converts the margins to inches by default. } procedure AfterUnitsChange; virtual; { Called after new Units are set. Converts the margins from inches by default. } procedure BeforeUnitsChange; virtual; { Paints a page to APreview.Canvas. } procedure PaintPageToPreview(APreview: TKPrintPreview); virtual; { Prints the page number at the bottom of the page, horizontally centered. } procedure PrintPageNumber(Value: Integer); virtual; { Prints the title at the top of the page. } procedure PrintTitle; virtual; { Inherited method. Calls UpdateSettings. } procedure Update; override; { Updates entire printing information. } procedure UpdateSettings; virtual; public { Creates the instance. Assigns default values to properties. } constructor Create(AControl: TKCustomControl); reintroduce; virtual; { Copies shareable properties of another TKPrintPageSetup instance to this instance. } procedure Assign(Source: TPersistent); override; { Returns a value mapped from desktop horizontal units to printer horizontal units. } function HMap(Value: Integer): Integer; { Invalidates the settings. } procedure Invalidate; { Prints the associated control. } procedure PrintOut; { Validates the settings. } procedure Validate; { Returns a value mapped from desktop vertical units to printer vertical units. } function VMap(Value: Integer): Integer; { Returns True if printing or previewing is active. } property Active: Boolean read FActive; { Returns True if the control is associated and has anything to print. } property CanPrint: Boolean read GetCanPrint; { Returns the Printer.Canvas or TkPrintPreview.Canvas. Do not access outside print job. } property Canvas: TCanvas read FCanvas; { Returns the control to which this TKPrintPageSetup instance is assigned. } property Control: TKCustomControl read FControl; { Returns the maximum amount of control pages for horizontal axis. } property ControlHorzPageCount: Integer read FControlHorzPageCount; { Returns the maximum amount of control pages for vertical axis. } property ControlVertPageCount: Integer read FControlVertPageCount; { Specifies the number of copies to print. } property Copies: Integer read FCopies write SetCopies; { Returns the currently printed copy. } property CurrentCopy: Integer read FCurrentCopy; { Returns the currently printed page. } property CurrentPage: Integer read FCurrentPage; { Returns the currently printed page relative to the control shape. It must be used with associated control to print page. } property CurrentPageControl: Integer read GetCurrentPageControl; { Returns the currently printed page relative to the extra left shape. } property CurrentPageExtraLeft: Integer read GetCurrentPageExtraLeft; { Returns the currently printed page relative to the extra left shape. } property CurrentPageExtraRight: Integer read GetCurrentPageExtraRight; { Returns the horizontal scale for the printed shape, without dimension. } property CurrentScale: Double read FCurrentScale; { Returns the control paint area width on canvas in units depending on PrintingMapped. } property MappedControlPaintAreaWidth: Integer read FMappedControlPaintAreaWidth; { Returns the width of extra left paint area on canvas in units depending on PrintingMapped. } property MappedExtraSpaceLeft: Integer read FMappedExtraSpaceLeft; { Returns the width of extra right paint area on canvas in units depending on PrintingMapped. } property MappedExtraSpaceRight: Integer read FMappedExtraSpaceRight; { Returns the footer space in units depending on PrintingMapped. } property MappedFooterSpace: Integer read FMappedFooterSpace; { Returns the header space in units depending on PrintingMapped. } property MappedHeaderSpace: Integer read FMappedHeaderSpace; { Returns the bottom margin in units depending on PrintingMapped. } property MappedMarginBottom: Integer read FMappedMarginBottom; { Returns the left margin in units depending on PrintingMapped. } property MappedMarginLeft: Integer read FMappedMarginLeft; { Returns the left margin respecting current page in units depending on PrintingMapped. } property MappedMarginLeftMirrored: Integer read FMappedMarginLeftMirrored; { Returns the right margin in units depending on PrintingMapped. } property MappedMarginRight: Integer read FMappedMarginRight; { Returns the left margin respecting current page in units depending on PrintingMapped. } property MappedMarginRightMirrored: Integer read FMappedMarginRightMirrored; { Returns the top margin in units depending on PrintingMapped. } property MappedMarginTop: Integer read FMappedMarginTop; { Returns the printed shape height (maximum of all pages) in units depending on PrintingMapped. } property MappedOutlineHeight: Integer read FMappedOutlineHeight; { Returns the printed shape width (maximum of all pages) in units depending on PrintingMapped. } property MappedOutlineWidth: Integer read FMappedOutlineWidth; { Returns the paint area height on canvas in units depending on PrintingMapped. } property MappedPaintAreaHeight: Integer read FMappedPaintAreaHeight; { Returns the paint area width on canvas in units depending on PrintingMapped. } property MappedPaintAreaWidth: Integer read FMappedPaintAreaWidth; { Returns the page height in units depending on PrintingMapped. } property MappedPageHeight: Integer read FMappedPageHeight; { Returns the page width in units depending on PrintingMapped. } property MappedPageWidth: Integer read FMappedPageWidth; { Returns the amount of pixels per inch for the desktop device context's horizontal axis } property DesktopPixelsPerInchX: Integer read FDesktopPixelsPerInchX; { Returns the amount of pixels per inch for the desktop device context's vertical axis } property DesktopPixelsPerInchY: Integer read FDesktopPixelsPerInchY; { Specifies last page printed if Range is eprRange. } property EndPage: Integer read FEndPage write SetEndPage; { Returns extra horizontal pages needed to print extra left space. } property ExtraLeftHorzPageCount: Integer read FExtraLeftHorzPageCount; { Returns extra vertical pages needed to print extra left space. } property ExtraLeftVertPageCount: Integer read FExtraLeftVertPageCount; { Returns extra horizontal pages needed to print extra right space. } property ExtraRightHorzPageCount: Integer read FExtraRightHorzPageCount; { Returns extra vertical pages needed to print extra right space. } property ExtraRightVertPageCount: Integer read FExtraRightVertPageCount; { Returns True if default printer is selected otherwise Talse. Because of VCL.Printers bug, there is no way to use any printer when False. } property IsDefaultPrinter: Boolean read GetIsDefaultPrinter; { Specifies the printing options. } property Options: TKPrintOptions read FOptions write SetOptions; { Specifies the paper orientation. } property Orientation: TPrinterOrientation read FOrientation write SetOrientation; { Returns the amount of all pages. Includes the extra left and right areas. } property PageCount: Integer read FPageCount; { Returns True if painting to a TKPrintPreview.Canvas is active. } property Previewing: Boolean read FPreviewing; { Returns the control paint area width in printer device context's units. } property PrinterControlPaintAreaWidth: Integer read FPrinterControlPaintAreaWidth; { Returns the left extra space in printer device context's units. } property PrinterExtraSpaceLeft: Integer read FPrinterExtraSpaceLeft; { Returns the right extra space in printer device context's units. } property PrinterExtraSpaceRight: Integer read FPrinterExtraSpaceRight; { Returns the footer space in printer device context's units. } property PrinterFooterSpace: Integer read FPrinterFooterSpace; { Returns the header space in printer device context's units. } property PrinterHeaderSpace: Integer read FPrinterHeaderSpace; { Returns the bottom margin in printer device context's units. } property PrinterMarginBottom: Integer read FPrinterMarginBottom; { Returns the left margin in printer device context's units. } property PrinterMarginLeft: Integer read FPrinterMarginLeft; { Returns the left margin in printer device context's units with respect to current page. } property PrinterMarginLeftMirrored: Integer read FPrinterMarginLeftMirrored; { Returns the right margin in printer device context's units. } property PrinterMarginRight: Integer read FPrinterMarginRight; { Returns the left margin in printer device context's units with respect to current page. } property PrinterMarginRightMirrored: Integer read FPrinterMarginRightMirrored; { Returns the top margin in printer device context's units. } property PrinterMarginTop: Integer read FPrinterMarginTop; { Specifies the printer name. } property PrinterName: string read FPrinterName write SetPrinterName; { Returns the page height in printer device context's pixels. } property PrinterPageHeight: Integer read FPrinterPageHeight; { Returns the page width in printer device context's pixels. } property PrinterPageWidth: Integer read FPrinterPageWidth; { Returns the paint area height in printer device context's units. } property PrinterPaintAreaHeight: Integer read FPrinterPaintAreaHeight; { Returns the paint area width in printer device context's units. } property PrinterPaintAreaWidth: Integer read FPrinterPaintAreaWidth; { Returns the amount of pixels per inch for the printer device context's horizontal axis } property PrinterPixelsPerInchX: Integer read FPrinterPixelsPerInchX; { Returns the amount of pixels per inch for the printer device context's vertical axis } property PrinterPixelsPerInchY: Integer read FPrinterPixelsPerInchY; { Specifies the units for MappedX properties. If True, those extents are given in printer device context's pixels, otherwise in desktop device context's pixels. It can be adjusted by the descendant in the AdjustPageSetup method. } property PrintingMapped: Boolean read FPrintingMapped write SetPrintingMapped; { Specifies the printing range. } property Range: TKPrintRange read FRange write SetRange; { Returns True if the associated control has a selection. } property SelAvail: Boolean read GetSelAvail; { Specifies first page printed if Range is eprRange. } property StartPage: Integer read FStartPage write SetStartPage; { Specifies the requested scale for the printed shape, in percent. If epoFitToPage is specified in Options, this parameter is ignored. } property Scale: Integer read FScale write SetScale; { Specifies the document title as it appears in printer manager. } property Title: string read FTitle write FTitle; { Returns the control paint area width on canvas in Units. } property UnitControlPaintAreaWidth: Double read FUnitControlPaintAreaWidth; { Specifies the horizontal space that should stay free for application specific contents at the left side of printed control. Value is given in Units. } property UnitExtraSpaceLeft: Double read FUnitExtraSpaceLeft write SetUnitExtraSpaceLeft; { Specifies the horizontal space that should stay free for application specific contents at the right side of printed control. Value is given in Units. } property UnitExtraSpaceRight: Double read FUnitExtraSpaceRight write SetUnitExtraSpaceRight; { Specifies the vertical space that should stay free for application specific footer. Value is given in Units. } property UnitFooterSpace: Double read FUnitFooterSpace write SetUnitFooterSpace; { Specifies the vertical space that should stay free for application specific header. Value is given in Units. } property UnitHeaderSpace: Double read FUnitHeaderSpace write SetUnitHeaderSpace; { Specifies the bottom margin. Value is given in Units. } property UnitMarginBottom: Double read FUnitMarginBottom write SetUnitMarginBottom; { Specifies the left margin. Value is given in Units. } property UnitMarginLeft: Double read FUnitMarginLeft write SetUnitMarginLeft; { Specifies the right margin. Value is given in Units. } property UnitMarginRight: Double read FUnitMarginRight write SetUnitMarginRight; { Specifies the top margin. Value is given in Units. } property UnitMarginTop: Double read FUnitMarginTop write SetUnitMarginTop; { Returns the paint area height on canvas in Units. } property UnitPaintAreaHeight: Double read FUnitPaintAreaHeight; { Returns the paint area width on canvas in Units. } property UnitPaintAreaWidth: Double read FUnitPaintAreaWidth; { Specifies the units for print margins. } property Units: TKPrintUnits read FUnits write SetUnits; { Allows to customize measure info filled from associated control just before respective calculations are performed. } property OnPrintMeasure: TKPrintMeasureEvent read FOnPrintMeasure write FOnPrintMeasure; { Allows to inspect settings before printing information is updated. } property OnUpdateSettings: TNotifyEvent read FOnUpdateSettings write FOnUpdateSettings; end; { @abstract(Container for all colors used by @link(TKPrintPreview) class) This container allows to group many colors into one item in object inspector. Colors are accessible via published properties or several public Color* properties. } TKPreviewColors = class(TKCustomColors) protected { Returns color specification structure for given index. } function GetColorSpec(Index: TKColorIndex): TKColorSpec; override; { Returns maximum color index. } function GetMaxIndex: Integer; override; published { Specifies the paper background color. } property Paper: TColor index ciPaper read GetColor write SetColor default cPaperDef; { Specifies the color of the background around paper. } property BkGnd: TColor index ciBkGnd read GetColor write SetColor default cBkGndDef; { Specifies the color of the paper border. } property Border: TColor index ciBorder read GetColor write SetColor default cBorderDef; { Specifies the color of the paper border when the control has input focus. } property SelectedBorder: TColor index ciSelectedBorder read GetColor write SetColor default cSelectedBorderDef; end; { @abstract(Print preview control for the TKCustomControl component) } TKPrintPreview = class(TKCustomControl) private FColors: TKPreviewColors; FControl: TKCustomControl; FMouseWheelAccumulator: Integer; FPage: Integer; FPageOld: Integer; FPageSize: TPoint; FExtent: TPoint; FPageOffset: TPoint; FScale: Integer; FScaleMode: TKPreviewScaleMode; FScrollExtent: TPoint; FScrollPos: TPoint; FScrollPosOld: TPoint; FX: Integer; FY: Integer; FOnChanged: TKPreviewChangedEvent; FPixelsPerInchX: Integer; FPixelsPerInchY: Integer; function GetCurrentScale: Integer; function GetEndPage: Integer; function GetStartPage: Integer; procedure SetColors(const Value: TKPreviewColors); procedure SetControl(Value: TKCustomControl); procedure SetPage(Value: Integer); procedure SetPixelsPerInchX(Value: Integer); procedure SetPixelsPerInchY(Value: Integer); procedure SetScale(Value: Integer); procedure SetScaleMode(Value: TKPreviewScaleMode); procedure WMEraseBkgnd(var Msg: TLMessage); message LM_ERASEBKGND; procedure WMGetDlgCode(var Msg: TLMNoParams); message LM_GETDLGCODE; procedure WMHScroll(var Msg: TLMHScroll); message LM_HSCROLL; procedure WMKillFocus(var Msg: TLMKillFocus); message LM_KILLFOCUS; procedure WMSetFocus(var Msg: TLMSetFocus); message LM_SETFOCUS; procedure WMVScroll(var Msg: TLMVScroll); message LM_VSCROLL; protected FCurrentCanvas: TCanvas; { Initializes a scroll message handling. } procedure BeginScrollWindow; { Defines additional styles. } procedure CreateParams(var Params: TCreateParams); override; { Overriden method - handles mouse wheel messages. } function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override; { Calls the ScrollWindowEx function to complete a scroll message. } procedure EndScrollWindow; { Returns current page rectangle inside of the window client area. } function GetPageRect: TRect; { Processes virtual key strokes. } procedure KeyDown(var Key: Word; Shift: TShiftState); override; { Processes scrollbar messages. } procedure ModifyScrollBar(ScrollBar, ScrollCode, Delta: Integer); { Initializes drag&scroll functionality. } procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; { Performs drag&scroll functionality. } procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; { Finalizes drag&scroll functionality. } procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; { Notifies about associated TKCustomControl control removal. } procedure Notification(AComponent: TComponent; Operation: TOperation); override; { Paints paper and control shape. } procedure Paint; override; { Paints the control to given canvas. } procedure PaintToCanvas(ACanvas: TCanvas); override; { Calls the @link(OnChanged) event. } procedure Changed; { Grants the input focus to the control when possible and the control has had none before. } procedure SafeSetFocus; { Updates mouse cursor. } function SetMouseCursor(X, Y: Integer): Boolean; override; { Updates page sizes and scrollbar ranges. } procedure UpdateScrollRange; { Updates the control size. } procedure UpdateSize; override; property CurrentCanvas: TCanvas read FCurrentCanvas; public { Performs necessary initializations - default values to properties. } constructor Create(AOwner: TComponent); override; { Destroy instance... } destructor Destroy; override; { Shows first page for the given range. } procedure FirstPage; { Shows last page for the given range. } procedure LastPage; { Shows next page. } procedure NextPage; { Paints the current page to another canvas, without the top and left space around paper. } procedure PaintTo(ACanvas: TCanvas); { Shows previous page. } procedure PreviousPage; { Updates the preview. } procedure UpdatePreview; { Returns the page scaling with regard to the @link(ScaleMode) property. } property CurrentScale: Integer read GetCurrentScale; { Returns the current page area rectangle in desktop pixels. } property PageRect: TRect read GetPageRect; { Returns the last page for the given range. } property EndPage: Integer read GetEndPage; { Returns the first page for the given range. } property StartPage: Integer read GetStartPage; published { Inherited property - see Delphi help. } property Align; { Inherited property - see Delphi help. } property Anchors; { See TKCustomControl.@link(TKCustomControl.BorderStyle) for details. } property BorderStyle; { Inherited property - see Delphi help. } property BorderWidth; { Specifies all colors used by TKPrintPreview's default painting. } property Colors: TKPreviewColors read FColors write SetColors; { Inherited property - see Delphi help. } property Constraints; { Specifies the associated control. } property Control: TKCustomControl read FControl write SetControl; { Inherited property - see Delphi help. } property DragCursor; { Inherited property - see Delphi help. } property DragKind; { Inherited property - see Delphi help. } property DragMode; { Specifies the currently displayed page. } property Page: Integer read FPage write SetPage default 1; { Inherited property - see Delphi help. } property ParentShowHint; { Inherited property - see Delphi help. } property PopupMenu; { The horizontal DPI at which to show the 100% scaled page. } property PixelsPerInchX: Integer read FPixelsPerInchX write SetPixelsPerInchX default cDPIDef; { The vertical DPI at which to show the 100% scaled page. } property PixelsPerInchY: Integer read FPixelsPerInchY write SetPixelsPerInchY default cDPIDef; { Specifies the user defined page scale - i.e. when ScaleMode = smScale. } property Scale: Integer read FScale write SetScale default 100; { Specifies the scale mode to display and scroll previewed pages. } property ScaleMode: TKPreviewScaleMode read FScaleMode write SetScaleMode default smPageWidth; { Inherited property - see Delphi help. } property ShowHint; { Inherited property - see Delphi help. } property TabStop; { Inherited property - see Delphi help. } property TabOrder; { Inherited property - see Delphi help. } property Visible; { Called whenever print preview is updated. } property OnChanged: TKPreviewChangedEvent read FOnChanged write FOnChanged; { Inherited property - see Delphi help. } property OnClick; { Inherited property - see Delphi help. } property OnContextPopup; { Inherited property - see Delphi help. } property OnDblClick; { Inherited property - see Delphi help. } property OnDockDrop; { Inherited property - see Delphi help. } property OnDockOver; { Inherited property - see Delphi help. } property OnDragDrop; { Inherited property - see Delphi help. } property OnDragOver; { Inherited property - see Delphi help. } property OnEndDock; { Inherited property - see Delphi help. } property OnEndDrag; { Inherited property - see Delphi help. } property OnEnter; { Inherited property - see Delphi help. } property OnExit; { Inherited property - see Delphi help. } property OnGetSiteInfo; { Inherited property - see Delphi help. } property OnKeyDown; { Inherited property - see Delphi help. } property OnKeyPress; { Inherited property - see Delphi help. } property OnKeyUp; { Inherited property - see Delphi help. } property OnMouseDown; {$IFDEF COMPILER9_UP} { Inherited property - see Delphi help. } property OnMouseEnter; { Inherited property - see Delphi help. } property OnMouseLeave; {$ENDIF} { Inherited property - see Delphi help. } property OnMouseMove; { Inherited property - see Delphi help. } property OnMouseUp; { Inherited property - see Delphi help. } property OnMouseWheel; { Inherited property - see Delphi help. } property OnMouseWheelDown; { Inherited property - see Delphi help. } property OnMouseWheelUp; { Inherited property - see Delphi help. } property OnResize; { Inherited property - see Delphi help. } property OnStartDock; { Inherited property - see Delphi help. } property OnStartDrag; { Inherited property - see Delphi help. } property OnUnDock; end; { Under Windows this function calls the WinAPI TrackMouseEvent. Under other OSes the implementation is still missing. } procedure CallTrackMouseEvent(Control: TWinControl; var Status: Boolean); { Center window identified by CenteredWnd with regard to another window BoundWnd. } procedure CenterWindowInWindow(CenteredWnd, BoundWnd: HWnd); { Center window identified by CenteredWnd with regard to main screen. } procedure CenterWindowOnScreen(CenteredWnd: HWnd); { Load clipboard data to AStream in a format specified by AFormat (if any). Loads also AText if clipboard has some data in text format. } function ClipboardLoadStreamAs(const AFormat: TKClipboardFormat; AStream: TStream; var AText: TKString): Boolean; overload; { Load clipboard data to AStream in a format specified by AFormat (if any). Loads also AText if clipboard has some data in text format. } function ClipboardLoadStreamAs(const AFormat: string; AStream: TStream; var AText: TKString): Boolean; overload; { Save data from AStream to clipboard in a format specified by AFormat. Optional AText can be saved in text format. } function ClipboardSaveStreamAs(const AFormat: string; AStream: TStream; const AText: TKString): Boolean; { Enables or disables all children of AParent depending on AEnabled. If ARecursive is True then the function applies to whole tree of controls owned by AParent. } procedure EnableControls(AParent: TWinControl; AEnabled: Boolean; ARecursive: Boolean = True); { Fills the message record. } function FillMessage(Msg: Cardinal; WParam: WPARAM; LParam: LPARAM): TLMessage; { Searches for a child control. Can search recursively. } function FindChildControl(AParent: TWinControl; const AName: string; ARecursive: Boolean = True): TControl; { Returns the Text property of any TWinControl instance as WideString (up to Delphi 2007) or string (Delphi 2009, Lazarus). } function GetControlText(Value: TWinControl): TKString; { Returns current status of Shift, Alt and Ctrl keys. } function GetShiftState: TShiftState; { Converts a value given in inches into a value given in specified units. } function InchesToValue(Units: TKPrintUnits; Value: Double): Double; { Open URL in external browser. } procedure OpenURLWithShell(const AText: TKString); { Converts value given in specified units into a value given in inches. } function ValueToInches(Units: TKPrintUnits; Value: Double): Double; { Under Windows this function calls the WinAPI SetWindowRgn. Under other OSes the implementation is still missing. } procedure SetControlClipRect(AControl: TWinControl; const ARect: TRect); { Modifies the Text property of any TWinControl instance. The value is given as WideString (up to Delphi 2007) or string (Delphi 2009, Lazarus). } procedure SetControlText(Value: TWinControl; const Text: TKString); procedure DPIScaleAllForms(FromDPI: Integer = 96); procedure DPIScaleControl(Control: TControl; FromDPI: Integer = 96); function DPIScaleValue(Value: Int64; FromDPI: Integer = 96): Int64; implementation uses {$IFDEF FPC} {$IFDEF MSWINDOWS}Windows,{$ENDIF} {$ELSE} ShlObj, ShellApi, {$ENDIF} ClipBrd, Math, Types, KGraphics, KMessageBox, KRes; const cPreviewHorzBorder = 30; cPreviewVertBorder = 30; cPreviewShadowSize = 3; procedure CallTrackMouseEvent(Control: TWinControl; var Status: Boolean); {$IFDEF MSWINDOWS} var TE: TTrackMouseEvent; begin if not Status then begin TE.cbSize := SizeOf(TE); TE.dwFlags := TME_LEAVE; TE.hwndTrack := Control.Handle; TE.dwHoverTime := HOVER_DEFAULT; TrackMouseEvent(TE); Status := True; end; end; {$ELSE} begin // This is a TODO for Lazarus team. end; {$ENDIF} procedure CenterWindowOnScreen(CenteredWnd: HWnd); var R: TRect; begin GetWindowRect(CenteredWnd, R); R.Left := Max((Screen.Width - R.Right + R.Left) div 2, 0); R.Top := Max((Screen.Height - R.Bottom + R.Top) div 2, 0); SetWindowPos(CenteredWnd, 0, R.Left, R.Top, 0, 0, SWP_NOSIZE or SWP_NOZORDER); end; procedure CenterWindowInWindow(CenteredWnd, BoundWnd: HWnd); var R1, R2: TRect; begin GetWindowRect(CenteredWnd, R1); GetWindowRect(BoundWnd, R2); R1.Left := Max((R2.Right - R2.Left - R1.Right + R1.Left) div 2, 0); R1.Top := Max((R2.Bottom - R2.Top - R1.Bottom + R1.Top) div 2, 0); SetWindowPos(CenteredWnd, 0, R1.Left, R1.Top, 0, 0, SWP_NOSIZE or SWP_NOZORDER); end; function ClipboardLoadStreamAs(const AFormat: TKClipboardFormat; AStream: TStream; var AText: TKString): Boolean; var Data: HGLOBAL; begin Result := False; {$IFDEF FPC} with Clipboard do begin if (AFormat <> 0) and HasFormat(AFormat) then begin Clipboard.GetFormat(AFormat, AStream); Result := True; end else begin AText := AsText; Result := AText <> ''; end; end; {$ELSE} if AFormat <> 0 then begin Data := 0; try with Clipboard do begin Open; try if HasFormat(AFormat) then begin Data := GetAsHandle(AFormat); if Data <> 0 then begin AStream.Write(GlobalLock(Data)^, GlobalSize(Data)); GlobalUnlock(Data); Result := True; end; end else begin AText := AsText; Result := AText <> ''; end; finally Close; end; end; except GlobalFree(Data); end; end else Clipboard.AsText := AText; {$ENDIF} end; function ClipboardLoadStreamAs(const AFormat: string; AStream: TStream; var AText: TKString): Boolean; begin {$IFDEF FPC} Result := ClipboardLoadStreamAs(RegisterClipboardFormat(AFormat), AStream, AText); {$ELSE} Result := ClipboardLoadStreamAs(RegisterClipboardFormat(PChar(AFormat)), AStream, AText); {$ENDIF} end; function ClipboardSaveStreamAs(const AFormat: string; AStream: TStream; const AText: TKString): Boolean; var Fmt: TKClipboardFormat; Data: HGLOBAL; begin Result := False; {$IFDEF FPC} with Clipboard do begin Clear; AsText := AText; Fmt := RegisterClipboardFormat(AFormat); if Fmt <> 0 then begin AStream.Seek(0, soFromBeginning); AddFormat(Fmt, AStream); Result := True; end; end; {$ELSE} Clipboard.Clear; Fmt := RegisterClipboardFormat(PChar(AFormat)); if Fmt <> 0 then begin Data := GlobalAlloc(GHND or GMEM_SHARE, AStream.Size); if Data <> 0 then try AStream.Seek(0, soFromBeginning); AStream.Read(GlobalLock(Data)^, AStream.Size); GlobalUnlock(Data); with Clipboard do begin Open; try Clipboard.AsText := AText; SetAsHandle(Fmt, Data); finally Close; end; end; Result := True; except GlobalFree(Data); end; end else Clipboard.AsText := AText; {$ENDIF} end; procedure EnableControls(AParent: TWinControl; AEnabled, ARecursive: Boolean); procedure DoEnable(AParent: TWinControl); var I: Integer; begin if AParent <> nil then for I := 0 to AParent.ControlCount - 1 do begin AParent.Controls[I].Enabled := AEnabled; if ARecursive and (AParent.Controls[I] is TWinControl) then DoEnable(TWinControl(AParent.Controls[I])); end; end; begin DoEnable(AParent); end; function FillMessage(Msg: Cardinal; WParam: WPARAM; LParam: LPARAM): TLMessage; begin Result.Msg := Msg; Result.LParam := LParam; Result.WParam := WParam; Result.Result := 0; end; function FindChildControl(AParent: TWinControl; const AName: string; ARecursive: Boolean): TControl; function DoSearch(AParent: TWinControl): TControl; var I: Integer; Ctrl: TControl; begin Result := nil; if AParent <> nil then for I := 0 to AParent.ControlCount - 1 do begin Ctrl := AParent.Controls[I]; if Ctrl.Name = AName then Result := Ctrl else if ARecursive and (Ctrl is TWinControl) then Result := DoSearch(TWinControl(Ctrl)); if Result <> nil then Break; end; end; begin Result := DoSearch(AParent); end; function GetControlText(Value: TWinControl): TKString; function GetTextBuffer(Value: TWinControl): string; begin SetLength(Result, Value.GetTextLen); if Length(Result) > 0 then Value.GetTextBuf(PChar(Result), Length(Result) + 1); end; begin {$IFDEF FPC} Result := GetTextBuffer(Value); // conversion from UTF8 forced anyway {$ELSE} {$IFDEF STRING_IS_UNICODE} Result := GetTextBuffer(Value); {$ELSE} if Value.HandleAllocated and (Win32Platform = VER_PLATFORM_WIN32_NT) then // unicode fully supported begin SetLength(Result, GetWindowTextLengthW(Value.Handle)); GetWindowTextW(Value.Handle, PWideChar(Result), Length(Result) + 1); end else Result := GetTextBuffer(Value); {$ENDIF} {$ENDIF} end; function GetShiftState: TShiftState; begin Result := []; if GetKeyState(VK_SHIFT) < 0 then Include(Result, ssShift); if GetKeyState(VK_CONTROL) < 0 then Include(Result, ssCtrl); if GetKeyState(VK_MENU) < 0 then Include(Result, ssAlt); end; function InchesToValue(Units: TKPrintUnits; Value: Double): Double; begin case Units of puMM: Result := Value * 25.4; puCM: Result := Value * 2.54; puHundredthInch: Result := Value * 100; else Result := Value; end; end; procedure OpenURLWithShell(const AText: TKString); begin {$IFDEF FPC} OpenURL(AText); {$ELSE} ShellExecuteW(Application.MainForm.Handle, 'open', PWideChar(AText), nil, nil, SW_SHOWNORMAL); {$ENDIF} end; procedure SetControlClipRect(AControl: TWinControl; const ARect: TRect); begin if AControl.HandleAllocated then begin {$IFDEF MSWINDOWS} SetWindowRgn(AControl.Handle, CreateRectRgn(0, 0, ARect.Right - ARect.Left, ARect.Bottom - ARect.Top), True); {$ELSE} //how to do that? {$ENDIF} end; end; procedure SetControlText(Value: TWinControl; const Text: TKString); procedure SetTextBuffer(Value: TWinControl; const Text: string); begin Value.SetTextBuf(PChar(Text)); end; begin {$IFDEF FPC} SetTextBuffer(Value, Text); // conversion to UTF8 forced anyway {$ELSE} {$IFDEF STRING_IS_UNICODE} SetTextBuffer(Value, Text); {$ELSE} if Value.HandleAllocated and (Win32Platform = VER_PLATFORM_WIN32_NT) then // unicode fully supported SetWindowTextW(Value.Handle, PWideChar(Text)) else SetTextBuffer(Value, Text); {$ENDIF} {$ENDIF} end; function ValueToInches(Units: TKPrintUnits; Value: Double): Double; begin case Units of puMM: Result := Value / 25.4; puCM: Result := Value / 2.54; puHundredthInch: Result := Value / 100; else Result := Value; end; end; procedure DPIScaleAllForms(FromDPI: Integer); var i: integer; begin {$IFNDEF FPC} if Screen.PixelsPerInch = FromDPI then exit; for i := 0 to Screen.FormCount - 1 do DPIScaleControl(Screen.Forms[i], FromDPI); {$ENDIF} end; procedure DPIScaleControl(Control: TControl; FromDPI: Integer); var WinControl: TWinControl; begin {$IFNDEF FPC} if Screen.PixelsPerInch = FromDPI then exit; if Control is TWinControl then begin WinControl := TWinControl(Control); WinControl.ScaleBy(Screen.PixelsPerInch, FromDPI); end; {$ENDIF} end; function DPIScaleValue(Value: Int64; FromDPI: Integer): Int64; begin {$IFDEF FPC} Result := Value; {$ELSE} Result := Value * Screen.PixelsPerInch div FromDPI; {$ENDIF} end; { TKRect } constructor TKRect.Create; begin inherited Create; FOnChanged := nil; FBottom := cRectBottomDef; FLeft := cRectLeftDef; FRight := cRectRightDef; FTop := cRectTopDef; end; procedure TKRect.Assign(Source: TPersistent); begin if Source is TKRect then begin Bottom := TKRect(Source).Bottom; Left := TKRect(Source).Left; Right := TKRect(Source).Right; Top := TKRect(Source).Top; end; end; procedure TKRect.AssignFromRect(const ARect: TRect); begin FBottom := ARect.Bottom; FLeft := ARect.Left; FRight := ARect.Right; FTop := ARect.Top; end; procedure TKRect.AssignFromValues(ALeft, ATop, ARight, ABottom: Integer); begin FBottom := ABottom; FLeft := ALeft; FRight := ARight; FTop := ATop; end; procedure TKRect.Changed; begin if Assigned(FOnChanged) then FOnChanged(Self); end; function TKRect.ContainsPoint(const APoint: TPoint): Boolean; begin Result := (FLeft <= APoint.X) and (APoint.X < FRight) and (FTop <= APoint.Y) and (APoint.Y < FBottom); end; function TKRect.EqualProperties(const ARect: TKRect): Boolean; begin Result := (ARect <> nil) and (FLeft = ARect.Left) and (FRight = ARect.Right) and (FTop = ARect.Top) and (FBottom = ARect.Bottom); end; function TKRect.GetHeight: Integer; begin Result := FBottom - FTop; end; function TKRect.GetWidth: Integer; begin Result := FRight - FLeft; end; function TKRect.NonZero: Boolean; begin Result := (FLeft <> 0) or (FTop <> 0) or (FRight <> 0) or (FBottom <> 0); end; function TKRect.OffsetRect(ARect: TKRect): TRect; begin if ARect <> nil then Result := Rect(ARect.Left + FLeft, ARect.Top + FTop, ARect.Right - FRight, ARect.Bottom - FBottom) else Result := CreateEmptyRect; end; function TKRect.OffsetRect(const ARect: TRect): TRect; begin Result := Rect(ARect.Left + FLeft, ARect.Top + FTop, ARect.Right - FRight, ARect.Bottom - FBottom); end; procedure TKRect.SetAll(const Value: Integer); begin Bottom := Value; Left := Value; Right := Value; Top := Value; end; procedure TKRect.SetBottom(const Value: Integer); begin if FBottom <> Value then begin FBottom := Value; Changed; end; end; procedure TKRect.SetLeft(const Value: Integer); begin if FLeft <> Value then begin FLeft := Value; Changed; end; end; procedure TKRect.SetRight(const Value: Integer); begin if FRight <> Value then begin FRight := Value; Changed; end; end; procedure TKRect.SetTop(const Value: Integer); begin if FTop <> Value then begin FTop := Value; Changed; end; end; { TKCustomControl } constructor TKCustomControl.Create(AOwner: TComponent); begin inherited; BorderStyle := cBorderStyleDef; FFlags := 0; FMemoryCanvas := nil; FMessages := nil; {$IFNDEF COMPILER10_UP} FMouseInClient := False; {$ENDIF} FOldClientSize.X := 0; FOldClientSize.Y := 0; FPageSetup := nil; {$IF DEFINED(FPC) OR NOT DEFINED(COMPILER10_UP)} FParentBackground := True; FParentDoubleBuffered := True; {$IFEND} FPreviewList := TList.Create; FUpdateLock := 0; FOnPrintNotify := nil; FOnPrintPaint := nil; end; destructor TKCustomControl.Destroy; begin inherited; FMessages := nil; FreeAndNil(FPreviewList); FreeAndNil(FPageSetup); end; procedure TKCustomControl.AddPreview(APreview: TKPrintPreview); begin if Assigned(APreview) then FPreviewList.Add(APreview); end; procedure TKCustomControl.AdjustPageSetup; begin end; procedure TKCustomControl.CallUpdateSize; var W, H: Integer; begin if HandleAllocated then begin W := ClientWidth; H := ClientHeight; if (FOldClientSize.X <> W) or (FOldClientSize.Y <> H) then begin UpdateSize; FOldClientSize.X := W; FOldClientSize.Y := H; end; end; end; procedure TKCustomControl.CancelMode; begin end; {$IFNDEF FPC} procedure TKCustomControl.CMCancelMode(var Msg: TLMessage); begin inherited; CancelMode; end; procedure TKCustomControl.CMCtl3DChanged(var Msg: TLMessage); begin inherited; RecreateWnd; end; {$ENDIF} procedure TKCustomControl.CMMouseLeave(var Msg: TLMessage); begin inherited; try MouseFormLeave; except end; end; procedure TKCustomControl.CreateHandle; begin inherited; CallUpdateSize; end; procedure TKCustomControl.CreateParams(var Params: TCreateParams); begin inherited; {$IFNDEF FPC} with Params do begin WindowClass.style := CS_DBLCLKS; if BorderStyle = bsSingle then if NewStyleControls and Ctl3D then begin Style := Style and not WS_BORDER; ExStyle := ExStyle or WS_EX_CLIENTEDGE; end else Style := Style or WS_BORDER; end; {$ENDIF} end; {$IFDEF FPC} procedure TKCustomControl.DoOnChangeBounds; begin inherited; if csDesigning in ComponentState then PostLateUpdate(FillMessage(LM_SIZE, 0, 0), True) else CallUpdateSize; end; {$ENDIF} function TKCustomControl.Flag(AFlag: Cardinal): Boolean; begin Result := FFlags and AFlag <> 0; end; procedure TKCustomControl.FlagAssign(AFlag: Cardinal; Value: Boolean); begin if Value then FlagSet(AFlag) else FlagClear(AFlag); end; procedure TKCustomControl.FlagClear(AFlag: Cardinal); begin FFlags := FFlags and not AFlag; end; procedure TKCustomControl.FlagSet(AFlag: Cardinal); begin FFlags := FFlags or AFlag; end; procedure TKCustomControl.FlagToggle(AFlag: Cardinal); begin FFlags := FFlags xor AFlag; end; function TKCustomControl.GetCanPrint: Boolean; begin Result := PageSetup.CanPrint; end; function TKCustomControl.GetPageSetup: TKPrintPageSetup; begin if not Assigned(FPageSetup) and not (csDestroying in ComponentState) then begin FPageSetup := TKPrintPageSetup.Create(Self); AdjustPageSetup; end; if Assigned(FPageSetup) then FPageSetup.Validate; Result := FPageSetup; end; function TKCustomControl.GetPageSetupAllocated: Boolean; begin Result := Assigned(FPageSetup); end; function TKCustomControl.InternalGetSelAvail: Boolean; begin Result := False; end; procedure TKCustomControl.InternalUnlockUpdate; begin end; procedure TKCustomControl.Invalidate; begin if UpdateUnlocked and HandleAllocated then inherited; end; procedure TKCustomControl.InvalidatePageSetup; begin if Assigned(FPageSetup) then FPageSetup.Invalidate; end; procedure TKCustomControl.InvalidateRectArea(const R: TRect); begin if UpdateUnlocked and HandleAllocated then InvalidateRect(Handle, @R, False); end; function TKCustomControl.IsThemed: Boolean; begin Result := True; end; procedure TKCustomControl.KMLateUpdate(var Msg: TLMessage); var M: TLMessage; begin if MessagePeek(M) then LateUpdate(M); end; procedure TKCustomControl.LateUpdate(var Msg: TLMessage); begin case Msg.Msg of LM_SIZE: CallUpdateSize; end; end; procedure TKCustomControl.LockUpdate; begin Inc(FUpdateLock); end; procedure TKCustomControl.MeasurePages(var Info: TKPrintMeasureInfo); begin end; function TKCustomControl.MessagePeek(out Msg: TLMessage): Boolean; var ALen: Integer; begin ALen := Length(FMessages); if ALen > 0 then begin Dec(ALen); Msg := FMessages[ALen]; SetLength(FMessages, ALen); Result := True; end else Result := False; end; procedure TKCustomControl.MessagePoke(const Msg: TLMessage); var ALen: Integer; begin ALen := Length(FMessages); SetLength(FMessages, ALen + 1); FMessages[ALen] := Msg; end; function TKCustomControl.MessageSearch(MsgCode: Cardinal): Boolean; var I: Integer; begin Result := False; for I := 0 to Length(FMessages) - 1 do if FMessages[I].Msg = MsgCode then begin Result := True; Exit; end; end; procedure TKCustomControl.MouseFormLeave; begin end; procedure TKCustomControl.MouseMove(Shift: TShiftState; X, Y: Integer); begin inherited; {$IFNDEF COMPILER10_UP} CallTrackMouseEvent(Self, FMouseInClient); {$ENDIF} {$IFDEF FPC} if not MouseCapture then SetMouseCursor(X, Y); {$ENDIF} end; procedure TKCustomControl.NotifyPreviews; var I: Integer; begin for I := 0 to FPreviewList.Count - 1 do TKPrintPreview(FPreviewList[I]).UpdatePreview; end; procedure TKCustomControl.Paint; begin PaintToCanvas(Canvas); if Assigned(FMemoryCanvas) then begin {$IFDEF MSWINDOWS} // this is the best method but does not work both on QT and GTK! MoveWindowOrg(FMemoryCanvas.Handle, -FMemoryCanvasRect.Left, -FMemoryCanvasRect.Top); try PaintToCanvas(FMemoryCanvas); finally MoveWindowOrg(FMemoryCanvas.Handle, FMemoryCanvasRect.Left, FMemoryCanvasRect.Top); end; {$ELSE} FMemoryCanvas.CopyRect(Rect(0, 0, FMemoryCanvasRect.Right - FMemoryCanvasRect.Left, FMemoryCanvasRect.Bottom - FMemoryCanvasRect.Top), Canvas, FMemoryCanvasRect); {$ENDIF} FMemoryCanvas := nil; end; end; procedure TKCustomControl.PostLateUpdate(const Msg: TLMessage; IfNotExists: Boolean); var MessageExists: Boolean; TmpMsg: tagMSG; begin if HandleAllocated then begin MessageExists := MessageSearch(Msg.Msg); if not MessageExists or not IfNotExists then begin MessagePoke(Msg); PostMessage(Handle, KM_LATEUPDATE, 0, 0); end; // resend lost message if MessageExists and not PeekMessage(TmpMsg, Handle, KM_LATEUPDATE, KM_LATEUPDATE, PM_NOREMOVE) then PostMessage(Handle, KM_LATEUPDATE, 0, 0); end; end; procedure TKCustomControl.PrintNotify(Status: TKPrintStatus; var Abort: Boolean); begin if Assigned(FOnPrintNotify) then FOnPrintNotify(Self, Status, Abort); end; procedure TKCustomControl.PrintPaint; begin if Assigned(FOnPrintPaint) then FOnPrintPaint(Self); end; procedure TKCustomControl.PrintPaintBegin; begin end; procedure TKCustomControl.PrintPaintEnd; begin end; procedure TKCustomControl.PrintOut; begin GetPageSetup.PrintOut; end; procedure TKCustomControl.PaintPage; begin end; procedure TKCustomControl.RemovePreview(APreview: TKPrintPreview); begin if Assigned(FPreviewList) and (FPreviewList.IndexOf(APreview) >= 0) then FPreviewList.Remove(APreview); end; procedure TKCustomControl.Resize; begin inherited; // Needs to be handled in Lazarus as well! // DoOnChangeBounds is not called in LCL when eg. scrollbars change their visibility etc. PostLateUpdate(FillMessage(LM_SIZE, 0, 0), True); end; {$IFNDEF FPC} procedure TKCustomControl.SetBorderStyle(Value: TBorderStyle); begin if FBorderStyle <> Value then begin FBorderStyle := Value; RecreateWnd; end; end; {$ENDIF} function TKCustomControl.SetMouseCursor(X, Y: Integer): Boolean; begin Result := False; end; procedure TKCustomControl.SetPageSetup(Value: TKPrintPageSetup); begin if Value <> FPageSetup then GetPageSetup.Assign(Value); end; procedure TKCustomControl.UnlockUpdate; begin if FUpdateLock > 0 then begin Dec(FUpdateLock); if FUpdateLock = 0 then InternalUnlockUpdate; end; end; procedure TKCustomControl.UpdateSize; begin end; function TKCustomControl.UpdateUnlocked: Boolean; begin Result := FUpdateLock = 0; end; {$IFNDEF FPC} procedure TKCustomControl.WMCancelMode(var Msg: TWMCancelMode); begin inherited; CancelMode; end; {$ENDIF} {$IFNDEF COMPILER10_UP} procedure TKCustomControl.WMMouseLeave(var Msg: TLMessage); begin { this is because of CM_MOUSELEAVE is not sent if mouse has left client area and entered any of the standard control scrollbars. This behavior has been fixed via TrackMouseEvent in BDS 2006. } inherited; FMouseInClient := False; Perform(CM_MOUSELEAVE, 0, 0); end; {$ENDIF} {$IFNDEF FPC} procedure TKCustomControl.WMNCPaint(var Msg: TWMNCPaint); {$IFDEF USE_THEMES} var R: TRect; ExStyle: Integer; TempRgn: HRGN; BorderWidth, BorderHeight: Integer; {$ENDIF} begin {$IFDEF USE_THEMES} with ThemeServices do if IsThemed and ThemesEnabled then begin // If OS themes are enabled and the client edge border is set for the window then prevent the default window proc // from painting the old border to avoid flickering. ExStyle := GetWindowLong(Handle, GWL_EXSTYLE); if (ExStyle and WS_EX_CLIENTEDGE) <> 0 then begin GetWindowRect(Handle, R); // Determine width of the client edge. BorderWidth := GetSystemMetrics(SM_CXEDGE); BorderHeight := GetSystemMetrics(SM_CYEDGE); InflateRect(R, -BorderWidth, -BorderHeight); TempRgn := CreateRectRgnIndirect(R); // Exclude the border from the message region if there is one. Otherwise just use the inflated // window area region. if Msg.Rgn <> 1 then CombineRgn(TempRgn, Msg.Rgn, TempRgn, RGN_AND); DefWindowProc(Handle, Msg.Msg, Integer(TempRgn), 0); DeleteObject(TempRgn); PaintBorder(Self, True); end else inherited; end else {$ENDIF} inherited; end; procedure TKCustomControl.WMSetCursor(var Msg: TWMSetCursor); var MousePt: TPoint; begin if (Msg.HitTest = HTCLIENT) and (Msg.CursorWnd = Handle) then begin MousePt := ScreenToClient(Mouse.CursorPos); if SetMouseCursor(MousePt.X, MousePt.Y) then Msg.Result := 1 else inherited end else inherited; end; {$ENDIF} procedure TKCustomControl.WMSize(var Msg: TLMSize); begin FResizeCalled := False; inherited; {$IFnDEF FPC} if not FResizeCalled then PostLateUpdate(FillMessage(LM_SIZE, 0, 0), True); {$ENDIF} end; {$IFNDEF FPC} {$IFDEF USE_THEMES} procedure TKCustomControl.WMThemeChanged(var Msg: TLMessage); begin if IsThemed then begin inherited; ThemeServices.UpdateThemes; RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_VALIDATE or RDW_FRAME); end; end; {$ENDIF} {$ENDIF} { TKCustomColors } constructor TKCustomColors.Create(AControl: TKCustomControl); begin inherited Create; FControl := AControl; Initialize; ClearBrightColors; end; procedure TKCustomColors.Assign(Source: TPersistent); begin inherited; if Source is TKCustomColors then begin Colors := TKCustomColors(Source).Colors; FControl.Invalidate; end end; procedure TKCustomColors.ClearBrightColors; var I: TKColorIndex; begin for I := 0 to Length(FBrightColors) - 1 do FBrightColors[I] := clNone; end; function TKCustomColors.GetColor(Index: TKColorIndex): TColor; begin Result := InternalGetColor(Index); end; function TKCustomColors.GetColorData(Index: TKColorIndex): TKColorData; var ColorSpec: TKColorSpec; begin Result.Index := Index; Result.Color := FColors[Index]; ColorSpec := GetColorSpec(Index); Result.Default := ColorSpec.Def; Result.Name := ColorSpec.Name; end; function TKCustomColors.GetColorEx(Index: TKColorIndex): TColor; begin Result := FColors[Index]; end; function TKCustomColors.GetColorName(Index: TKColorIndex): string; begin Result := GetColorSpec(Index).Name; end; function TKCustomColors.GetColorSpec(Index: TKColorIndex): TKColorSpec; begin Result.Def := clNone; Result.Name := ''; end; function TKCustomColors.GetDefaultColor(Index: TKColorIndex): TColor; begin Result := GetColorSpec(Index).Def; end; function TKCustomColors.GetMaxIndex: Integer; begin Result := -1; end; procedure TKCustomColors.Initialize; var I, MaxIndex: TKColorIndex; begin MaxIndex := GetMaxIndex; SetLength(FColors, MaxIndex + 1); SetLength(FBrightColors, MaxIndex + 1); for I := 0 to Length(FColors) - 1 do FColors[I] := GetColorSpec(I).Def; end; function TKCustomColors.InternalGetColor(Index: TKColorIndex): TColor; begin case FColorScheme of csBright: begin if FBrightColors[Index] = clNone then FBrightColors[Index] := BrightColor(FColors[Index], 0.5, bsOfTop); Result := FBrightColors[Index]; end; csGrayScale: Result := ColorToGrayScale(FColors[Index]); else Result := FColors[Index]; end; end; procedure TKCustomColors.InternalSetColor(Index: TKColorIndex; Value: TColor); begin if FColors[Index] <> Value then begin FColors[Index] := Value; FBrightColors[Index] := clNone; if not (csLoading in FControl.ComponentState) then FControl.Invalidate; end; end; procedure TKCustomColors.SetColor(Index: TKColorIndex; Value: TColor); begin InternalSetColor(Index, Value); end; procedure TKCustomColors.SetColorEx(Index: TKColorIndex; Value: TColor); begin if FColors[Index] <> Value then begin FColors[Index] := Value; FBrightColors[Index] := clNone; end; end; procedure TKCustomColors.SetColors(const Value: TKColorArray); var I: Integer; begin for I := 0 to Min(Length(FColors), Length(Value)) - 1 do FColors[I] := Value[I]; ClearBrightColors; end; { TKPrintPageSetup } constructor TKPrintPageSetup.Create(AControl: TKCustomControl); begin inherited Create; FActive := False; FCanvas := nil; FControl := AControl; FControlHorzPageCount := 0; FControlPageCount := 0; FControlVertPageCount := 0; FCopies := cCopiesDef; FCurrentCopy := 0; FCurrentPage := 0; FCurrentScale := 0; FMappedOutlineHeight := 0; FMappedOutlineWidth := 0; FDesktopPixelsPerInchX := 0; FDesktopPixelsPerInchY := 0; FEndPage := 0; FExtraLeftHorzPageCount := 0; FExtraLeftPageCount := 0; FExtraLeftVertPageCount := 0; FExtraRightHorzPageCount := 0; FExtraRightPageCount := 0; FExtraRightVertPageCount := 0; FIsValid := False; FOptions := cOptionsDef; FOrientation := poPortrait; FPageCount := 0; FPreviewing := False; FPrinterExtraSpaceLeft := 0; FPrinterExtraSpaceRight := 0; FPrinterFooterSpace := 0; FPrinterHeaderSpace := 0; FPrinterMarginBottom := 0; FPrinterMarginLeft := 0; FPrinterMarginLeftMirrored := 0; FPrinterMarginRight := 0; FPrinterMarginRightMirrored := 0; FPrinterMarginTop := 0; FPrinterName := ''; FPrinterPageHeight := 0; FPrinterPageWidth := 0; FPrinterPixelsPerInchX := 0; FPrinterPixelsPerInchY := 0; FPrintingMapped := True; FRange := cRangeDef; FStartPage := 0; FScale := cScaleDef; FTitle := ''; FUnitExtraSpaceLeft := 0; FUnitExtraSpaceRight := 0; FUnitFooterSpace := 0; FUnitHeaderSpace := 0; FUnitMarginBottom := cMarginBottomDef; FUnitMarginLeft := cMarginLeftDef; FUnitMarginRight := cMarginRightDef; FUnitMarginTop := cMarginTopDef; FUnitPaintAreaHeight := 0; FUnitPaintAreaWidth := 0; FUnits := cUnitsDef; FValidating := False; FOnPrintMeasure := nil; FOnUpdateSettings := nil; end; function TKPrintPageSetup.GetCanPrint: Boolean; begin Result := Assigned(FControl) and (FPageCount > 0) and (Printer.Printers.Count > 0); end; function TKPrintPageSetup.GetCurrentPageControl: Integer; begin if (FCurrentPage > FExtraLeftPageCount) and (FCurrentPage <= FExtraLeftPageCount + FControlPageCount) then Result := FCurrentPage - FExtraLeftPageCount else Result := 0; // we are in extra left or right area end; function TKPrintPageSetup.GetCurrentPageExtraLeft: Integer; begin if (FCurrentPage > 0) and (FCurrentPage <= FExtraLeftPageCount) then Result := FCurrentPage - FExtraLeftPageCount else Result := 0; // we are in control or extra right area end; function TKPrintPageSetup.GetCurrentPageExtraRight: Integer; begin if FCurrentPage > FExtraLeftPageCount + FControlPageCount then Result := FCurrentPage - FExtraLeftPageCount - FControlPageCount else Result := 0; // we are in control or extra left area end; function TKPrintPageSetup.GetIsDefaultPrinter: Boolean; begin try Result := Printer.PrinterIndex > -MaxInt; except Result := False; end; end; function TKPrintPageSetup.GetSelAvail: Boolean; begin if Assigned(FControl) then Result := FControl.InternalGetSelAvail else Result := False; end; procedure TKPrintPageSetup.AfterUnitsChange; begin FUnitExtraSpaceLeft := InchesToValue(FUnits, FUnitExtraSpaceLeft); FUnitExtraSpaceRight := InchesToValue(FUnits, FUnitExtraSpaceRight); FUnitFooterSpace := InchesToValue(FUnits, FUnitFooterSpace); FUnitHeaderSpace := InchesToValue(FUnits, FUnitHeaderSpace); FUnitMarginBottom := InchesToValue(FUnits, FUnitMarginBottom); FUnitMarginLeft := InchesToValue(FUnits, FUnitMarginLeft); FUnitMarginRight := InchesToValue(FUnits, FUnitMarginRight); FUnitMarginTop := InchesToValue(FUnits, FUnitMarginTop); end; procedure TKPrintPageSetup.Assign(Source: TPersistent); begin if Source is TKPrintPageSetup then begin LockUpdate; try Copies := TKPrintPageSetup(Source).Copies; EndPage := TKPrintPageSetup(Source).EndPage; Options := TKPrintPageSetup(Source).Options; PrinterName := TKPrintPageSetup(Source).PrinterName; Range := TKPrintPageSetup(Source).Range; StartPage := TKPrintPageSetup(Source).StartPage; Scale := TKPrintPageSetup(Source).Scale; Title := TKPrintPageSetup(Source).Title; UnitExtraSpaceLeft := TKPrintPageSetup(Source).UnitExtraSpaceLeft; UnitExtraSpaceRight := TKPrintPageSetup(Source).UnitExtraSpaceRight; UnitFooterSpace := TKPrintPageSetup(Source).UnitFooterSpace; UnitHeaderSpace := TKPrintPageSetup(Source).UnitHeaderSpace; UnitMarginBottom := TKPrintPageSetup(Source).UnitMarginBottom; UnitMarginLeft := TKPrintPageSetup(Source).UnitMarginLeft; UnitMarginRight := TKPrintPageSetup(Source).UnitMarginRight; UnitMarginTop := TKPrintPageSetup(Source).UnitMarginTop; Units := TKPrintPageSetup(Source).Units; OnUpdateSettings := TKPrintPageSetup(Source).OnUpdateSettings; finally UnlockUpdate; end; end; end; procedure TKPrintPageSetup.BeforeUnitsChange; begin FUnitExtraSpaceLeft := ValueToInches(FUnits, FUnitExtraSpaceLeft); FUnitExtraSpaceRight := ValueToInches(FUnits, FUnitExtraSpaceRight); FUnitFooterSpace := ValueToInches(FUnits, FUnitFooterSpace); FUnitHeaderSpace := ValueToInches(FUnits, FUnitHeaderSpace); FUnitMarginBottom := ValueToInches(FUnits, FUnitMarginBottom); FUnitMarginLeft := ValueToInches(FUnits, FUnitMarginLeft); FUnitMarginRight := ValueToInches(FUnits, FUnitMarginRight); FUnitMarginTop := ValueToInches(FUnits, FUnitMarginTop); end; function TKPrintPageSetup.HMap(Value: Integer): Integer; begin Result := MulDiv(Value, FPrinterPixelsPerInchX, FDesktopPixelsPerInchX); end; procedure TKPrintPageSetup.Invalidate; begin FIsValid := False; end; procedure TKPrintPageSetup.PaintPageToPreview(APreview: TKPrintPreview); var PaperWidth, PaperHeight, DesktopPageWidth, DesktopPageHeight, SaveIndex, LeftOffset: Integer; R, PageRect: TRect; begin if UpdateUnlocked and Assigned(FControl) then begin if FActive then Invalidate else begin FCanvas := APreview.CurrentCanvas; FActive := True; FPreviewing := True; try FControl.PrintPaintBegin; FCurrentCopy := 1; FCurrentPage := APreview.Page; if (poMirrorMargins in FOptions) and (FCurrentPage and 1 <> 0) then begin FPrinterMarginLeftMirrored := FPrinterMarginRight; FPrinterMarginRightMirrored := FPrinterMarginLeft; end else begin FPrinterMarginLeftMirrored := FPrinterMarginLeft; FPrinterMarginRightMirrored := FPrinterMarginRight; end; R := APreview.PageRect; PaperWidth := R.Right - R.Left; PaperHeight := R.Bottom - R.Top; if CurrentPageControl > 0 then begin SaveIndex := SaveDC(FCanvas.Handle); try if poFitToPage in FOptions then LeftOffset := FPrinterExtraSpaceLeft else LeftOffset := 0; // change the canvas mapping mode to scale the page outline CanvasSetOffset(FCanvas, R.Left + MulDiv(FPrinterMarginLeftMirrored + LeftOffset, PaperWidth, FPrinterPageWidth), R.Top + MulDiv(FPrinterMarginTop + FPrinterHeaderSpace, PaperHeight, FPrinterPageHeight)); if FPrintingMapped then begin DesktopPageWidth := MulDiv(FPrinterPageWidth, FDesktopPixelsPerInchX, FPrinterPixelsPerInchX); DesktopPageHeight := MulDiv(FPrinterPageHeight, FDesktopPixelsPerInchY, FPrinterPixelsPerInchY); CanvasSetScale(FCanvas, Round(PaperWidth * FCurrentScale), Round(PaperHeight * FCurrentScale), DesktopPageWidth, DesktopPageHeight); end else CanvasSetScale(FCanvas, PaperWidth, PaperHeight, FPrinterPageWidth, FPrinterPageHeight); FControl.PaintPage; finally RestoreDC(FCanvas.Handle, SaveIndex); end; end; PaperWidth := R.Right - R.Left; PaperHeight := R.Bottom - R.Top; SaveIndex := SaveDC(FCanvas.Handle); try CanvasSetOffset(FCanvas, R.Left, R.Top); CanvasSetScale(FCanvas, PaperWidth, PaperHeight, FPrinterPageWidth, FPrinterPageHeight); PageRect := Rect(0, 0, FPrinterPageWidth, FPrinterPageHeight); TranslateRectToDevice(FCanvas.Handle, PageRect); SelectClipRect(FCanvas.Handle, PageRect); FControl.PrintPaint; finally RestoreDC(FCanvas.Handle, SaveIndex); end; SaveIndex := SaveDC(FCanvas.Handle); try CanvasSetOffset(FCanvas, R.Left, R.Top); CanvasSetScale(FCanvas, PaperWidth, PaperHeight, FPrinterPageWidth, FPrinterPageHeight); PageRect := Rect(0, 0, FPrinterPageWidth, FPrinterPageHeight); TranslateRectToDevice(FCanvas.Handle, PageRect); SelectClipRect(FCanvas.Handle, PageRect); PrintTitle; PrintPageNumber(FCurrentPage); finally RestoreDC(FCanvas.Handle, SaveIndex); end; FControl.PrintPaintEnd; finally FActive := False; FPreviewing := False; FCanvas := nil; end; end; end; end; procedure TKPrintPageSetup.PrintPageNumber(Value: Integer); var S: string; begin if poPageNumbers in FOptions then begin SetBkMode(FCanvas.Handle, TRANSPARENT); FCanvas.Brush.Style := bsClear; FCanvas.Font.Color := clBlack; FCanvas.Font.Height := 1; FCanvas.Font.Height := VMap(16); FCanvas.Font.Name := 'Arial'; FCanvas.Font.Pitch := fpDefault; FCanvas.Font.Style := [fsBold]; S := Format('- %d -', [Value]); FCanvas.TextOut(FPrinterMarginLeftMirrored + (FPrinterPageWidth - FPrinterMarginLeft - FPrinterMarginRight - FCanvas.TextWidth(S)) div 2, FPrinterPageHeight - FPrinterMarginBottom + VMap(5), S); end; end; procedure TKPrintPageSetup.PrintTitle; begin if poTitle in FOptions then begin SetBkMode(FCanvas.Handle, TRANSPARENT); FCanvas.Brush.Style := bsClear; FCanvas.Font.Color := clBlack; FCanvas.Font.Height := 1; FCanvas.Font.Height := VMap(16); FCanvas.Font.Name := 'Arial'; FCanvas.Font.Pitch := fpDefault; FCanvas.Font.Style := [fsBold]; FCanvas.TextOut(FPrinterMarginLeftMirrored, FPrinterMarginTop - VMap(36), Title); FCanvas.Brush.Style := bsSolid; FCanvas.Brush.Color := clBlack; FCanvas.FillRect(Rect(FPrinterMarginLeftMirrored, FPrinterMarginTop - VMap(14), FPrinterPageWidth - FPrinterMarginRight, FPrinterMarginTop - VMap(12))); end; end; procedure TKPrintPageSetup.PrintOut; function DoPrint: Boolean; var LeftOffset, SaveIndex: Integer; PageRect: TRect; begin Result := False; if (poMirrorMargins in FOptions) and (FCurrentPage and 1 <> 0) then begin FPrinterMarginLeftMirrored := FPrinterMarginRight; FPrinterMarginRightMirrored := FPrinterMarginLeft; end else begin FPrinterMarginLeftMirrored := FPrinterMarginLeft; FPrinterMarginRightMirrored := FPrinterMarginRight; end; if CurrentPageControl > 0 then begin SaveIndex := SaveDC(FCanvas.Handle); try if poFitToPage in FOptions then LeftOffset := FPrinterExtraSpaceLeft else LeftOffset := 0; CanvasSetOffset(FCanvas, FPrinterMarginLeftMirrored + LeftOffset, FPrinterMarginTop + FPrinterHeaderSpace); if FPrintingMapped then begin // change the canvas mapping mode to scale the page outline CanvasSetScale(FCanvas, Round(FPrinterPageWidth * FCurrentScale), Round(FPrinterPageHeight * FCurrentScale), MulDiv(FPrinterPageWidth, FDesktopPixelsPerInchX, FPrinterPixelsPerInchX), MulDiv(FPrinterPageHeight, FDesktopPixelsPerInchY, FPrinterPixelsPerInchY)); end else CanvasResetScale(FCanvas); FControl.PaintPage; finally RestoreDC(FCanvas.Handle, SaveIndex); end; end; SaveIndex := SaveDC(FCanvas.Handle); try CanvasResetScale(FCanvas); PageRect := Rect(0, 0, FPrinterPageWidth, FPrinterPageHeight); TranslateRectToDevice(FCanvas.Handle, PageRect); SelectClipRect(FCanvas.Handle, PageRect); FControl.PrintPaint; finally RestoreDC(FCanvas.Handle, SaveIndex); end; SaveIndex := SaveDC(FCanvas.Handle); try CanvasResetScale(FCanvas); PageRect := Rect(0, 0, FPrinterPageWidth, FPrinterPageHeight); TranslateRectToDevice(FCanvas.Handle, PageRect); SelectClipRect(FCanvas.Handle, PageRect); PrintTitle; PrintPageNumber(FCurrentPage); finally RestoreDC(FCanvas.Handle, SaveIndex); end; FControl.PrintNotify(epsNewPage, Result); if ((FCurrentPage < FEndPage) or (FCurrentCopy < FCopies)) and not Result then Printer.NewPage; end; var I, J, PrinterCount: Integer; AbortPrint: Boolean; { Orientation: TPrinterOrientation; PaperSize: TPaperSize; APageWidth, ApageHeight, APaperWidth, APaperHeight: Integer; PrinterType: TPrinterType; APaperRect: TPaperRect;} begin if UpdateUnlocked and Assigned(FControl) and not FActive then begin UpdateSettings; if FPageCount > 0 then begin if IsDefaultPrinter then begin PrinterCount := 0; try AbortPrint := False; PrinterCount := Printer.Printers.Count; Printer.Title := FTitle; Printer.Copies := 1; { PrinterType := Printer.PrinterType; APageWidth := Printer.PageWidth; APageHeight := Printer.PageHeight; APaperRect := Printer.PaperSize.PaperRect; Orientation := Printer.Orientation;} Printer.BeginDoc; FActive := True; try FCanvas := Printer.Canvas; FControl.PrintNotify(epsBegin, AbortPrint); { Printer.Canvas.Font.Name := 'Arial'; Printer.Canvas.Font.color := clBlack; Printer.Canvas.Font.height := 100; Printer.Canvas.TextOut(200, 200, 'hello!');} if not AbortPrint then begin FControl.PrintPaintBegin; try if poCollate in FOptions then for I := 1 to FCopies do begin FCurrentCopy := I; for J := FStartPage to FEndPage do begin FCurrentPage := J; AbortPrint := DoPrint; if AbortPrint then Break; end; if AbortPrint then Break; end else for J := FStartPage to FEndPage do begin FCurrentPage := J; for I := 1 to FCopies do begin FCurrentCopy := I; AbortPrint := DoPrint; if AbortPrint then Break; end; if AbortPrint then Break; end finally FControl.PrintPaintEnd; end; end; FCurrentPage := 0; FCurrentCopy := 0; FControl.PrintNotify(epsEnd, AbortPrint); finally FActive := False; Printer.EndDoc; FCanvas := nil; end; except if PrinterCount = 0 then KMsgBox(sPSErrPrintSetup, sPSErrNoPrinterInstalled, [mbOk], miStop) else KMsgBox(sPSErrPrintSetup, sPSErrPrinterUnknown, [mbOk], miStop); end; end else KMsgBox(sPSErrPrintSetup, sPSErrNoDefaultPrinter, [mbOk], miStop); end; end; end; procedure TKPrintPageSetup.SetCopies(Value: Integer); begin if FActive then Exit; if Value <> FCopies then begin FCopies := Value; Changed; end; end; procedure TKPrintPageSetup.SetEndPage(Value: Integer); begin if FActive then Exit; if Value <> FEndPage then begin FEndPage := Value; Changed; end; end; procedure TKPrintPageSetup.SetOptions(Value: TKPrintOptions); begin if FActive then Exit; if Value <> FOptions then begin FOptions := Value; Changed; end; end; procedure TKPrintPageSetup.SetOrientation(AValue: TPrinterOrientation); begin if AValue <> FOrientation then begin FOrientation := AValue; Changed; end; end; procedure TKPrintPageSetup.SetPrinterName(const Value: string); begin if FActive then Exit; if Value <> FPrinterName then begin FPrinterName := Value; Changed; end; end; procedure TKPrintPageSetup.SetPrintingMapped(Value: Boolean); begin if FActive then Exit; if Value <> FPrintingMapped then begin FPrintingMapped := Value; Changed; end; end; procedure TKPrintPageSetup.SetRange(Value: TKPrintRange); begin if FActive then Exit; if Value <> FRange then begin FRange := Value; Changed; end; end; procedure TKPrintPageSetup.SetScale(Value: Integer); begin if FActive then Exit; if Value <> FScale then begin FScale := Value; Changed; end; end; procedure TKPrintPageSetup.SetStartPage(Value: Integer); begin if FActive then Exit; if Value <> FStartPage then begin FStartPage := Value; Changed; end; end; procedure TKPrintPageSetup.SetUnitExtraSpaceLeft(Value: Double); begin if FActive then Exit; if Value <> FUnitExtraSpaceLeft then begin FUnitExtraSpaceLeft := Value; Changed; end; end; procedure TKPrintPageSetup.SetUnitExtraSpaceRight(Value: Double); begin if FActive then Exit; if Value <> FUnitExtraSpaceRight then begin FUnitExtraSpaceRight := Value; Changed; end; end; procedure TKPrintPageSetup.SetUnitFooterSpace(Value: Double); begin if FActive then Exit; if Value <> FUnitFooterSpace then begin FUnitFooterSpace := Value; Changed; end; end; procedure TKPrintPageSetup.SetUnitHeaderSpace(Value: Double); begin if FActive then Exit; if Value <> FUnitHeaderSpace then begin FUnitHeaderSpace := Value; Changed; end; end; procedure TKPrintPageSetup.SetUnitMarginBottom(Value: Double); begin if FActive then Exit; if Value <> FUnitMarginBottom then begin FUnitMarginBottom := Value; Changed; end; end; procedure TKPrintPageSetup.SetUnitMarginLeft(Value: Double); begin if FActive then Exit; if Value <> FUnitMarginLeft then begin FUnitMarginLeft := Value; Changed; end; end; procedure TKPrintPageSetup.SetUnitMarginRight(Value: Double); begin if FActive then Exit; if Value <> FUnitMarginRight then begin FUnitMarginRight := Value; Changed; end; end; procedure TKPrintPageSetup.SetUnitMarginTop(Value: Double); begin if FActive then Exit; if Value <> FUnitMarginTop then begin FUnitMarginTop := Value; Changed; end; end; procedure TKPrintPageSetup.SetUnits(Value: TKPrintUnits); begin if FActive then Exit; if Value <> FUnits then begin BeforeUnitsChange; FUnits := Value; AfterUnitsChange; end; end; procedure TKPrintPageSetup.Update; begin UpdateSettings; end; procedure TKPrintPageSetup.UpdateSettings; var I, PixelsPerInchX, PixelsPerInchY: Integer; D: Double; DC: HDC; Info: TKPrintMeasureInfo; begin if UpdateUnlocked and not FActive and not FValidating then begin FValidating := True; try if Assigned(FOnUpdateSettings) then FOnUpdateSettings(Self); // limit copies and Scale FCopies := MinMax(FCopies, cCopiesMin, cCopiesMax); FScale := MinMax(FScale, cScaleMin, cScaleMax); // get metrics for the desktop DC := GetDC(0); try FDesktopPixelsPerInchX := GetDeviceCaps(DC, LOGPIXELSX); FDesktopPixelsPerInchY := GetDeviceCaps(DC, LOGPIXELSY); finally ReleaseDC(0, DC); end; // Printer.Refresh; // default printer metrics if no printer is installed FOrientation := poPortrait; FPrinterPageWidth := 2360; FPrinterPageHeight := 3400; FPrinterPixelsPerInchX := 300; FPrinterPixelsPerInchY := 300; // get printer data try if IsDefaultPrinter then begin I := Printer.Printers.IndexOf(FPrinterName); if I >= 0 then Printer.PrinterIndex := I; // set orientation in case somebody assigned it programmatically try Printer.Orientation := FOrientation; except FOrientation := Printer.Orientation; end; // get metrics for the printer if Printer.Printers.Count > 0 then begin FPrinterPageWidth := Printer.PageWidth; FPrinterPageHeight := Printer.PageHeight; {$IFDEF FPC} FPrinterPixelsPerInchX := Printer.XDPI; FPrinterPixelsPerInchY := Printer.YDPI; {$ELSE} FPrinterPixelsPerInchX := GetDeviceCaps(Printer.Handle, LOGPIXELSX); FPrinterPixelsPerInchY := GetDeviceCaps(Printer.Handle, LOGPIXELSY); {$ENDIF} end end; except // silent, keep default or successfully obtained data end; // decide how to outline extent if FPrintingMapped then begin PixelsPerInchX := FDesktopPixelsPerInchX; PixelsPerInchY := FDesktopPixelsPerInchY; end else begin PixelsPerInchX := FPrinterPixelsPerInchX; PixelsPerInchY := FPrinterPixelsPerInchY; end; FMappedPageHeight := MulDiv(FPrinterPageHeight, PixelsPerInchX, FPrinterPixelsPerInchX); FMappedPageWidth := MulDiv(FPrinterPageWidth, PixelsPerInchX, FPrinterPixelsPerInchX); // limit and convert margins D := FPrinterPageWidth * 0.4; // 40% of the page FPrinterMarginLeft := Round(MinMax(ValueToInches(FUnits, FUnitMarginLeft) * FPrinterPixelsPerInchX, 0, D)); FUnitMarginLeft := InchesToValue(FUnits, FPrinterMarginLeft / FPrinterPixelsPerInchX); FMappedMarginLeft := MulDiv(FPrinterMarginLeft, PixelsPerInchX, FPrinterPixelsPerInchX); FPrinterMarginLeftMirrored := FPrinterMarginLeft; FMappedMarginLeftMirrored := FMappedMarginLeft; FPrinterMarginRight := Round(MinMax(ValueToInches(FUnits, FUnitMarginRight) * FPrinterPixelsPerInchX, 0, D)); FUnitMarginRight := InchesToValue(FUnits, FPrinterMarginRight / FPrinterPixelsPerInchX); FMappedMarginRight := MulDiv(FPrinterMarginRight, PixelsPerInchX, FPrinterPixelsPerInchX); FPrinterMarginRightMirrored := FPrinterMarginRight; FMappedMarginRightMirrored := FMappedMarginRight; D := FPrinterPageHeight * 0.4; // 40% of the page FPrinterMarginTop := Round(MinMax(ValueToInches(FUnits, FUnitMarginTop) * FPrinterPixelsPerInchY, 0, D)); FUnitMarginTop := InchesToValue(FUnits, FPrinterMarginTop / FPrinterPixelsPerInchY); FMappedMarginTop := MulDiv(FPrinterMarginTop, PixelsPerInchX, FPrinterPixelsPerInchX); FPrinterMarginBottom := Round(MinMax(ValueToInches(FUnits, FUnitMarginBottom) * FPrinterPixelsPerInchY, 0, D)); FUnitMarginBottom := InchesToValue(FUnits, FPrinterMarginBottom / FPrinterPixelsPerInchY); FMappedMarginBottom := MulDiv(FPrinterMarginBottom, PixelsPerInchX, FPrinterPixelsPerInchX); // limit and convert header and footer space FPrinterHeaderSpace := Round(MinMax(ValueToInches(FUnits, Max(FUnitHeaderSpace, 0)) * FPrinterPixelsPerInchY, 0, D - FPrinterMarginTop)); FUnitHeaderSpace := InchesToValue(FUnits, FPrinterHeaderSpace / FPrinterPixelsPerInchY); FMappedHeaderSpace := MulDiv(FPrinterHeaderSpace, PixelsPerInchX, FPrinterPixelsPerInchX); FPrinterFooterSpace := Round(MinMax(ValueToInches(FUnits, Max(FUnitFooterSpace, 0)) * FPrinterPixelsPerInchY, 0, D - FPrinterMarginBottom)); FUnitFooterSpace := InchesToValue(FUnits, FPrinterFooterSpace / FPrinterPixelsPerInchY); FMappedFooterSpace := MulDiv(FPrinterFooterSpace, PixelsPerInchX, FPrinterPixelsPerInchX); // limit and convert extra space FPrinterExtraSpaceLeft := Round(ValueToInches(FUnits, Max(FUnitExtraSpaceLeft, 0)) * FPrinterPixelsPerInchX); FUnitExtraSpaceLeft := InchesToValue(FUnits, FPrinterExtraSpaceLeft / FPrinterPixelsPerInchX); FMappedExtraSpaceLeft := MulDiv(FPrinterExtraSpaceLeft, PixelsPerInchX, FPrinterPixelsPerInchX); FPrinterExtraSpaceRight := Round(ValueToInches(FUnits, Max(FUnitExtraSpaceRight, 0)) * FPrinterPixelsPerInchX); FUnitExtraSpaceRight := InchesToValue(FUnits, FPrinterExtraSpaceRight / FPrinterPixelsPerInchX); FMappedExtraSpaceRight := MulDiv(FPrinterExtraSpaceRight, PixelsPerInchX, FPrinterPixelsPerInchX); // paint area extent FPrinterPaintAreaHeight := FPrinterPageHeight - FPrinterMarginTop - FPrinterMarginBottom - FPrinterHeaderSpace - FPrinterFooterSpace; FUnitPaintAreaHeight := InchesToValue(FUnits, FPrinterPaintAreaHeight / FPrinterPixelsPerInchY); FMappedPaintAreaHeight := MulDiv(FPrinterPaintAreaHeight, PixelsPerInchY, FPrinterPixelsPerInchY); FPrinterPaintAreaWidth := FPrinterPageWidth - FPrinterMarginLeft - FPrinterMarginRight; FUnitPaintAreaWidth := InchesToValue(FUnits, FPrinterPaintAreaWidth / FPrinterPixelsPerInchX); FMappedPaintAreaWidth := MulDiv(FPrinterPaintAreaWidth, PixelsPerInchX, FPrinterPixelsPerInchX); // control paint area extent FPrinterControlPaintAreaWidth := FPrinterPaintAreaWidth; if poFitToPage in FOptions then Dec(FPrinterControlPaintAreaWidth, FPrinterExtraSpaceLeft + FPrinterExtraSpaceRight); FUnitControlPaintAreaWidth := InchesToValue(FUnits, FPrinterControlPaintAreaWidth / FPrinterPixelsPerInchX); FMappedControlPaintAreaWidth := MulDiv(FPrinterControlPaintAreaWidth, PixelsPerInchX, FPrinterPixelsPerInchX); // default horizontal scaling FCurrentScale := FScale / 100; // default page/copy info FCurrentCopy := 0; FCurrentPage := 0; // measured data if Assigned(FControl) then begin FillChar(Info, SizeOf(TKPrintMeasureInfo), 0); FControl.MeasurePages(Info); if Assigned(FOnPrintMeasure) then FOnPrintMeasure(Self, Info); FMappedOutlineWidth := Info.OutlineWidth; FMappedOutlineHeight := Info.OutlineHeight; FExtraLeftHorzPageCount := Info.ExtraLeftHorzPageCount; FExtraLeftVertPageCount := Info.ExtraLeftVertPageCount; FExtraLeftPageCount := FExtraLeftHorzPageCount * FExtraLeftVertPageCount; FExtraRightHorzPageCount := Info.ExtraRightHorzPageCount; FExtraRightVertPageCount := Info.ExtraRightVertPageCount; FExtraRightPageCount := FExtraRightHorzPageCount * FExtraRightVertPageCount; FControlHorzPageCount := Info.ControlHorzPageCount; FControlVertPageCount := Info.ControlVertPageCount; FControlPageCount := FControlHorzPageCount * FControlVertPageCount; FPageCount := FExtraLeftPageCount + FControlPageCount + FExtraRightPageCount; if FPageCount > 0 then begin // update horizontal scaling if (poFitToPage in FOptions) and (FMappedOutlineWidth > 0) then FCurrentScale := FMappedControlPaintAreaWidth / FMappedOutlineWidth; // limit start and end page case FRange of prAll, prSelectedOnly: begin FStartPage := 1; FEndPage := FPageCount; end; prRange: begin FEndPage := MinMax(FEndPage, 1, FPageCount); FStartPage := MinMax(FStartPage, 1, FEndPage); end; end; end; // notify all previews/ force their repainting FControl.NotifyPreviews; end else begin FMappedOutlineWidth := 0; FMappedOutlineHeight := 0; FExtraLeftHorzPageCount := 0; FExtraLeftVertPageCount := 0; FExtraRightHorzPageCount := 0; FExtraRightVertPageCount := 0; FControlHorzPageCount := 0; FControlVertPageCount := 0; FPageCount := 0; FEndPage := 0; FStartPage := 0; end; FIsValid := True; finally FValidating := False; end; end; end; procedure TKPrintPageSetup.Validate; begin if not FIsValid and not FValidating then UpdateSettings; end; function TKPrintPageSetup.VMap(Value: Integer): Integer; begin Result := MulDiv(Value, FPrinterPixelsPerInchY, FDesktopPixelsPerInchY); end; { TKPreviewColors } function TKPreviewColors.GetColorSpec(Index: TKColorIndex): TKColorSpec; begin case Index of ciPaper: begin Result.Def := cPaperDef; Result.Name := ''; end; ciBkGnd: begin Result.Def := cBkGndDef; Result.Name := ''; end; ciBorder: begin Result.Def := cBorderDef; Result.Name := ''; end; ciSelectedBorder: begin Result.Def := cSelectedBorderDef; Result.Name := ''; end; else Result := inherited GetColorSpec(Index); end; end; function TKPreviewColors.GetMaxIndex: Integer; begin Result := ciPreviewColorsMax; end; { TKPrintPreview } constructor TKPrintPreview.Create(AOwner: TComponent); begin inherited; FColors := TKPreviewColors.Create(Self); FControl := nil; FCurrentCanvas := Canvas; FMouseWheelAccumulator := 0; FPage := 1; FPageSize := CreateEmptyPoint; FPixelsPerInchX := cDPIDef; FPixelsPerInchY := cDPIDef; FScale := 100; FScaleMode := smPageWidth; FOnChanged := nil; LoadCustomCursor(crDragHandFree, 'KPREVIEW_CURSOR_HAND_FREE'); LoadCustomCursor(crDragHandGrip, 'KPREVIEW_CURSOR_HAND_GRIP'); Width := 300; Height := 200; end; destructor TKPrintPreview.Destroy; begin if Assigned(FControl) then FControl.RemovePreview(Self); inherited; FColors.Free; end; procedure TKPrintPreview.BeginScrollWindow; begin FPageOld := FPage; FScrollPosOld := FScrollPos; end; procedure TKPrintPreview.CreateParams(var Params: TCreateParams); begin inherited; with Params do Style := Style or WS_HSCROLL or WS_VSCROLL; end; function TKPrintPreview.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; const cWheelDivisor = 120; var Delta, WheelClicks: Integer; begin Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos); if not Result then begin if ssCtrl in Shift then begin if FScaleMode = smWholePage then Delta := 10 else Delta := ClientHeight; end else if FScaleMode = smWholePage then Delta := 1 else Delta := ClientHeight div 10; Inc(FMouseWheelAccumulator, WheelDelta); WheelClicks := FMouseWheelAccumulator div cWheelDivisor; FMouseWheelAccumulator := FMouseWheelAccumulator mod cWheelDivisor; BeginScrollWindow; ModifyScrollBar(SB_VERT, cScrollDelta, -WheelClicks * Delta); EndScrollWindow; Result := True; end; end; procedure TKPrintPreview.EndScrollWindow; begin if (FPage <> FPageOld) then Invalidate else if (FScrollPos.X <> FScrollPosOld.X) or (FScrollPos.Y <> FScrollPosOld.Y) then begin ScrollWindowEx(Handle, FScrollPosOld.X - FScrollPos.X, FScrollPosOld.Y - FScrollPos.Y, nil, nil, 0, nil, SW_INVALIDATE); end; end; procedure TKPrintPreview.FirstPage; begin Page := StartPage; end; function TKPrintPreview.GetCurrentScale: Integer; begin if Assigned(FControl) then Result := MulDiv(FPageSize.X, 100, MulDiv(FControl.PageSetup.PrinterPageWidth, 300, FControl.PageSetup.PrinterPixelsPerInchX)) else Result := FScale; end; function TKPrintPreview.GetEndPage: Integer; begin if Assigned(FControl) then begin Result := FControl.PageSetup.EndPage; if Result = 0 then begin FControl.PageSetup.UpdateSettings; Result := FControl.PageSetup.EndPage end; end else Result := 0; end; function TKPrintPreview.GetPageRect: TRect; begin with Result do begin Left := FPageOffset.X - FScrollPos.X; if FScaleMode = smWholePage then Top := FPageOffset.Y else Top := FPageOffset.Y - FScrollPos.Y; Right := Left + FPageSize.X; Bottom := Top + FPageSize.Y; end; end; function TKPrintPreview.GetStartPage: Integer; begin if Assigned(FControl) then begin Result := FControl.PageSetup.StartPage; if Result = 0 then begin FControl.PageSetup.UpdateSettings; Result := FControl.PageSetup.StartPage end; end else Result := 0; end; procedure TKPrintPreview.KeyDown(var Key: Word; Shift: TShiftState); var DeltaX, DeltaY, LineX, PageY: Integer; NoAlt, NoAltCtrl: Boolean; begin NoAlt := Shift * [ssAlt] = []; NoAltCtrl := Shift * [ssAlt, ssCtrl] = []; DeltaX := 0; DeltaY := 0; LineX := ClientWidth div 10; PageY := ClientHeight; case Key of VK_UP: if NoAltCtrl then begin if FScaleMode = smWholePage then PreviousPage else DeltaY := -PageY div 10; end; VK_DOWN: if NoAltCtrl then begin if FScaleMode = smWholePage then NextPage else DeltaY := PageY div 10; end; VK_PRIOR: if NoAltCtrl then begin if FScaleMode = smWholePage then PreviousPage else DeltaY := -PageY; end; VK_NEXT: if NoAltCtrl then begin if FScaleMode = smWholePage then NextPage else DeltaY := PageY; end; VK_LEFT: if NoAltCtrl then DeltaX := -LineX; VK_RIGHT: if NoAltCtrl then DeltaX := LineX; VK_HOME: if NoAlt then begin if ssCtrl in Shift then FirstPage else DeltaX := -FScrollPos.X; end; VK_END: if NoAlt then begin if ssCtrl in Shift then LastPage else DeltaX := FScrollExtent.X - FScrollPos.X; end; end; if (DeltaX <> 0) or (DeltaY <> 0) then begin BeginScrollWindow; if DeltaX <> 0 then ModifyScrollBar(SB_HORZ, cScrollDelta, DeltaX); if DeltaY <> 0 then ModifyScrollBar(SB_VERT, cScrollDelta, DeltaY); EndScrollWindow; end; end; procedure TKPrintPreview.LastPage; begin Page := EndPage; end; procedure TKPrintPreview.ModifyScrollBar(ScrollBar, ScrollCode, Delta: Integer); var I, AEndPage: Integer; Divisor: Cardinal; PPos, PExtent: PInteger; SI: TScrollInfo; begin Divisor := 10; if ScrollBar = SB_HORZ then begin PPos := @FScrollPos.X; PExtent := @FScrollExtent.X; end else begin if FScaleMode = smWholePage then begin PPos := @FPage; AEndPage := EndPage; PExtent := @AEndPage; Divisor := 1; end else begin PPos := @FScrollPos.Y; PExtent := @FScrollExtent.Y; end; end; if PExtent^ > 0 then begin SI.cbSize := SizeOf(TScrollInfo); SI.fMask := SIF_RANGE or SIF_PAGE or SIF_TRACKPOS; GetScrollInfo(Handle, ScrollBar, SI); {$IFDEF UNIX} SI.nTrackPos := Delta; {$ENDIF} I := PPos^; case ScrollCode of SB_TOP: I := SI.nMin; SB_BOTTOM: I := SI.nMax; // will be trimmed below SB_LINEUP: Dec(I, SI.nPage div Divisor); SB_LINEDOWN: Inc(I, SI.nPage div Divisor); SB_PAGEUP: Dec(I, SI.nPage); SB_PAGEDOWN: Inc(I, SI.nPage); SB_THUMBTRACK, SB_THUMBPOSITION: I := SI.nTrackPos; cScrollDelta: Inc(I, Delta); end; if FScaleMode = smWholePage then I := MinMax(I, 1, PExtent^) else I := MinMax(I, 0, PExtent^); PPos^ := I; SI.nPos := I; SI.fMask := SIF_POS; SetScrollInfo(Handle, ScrollBar, SI, True); end; end; procedure TKPrintPreview.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; if ssLeft in Shift then begin SafeSetFocus; if (FScaleMode <> smWholePage) and PtInRect(GetPageRect, Point(X, Y)) then begin FlagSet(cPF_Dragging); FX := X; FY := Y; SetMouseCursor(X, Y); end; end; end; procedure TKPrintPreview.MouseMove(Shift: TShiftState; X, Y: Integer); begin inherited; if Flag(cPF_Dragging) and MouseCapture then begin BeginScrollWindow; if (X > FX) and (FScrollPos.X > 0) or (X < FX) and (FScrollPos.X < FScrollExtent.X) then begin ModifyScrollBar(SB_HORZ, cScrollDelta, FX - X); FX := X; end; if (Y > FY) and (FScrollPos.Y > 0) or (Y < FY) and (FScrollPos.Y < FScrollExtent.Y) then begin ModifyScrollBar(SB_VERT, cScrollDelta, FY - Y); FY := Y; end; EndScrollWindow; end; end; procedure TKPrintPreview.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; FlagClear(cPF_Dragging); SetMouseCursor(X, Y); end; procedure TKPrintPreview.NextPage; begin Page := Page + 1; end; procedure TKPrintPreview.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if (Operation = opRemove) and (AComponent = FControl) then begin FControl := nil; UpdatePreview; end; end; procedure TKPrintPreview.PaintToCanvas(ACanvas: TCanvas); procedure DoPaint(IsBuffer: Boolean); var C: TColor; R, RPaper, RPage: TRect; RgnPaper: HRGN; begin ACanvas.Brush.Style := bsSolid; ACanvas.Pen.Mode := pmCopy; ACanvas.Pen.Style := psSolid; ACanvas.Pen.Width := 1; RPage := GetPageRect; RPaper := RPage; with RPaper do begin Inc(Right, cPreviewShadowSize); Inc(Bottom, cPreviewShadowSize); end; if not IsBuffer then RgnPaper := CreateRectRgnIndirect(RPaper) else RgnPaper := 0; try // paint background around paper, we don't want at least this to flicker if IsBuffer or (ExtSelectClipRgn(ACanvas.Handle, RgnPaper, RGN_DIFF) <> NULLREGION) then begin ACanvas.Brush.Color := FColors.BkGnd; ACanvas.FillRect(ClientRect); end; if not IsBuffer then SelectClipRgn(ACanvas.Handle, RgnPaper); finally if not IsBuffer then DeleteObject(rgnPaper); end; // paint paper outline if Focused then C := FColors.SelectedBorder else C := FColors.Border; ACanvas.Pen.Color := C; ACanvas.Brush.Color := FColors.Paper; ACanvas.Rectangle(RPage); ACanvas.Brush.Color := FColors.BkGnd; R := Rect(RPage.Left, RPage.Bottom, RPage.Left + cPreviewShadowSize, RPage.Bottom + cPreviewShadowSize); ACanvas.FillRect(R); R := Rect(RPage.Right, RPage.Top, RPage.Right + cPreviewShadowSize, RPage.Top + cPreviewShadowSize); ACanvas.FillRect(R); ACanvas.Brush.Color := C; R := Rect(RPage.Left + cPreviewShadowSize, RPage.Bottom, RPaper.Right, RPaper.Bottom); ACanvas.FillRect(R); R := Rect(RPage.Right, RPage.Top + cPreviewShadowSize, RPaper.Right, RPaper.Bottom); ACanvas.FillRect(R); // paint page outline InflateRect(RPage, -1, -1); FControl.PageSetup.PaintPageToPreview(Self); end; var SaveIndex: Integer; RClient: TRect; {$IFDEF MSWINDOWS} Org: TPoint; MemBitmap, OldBitmap: HBITMAP; DC: HDC; {$ENDIF} begin RClient := ClientRect; if Assigned(FControl) then begin SaveIndex := SaveDC(ACanvas.Handle); try {$IFDEF MSWINDOWS} if DoubleBuffered then begin // we must paint always the entire client because of canvas scaling MemBitmap := CreateCompatibleBitmap(ACanvas.Handle, RClient.Right - RClient.Left, RClient.Bottom - RClient.Top); try OldBitmap := SelectObject(ACanvas.Handle, MemBitmap); try SetWindowOrgEx(ACanvas.Handle, 0, 0, @Org); SelectClipRect(ACanvas.Handle, Rect(0, 0, RClient.Right - RClient.Left, RClient.Bottom - RClient.Top)); DoPaint(True); finally SelectObject(ACanvas.Handle, OldBitmap); SetWindowOrgEx(ACanvas.Handle, Org.X, Org.Y, nil); end; // copy MemBitmap to original canvas DC := CreateCompatibleDC(ACanvas.Handle); try OldBitmap := SelectObject(DC, MemBitmap); try CopyBitmap(ACanvas.Handle, RClient, DC, 0, 0); finally SelectObject(DC, OldBitmap); end; finally DeleteDC(DC); end; finally DeleteObject(MemBitmap); end; end else {$ENDIF} DoPaint(False); finally RestoreDC(ACanvas.Handle, SaveIndex); end; end else begin ACanvas.Brush.Color := FColors.BkGnd; ACanvas.FillRect(RClient); end; end; procedure TKPrintPreview.Paint; begin PaintToCanvas(Canvas); end; procedure TKPrintPreview.PaintTo(ACanvas: TCanvas); var OldOffset, OldScrollPos: TPoint; begin // will paint the page on given canvas FCurrentCanvas := ACanvas; OldOffset := FPageOffset; OldScrollPos := FScrollPos; try FPageOffset := Point(0, 0); // don't paint left and top space around paper FScrollPos := Point(0, 0); PaintToCanvas(ACanvas); finally FPageOffset := OldOffset; FScrollPos := OldScrollPos; FCurrentCanvas := Canvas; end; end; procedure TKPrintPreview.Changed; begin if Assigned(FOnChanged) then FOnChanged(Self); end; procedure TKPrintPreview.PreviousPage; begin Page := Page - 1; end; procedure TKPrintPreview.SafeSetFocus; var Form: TCustomForm; begin Form := GetParentForm(Self); if (Form <> nil) and Form.Visible and Form.Enabled and Visible and Enabled then Form.ActiveControl := Self; end; procedure TKPrintPreview.SetColors(const Value: TKPreviewColors); begin FColors.Assign(Value); end; procedure TKPrintPreview.SetControl(Value: TKCustomControl); begin if (Value <> FControl) and (Value <> Self) and not (Value is TKPrintPreview) then begin if Assigned(FControl) then FControl.RemovePreview(Self); FControl := Value; if Assigned(FControl) then FControl.AddPreview(Self); UpdatePreview; end; end; procedure TKPrintPreview.SetPage(Value: Integer); begin Value := MinMax(Value, StartPage, EndPage); if Value <> FPage then begin BeginScrollWindow; if FScaleMode = smWholePage then ModifyScrollBar(SB_VERT, cScrollDelta, Value - FPage) else FPage := Value; EndScrollWindow; Changed; end; end; procedure TKPrintPreview.SetPixelsPerInchX(Value: Integer); begin Value := MinMax(Value, cDPIMin, cDPIMax); if Value <> FPixelsPerInchX then begin FPixelsPerInchX := Value; UpdatePreview; end; end; procedure TKPrintPreview.SetPixelsPerInchY(Value: Integer); begin Value := MinMax(Value, cDPIMin, cDPIMax); if Value <> FPixelsPerInchY then begin FPixelsPerInchY := Value; UpdatePreview; end; end; procedure TKPrintPreview.SetScale(Value: Integer); begin Value := MinMax(Value, cScaleMin, cScaleMax); if Value <> FScale then begin FScale := Value; UpdatePreview; end; end; procedure TKPrintPreview.SetScaleMode(Value: TKPreviewScaleMode); begin if Value <> FScaleMode then begin FScaleMode := Value; UpdatePreview; end; end; function TKPrintPreview.SetMouseCursor(X, Y: Integer): Boolean; var ACursor: TCursor; begin if PtInRect(GetPageRect, Point(X, Y)) and (FScaleMode <> smWholePage) then begin if MouseCapture then ACursor := crDragHandGrip else ACursor := crDragHandFree; end else ACursor := crDefault; {$IFDEF FPC} FCursor := ACursor; SetTempCursor(ACursor); {$ELSE} Windows.SetCursor(Screen.Cursors[ACursor]); {$ENDIF} Result := True; end; procedure TKPrintPreview.UpdatePreview; begin Page := FPage; UpdateScrollRange; Changed; end; procedure TKPrintPreview.UpdateScrollRange; var I: Integer; PageWidth100Percent, PageHeight100Percent: Integer; SI: TScrollInfo; begin if HandleAllocated and not Flag(cPF_UpdateRange) then begin FlagSet(cPF_UpdateRange); try if Assigned(FControl) then begin PageWidth100Percent := MulDiv(FControl.PageSetup.PrinterPageWidth, FPixelsPerInchX, FControl.PageSetup.PrinterPixelsPerInchX); PageHeight100Percent := MulDiv(FControl.PageSetup.PrinterPageHeight, FPixelsPerInchY, FControl.PageSetup.PrinterPixelsPerInchY); case FScaleMode of smScale: begin FPageSize.X := MulDiv(PageWidth100Percent, FScale, 100); FPageSize.Y := MulDiv(PageHeight100Percent, FScale, 100); end; smPageWidth: begin FPageSize.X := Max(ClientWidth - 2 * cPreviewHorzBorder - cPreviewShadowSize, 40); FPageSize.Y := MulDiv(FPageSize.X, PageHeight100Percent, PageWidth100Percent); end; smWholePage: begin FPageSize.X := Max(ClientWidth - 2 * cPreviewHorzBorder - cPreviewShadowSize, 40); FPageSize.Y := Max(ClientHeight - 2 * cPreviewVertBorder - cPreviewShadowSize, 40); I := MulDiv(FPageSize.Y, PageWidth100Percent, PageHeight100Percent); if I < FPageSize.X then FPageSize.X := I else FPageSize.Y := MulDiv(FPageSize.X, PageHeight100Percent, PageWidth100Percent); end; end; FExtent.X := FPageSize.X + 2 * cPreviewHorzBorder + cPreviewShadowSize; FExtent.Y := FPageSize.Y + 2 * cPreviewVertBorder + cPreviewShadowSize; FPageOffset.X := cPreviewHorzBorder; if (FExtent.X < ClientWidth) then Inc(FPageOffset.X, (ClientWidth - FExtent.X) div 2); FPageOffset.Y := cPreviewVertBorder; if (FExtent.Y < ClientHeight) then Inc(FPageOffset.Y, (ClientHeight - FExtent.Y) div 2); // adjust horizontal scroll position I := FScrollPos.X + ClientWidth - FExtent.X - 1; if I > 0 then Dec(FScrollPos.X, I); FScrollPos.X := Max(FScrollPos.X, 0); // adjust vertical scroll position I := FScrollPos.Y + ClientHeight - FExtent.Y - 1; if I > 0 then Dec(FScrollPos.Y, I); FScrollPos.Y := Max(FScrollPos.Y, 0); // update scroll range FScrollExtent.X := 0; FScrollExtent.Y := 0; FillChar(SI, SizeOf(TScrollInfo), 0); SI.cbSize := SizeOf(TScrollInfo); SI.fMask := SIF_RANGE or SIF_PAGE or SIF_POS or SIF_DISABLENOSCROLL {$IFDEF UNIX}or SIF_UPDATEPOLICY{$ENDIF}; SI.nMin := 0; {$IFDEF UNIX} SI.ntrackPos := SB_POLICY_CONTINUOUS; {$ENDIF} case FScaleMode of smScale: begin ShowScrollbar(Handle, SB_HORZ, True); ShowScrollbar(Handle, SB_VERT, True); SI.nMax := FExtent.X{$IFDEF FPC}+ 1{$ENDIF}; SI.nPage := ClientWidth; SI.nPos := FScrollPos.X; FScrollExtent.X := SI.nMax - Integer(SI.nPage); SetScrollInfo(Handle, SB_HORZ, SI, True); SI.nMax := FExtent.Y{$IFDEF FPC}+ 1{$ENDIF}; SI.nPage := ClientHeight; SI.nPos := FScrollPos.Y; FScrollExtent.Y := SI.nMax - Integer(SI.nPage); SetScrollInfo(Handle, SB_VERT, SI, True); end; smPageWidth: begin ShowScrollbar(Handle, SB_HORZ, False); ShowScrollbar(Handle, SB_VERT, True); SI.nMax := FExtent.Y{$IFDEF FPC}+ 1{$ENDIF}; SI.nPage := ClientHeight; SI.nPos := FScrollPos.Y; FScrollExtent.Y := SI.nMax - Integer(SI.nPage); SetScrollInfo(Handle, SB_VERT, SI, True); end; smWholePage: begin // another mode for vertical scrollbar - page selection ShowScrollbar(Handle, SB_HORZ, False); ShowScrollbar(Handle, SB_VERT, True); SI.nMin := StartPage; SI.nMax := EndPage{$IFDEF FPC}+ 1{$ENDIF}; SI.nPage := 1; SI.nPos := FPage; SetScrollInfo(Handle, SB_VERT, SI, True); end; end; end else begin ShowScrollbar(Handle, SB_HORZ, False); ShowScrollbar(Handle, SB_VERT, False); end; Invalidate; finally FlagClear(cPF_UpdateRange); end; end; end; procedure TKPrintPreview.UpdateSize; begin inherited; UpdatePreview; end; procedure TKPrintPreview.WMEraseBkgnd(var Msg: TLMessage); begin Msg.Result := 1; end; procedure TKPrintPreview.WMGetDlgCode(var Msg: TLMNoParams); begin Msg.Result := DLGC_WANTARROWS; end; procedure TKPrintPreview.WMHScroll(var Msg: TLMHScroll); begin SafeSetFocus; BeginScrollWindow; ModifyScrollBar(SB_HORZ, Msg.ScrollCode, Msg.Pos); EndScrollWindow; end; procedure TKPrintPreview.WMKillFocus(var Msg: TLMKillFocus); begin inherited; Invalidate; end; procedure TKPrintPreview.WMSetFocus(var Msg: TLMSetFocus); begin inherited; Invalidate; end; procedure TKPrintPreview.WMVScroll(var Msg: TLMVScroll); begin SafeSetFocus; BeginScrollWindow; ModifyScrollBar(SB_VERT, Msg.ScrollCode, Msg.Pos); EndScrollWindow; end; {$IFDEF FPC} initialization {$i kcontrols.lrs} {$ELSE} {$R kcontrols.res} {$ENDIF} end. tomboy-ng_0.34-1/kcontrols/source/kcontrols.inc0000644000175000017500000001740014125207534021447 0ustar dbannondbannon{ @abstract(This file is part of the KControls component suite for Delphi and Lazarus.) @author(Tomas Krysl) Copyright (c) 2020 Tomas Krysl

License:
This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } {$IFNDEF KCONTROLS_INC} {$DEFINE KCONTROLS_INC} { Default compiler directives for entire KControls Development Suite } {$IFDEF FPC} {$MODE DELPHI} {$B-,H+,J+,Q-,R-,T-,X+} {$ELSE} {$B-,H+,J+,Q-,R-,T-,X+} {$ENDIF} { Specifies if native operating system theme support should be used (Themes.pas is needed) } {$DEFINE USE_THEMES} { COMPILERx, DELPHIx and BCBx directives from VERx } {$IFDEF VER320} {$DEFINE COMPILER25} {$IFDEF BCB} {$DEFINE BCB10C} {$ELSE} {$DEFINE DELPHI10C} {$ENDIF} {$ENDIF} {$IFDEF VER310} {$DEFINE COMPILER24} {$IFDEF BCB} {$DEFINE BCB10B} {$ELSE} {$DEFINE DELPHI10B} {$ENDIF} {$ENDIF} {$IFDEF VER300} {$DEFINE COMPILER23} {$IFDEF BCB} {$DEFINE BCB10S} {$ELSE} {$DEFINE DELPHI10S} {$ENDIF} {$ENDIF} {$IFDEF VER290} {$DEFINE COMPILER22} {$IFDEF BCB} {$DEFINE BCBXE8} {$ELSE} {$DEFINE DELPHIXE8} {$ENDIF} {$ENDIF} {$IFDEF VER280} {$DEFINE COMPILER21} {$IFDEF BCB} {$DEFINE BCBXE7} {$ELSE} {$DEFINE DELPHIXE7} {$ENDIF} {$ENDIF} {$IFDEF VER270} {$DEFINE COMPILER20} {$IFDEF BCB} {$DEFINE BCBXE6} {$ELSE} {$DEFINE DELPHIXE6} {$ENDIF} {$ENDIF} {$IFDEF VER260} {$DEFINE COMPILER19} {$IFDEF BCB} {$DEFINE BCBXE5} {$ELSE} {$DEFINE DELPHIXE5} {$ENDIF} {$ENDIF} {$IFDEF VER250} {$DEFINE COMPILER18} {$IFDEF BCB} {$DEFINE BCBXE4} {$ELSE} {$DEFINE DELPHIXE4} {$ENDIF} {$ENDIF} {$IFDEF VER240} {$DEFINE COMPILER17} {$IFDEF BCB} {$DEFINE BCBXE3} {$ELSE} {$DEFINE DELPHIXE3} {$ENDIF} {$ENDIF} {$IFDEF VER230} {$DEFINE COMPILER16} {$IFDEF BCB} {$DEFINE BCBXE2} {$ELSE} {$DEFINE DELPHIXE2} {$ENDIF} {$ENDIF} {$IFDEF VER220} {$DEFINE COMPILER15} {$IFDEF BCB} {$DEFINE BCBXE} {$ELSE} {$DEFINE DELPHIXE} {$ENDIF} {$ENDIF} {$IFDEF VER210} {$DEFINE COMPILER14} {$IFDEF BCB} {$DEFINE BCB2010} {$ELSE} {$DEFINE DELPHI2010} {$ENDIF} {$ENDIF} {$IFDEF VER200} {$DEFINE COMPILER12} {$IFDEF BCB} {$DEFINE BCB2009} {$ELSE} {$DEFINE DELPHI2009} {$ENDIF} {$ENDIF} {$IFDEF VER180} {$IFDEF VER185} {$DEFINE COMPILER11} {$IFDEF BCB} {$DEFINE BCB2007} {$ELSE} {$DEFINE DELPHI2007} {$ENDIF} {$ELSE} {$DEFINE COMPILER10} {$IFDEF BCB} {$DEFINE BCB2006} {$ELSE} {$DEFINE DELPHI2006} {$ENDIF} {$ENDIF} {$ENDIF} {$IFDEF VER170} {$DEFINE COMPILER9} {$DEFINE DELPHI2005} {$ENDIF} {$IFDEF VER160} {$DEFINE COMPILER8} {$DEFINE DELPHI8} {$ENDIF} {$IFDEF VER150} {$DEFINE COMPILER7} {$DEFINE DELPHI7} {$ENDIF} {$IFDEF VER140} {$DEFINE COMPILER6} {$IFDEF BCB} {$DEFINE BCB6} {$ELSE} {$DEFINE DELPHI6} {$ENDIF} {$ENDIF} {$IFDEF VER130} {$DEFINE COMPILER5} {$IFDEF BCB} {$DEFINE BCB5} {$ELSE} {$DEFINE DELPHI5} {$ENDIF} {$ENDIF} {$IFDEF VER125} {$DEFINE COMPILER4} {$DEFINE BCB} {$DEFINE BCB4} {$ENDIF} {$IFDEF VER120} {$DEFINE COMPILER4} {$DEFINE DELPHI4} {$ENDIF} {$IFDEF VER110} {$DEFINE COMPILER3} {$DEFINE BCB} {$DEFINE BCB3} {$ENDIF} {$IFDEF VER100} {$DEFINE COMPILER3} {$DEFINE DELPHI3} {$ENDIF} {$IFDEF VER93} {$DEFINE COMPILER2} {$DEFINE BCB} {$DEFINE BCB1} {$ENDIF} {$IFDEF VER90} {$DEFINE COMPILER2} {$DEFINE DELPHI2} {$ENDIF} { What is used: DELPHI or BCB ? (BCB is defined by C++Builder 5 and later) } {$IFNDEF BCB} {$DEFINE DELPHI} {$ENDIF} { COMPILERx_UP directives from COMPILERx } {$IFDEF COMPILER25} {$DEFINE COMPILER25_UP} {$ENDIF} {$IFDEF COMPILER24} {$DEFINE COMPILER24_UP} {$ENDIF} {$IFDEF COMPILER23} {$DEFINE COMPILER23_UP} {$ENDIF} {$IFDEF COMPILER22} {$DEFINE COMPILER22_UP} {$ENDIF} {$IFDEF COMPILER21} {$DEFINE COMPILER21_UP} {$ENDIF} {$IFDEF COMPILER20} {$DEFINE COMPILER20_UP} {$ENDIF} {$IFDEF COMPILER19} {$DEFINE COMPILER19_UP} {$ENDIF} {$IFDEF COMPILER18} {$DEFINE COMPILER18_UP} {$ENDIF} {$IFDEF COMPILER17} {$DEFINE COMPILER17_UP} {$ENDIF} {$IFDEF COMPILER16} {$DEFINE COMPILER16_UP} {$ENDIF} {$IFDEF COMPILER15} {$DEFINE COMPILER15_UP} {$ENDIF} {$IFDEF COMPILER14} {$DEFINE COMPILER14_UP} {$ENDIF} {$IFDEF COMPILER12} {$DEFINE COMPILER12_UP} {$ENDIF} {$IFDEF COMPILER11} {$DEFINE COMPILER11_UP} {$ENDIF} {$IFDEF COMPILER10} {$DEFINE COMPILER10_UP} {$ENDIF} {$IFDEF COMPILER9} {$DEFINE COMPILER9_UP} {$ENDIF} {$IFDEF COMPILER8} {$DEFINE COMPILER8_UP} {$ENDIF} {$IFDEF COMPILER7} {$DEFINE COMPILER7_UP} {$ENDIF} {$IFDEF COMPILER6} {$DEFINE COMPILER6_UP} {$ENDIF} {$IFDEF COMPILER5} {$DEFINE COMPILER5_UP} {$ENDIF} {$IFDEF COMPILER4} {$DEFINE COMPILER4_UP} {$ENDIF} {$IFDEF COMPILER3} {$DEFINE COMPILER3_UP} {$ENDIF} {$IFDEF COMPILER2} {$DEFINE COMPILER2_UP} {$ENDIF} {$IFDEF COMPILER25_UP} {$DEFINE COMPILER24_UP} {$ENDIF} {$IFDEF COMPILER24_UP} {$DEFINE COMPILER23_UP} {$ENDIF} {$IFDEF COMPILER23_UP} {$DEFINE COMPILER22_UP} {$ENDIF} {$IFDEF COMPILER22_UP} {$DEFINE COMPILER21_UP} {$ENDIF} {$IFDEF COMPILER21_UP} {$DEFINE COMPILER20_UP} {$ENDIF} {$IFDEF COMPILER20_UP} {$DEFINE COMPILER19_UP} {$ENDIF} {$IFDEF COMPILER19_UP} {$DEFINE COMPILER18_UP} {$ENDIF} {$IFDEF COMPILER18_UP} {$DEFINE COMPILER17_UP} {$ENDIF} {$IFDEF COMPILER17_UP} {$DEFINE COMPILER16_UP} {$ENDIF} {$IFDEF COMPILER16_UP} {$DEFINE COMPILER15_UP} {$ENDIF} {$IFDEF COMPILER15_UP} {$DEFINE COMPILER14_UP} {$ENDIF} {$IFDEF COMPILER14_UP} {$DEFINE COMPILER12_UP} {$ENDIF} {$IFDEF COMPILER12_UP} {$DEFINE COMPILER11_UP} {$ENDIF} {$IFDEF COMPILER11_UP} {$DEFINE COMPILER10_UP} {$ENDIF} {$IFDEF COMPILER10_UP} {$DEFINE COMPILER9_UP} {$ENDIF} {$IFDEF COMPILER9_UP} {$DEFINE COMPILER8_UP} {$ENDIF} {$IFDEF COMPILER8_UP} {$DEFINE COMPILER7_UP} {$ENDIF} {$IFDEF COMPILER7_UP} {$DEFINE COMPILER6_UP} {$ENDIF} {$IFDEF COMPILER6_UP} {$DEFINE COMPILER5_UP} {$ENDIF} {$IFDEF COMPILER5_UP} {$DEFINE COMPILER4_UP} {$ENDIF} {$IFDEF COMPILER4_UP} {$DEFINE COMPILER3_UP} {$ENDIF} {$IFDEF COMPILER3_UP} {$DEFINE COMPILER2_UP} {$ENDIF} {$IFDEF COMPILER2_UP} {$DEFINE COMPILER1_UP} {$ENDIF} { Unicode compiler directive for string type } // Delphi 2009+ uses UTF16, Lazarus 0.9.25+ uses UTF8 {$IF DEFINED(COMPILER12_UP) OR DEFINED(FPC)} {$DEFINE STRING_IS_UNICODE} {$IFEND} { Prefers usage of TCanvas methods instead of WinAPI mainly to avoid problems in Lazarus. } {$DEFINE USE_CANVAS_METHODS} { Register new image formats into TPicture. } {.$DEFINE REGISTER_PICTURE_FORMATS} { Allows to use WideWinProcs unit } {$IFDEF MSWINDOWS} {.$DEFINE USE_WIDEWINPROCS} {$ENDIF} {$DEFINE LAZARUS_HAS_DC_MAPPING} {$IF DEFINED(USE_WINAPI) OR DEFINED(LAZARUS_HAS_DC_MAPPING)} {$DEFINE USE_DC_MAPPING} {$IFEND} { Conditional defines for unit KGrids: } // we want TKGridObjectCell to be a descendant of TKGridAttrTextCell {$DEFINE TKGRIDOBJECTCELL_IS_TKGRIDATTRTEXTCELL} // we want TKGridObjectCell to be a descendant of TKGridTextCell {.$DEFINE TKGRIDOBJECTCELL_IS_TKGRIDTEXTCELL} // use JCLUnicode (only for TKGridAxisItem.Assign(Source: TWideStrings);) {.$DEFINE TKGRID_USE_JCL} { Conditional defines for unit KDBGrids: } // we want to use TKDBGrid {$DEFINE TKDBGRID_USE} // we want TKDBGridCell to be a descendant of TKGridAttrTextCell {.$DEFINE TKDBGRIDCELL_IS_TKGRIDATTRTEXTCELL} // PngImage can be used {$IF DEFINED(FPC) OR DEFINED(COMPILER12_UP)} {$DEFINE USE_PNG_SUPPORT} {$IFEND} {$ENDIF ~KCONTROLS_INC} tomboy-ng_0.34-1/kcontrols/source/keditcommon.pas0000644000175000017500000006166414125207534021767 0ustar dbannondbannon{ @abstract(This file is part of the KControls component suite for Delphi and Lazarus.) @author(Tomas Krysl) Copyright (c) 2020 Tomas Krysl

License:
This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } unit keditcommon; // lowercase name because of Lazarus/Linux {$include kcontrols.inc} {$WEAKPACKAGEUNIT ON} interface uses {$IFDEF FPC} LCLType, LCLIntf, LCLProc, LMessages, LResources, {$IFDEF MSWINDOWS}Windows,{$ENDIF} {$ELSE} Windows, Messages, {$ENDIF} SysUtils, Classes, ClipBrd, Graphics, Controls, ComCtrls, Forms, StdCtrls, KFunctions; const cCharMappingSize = 256; type { Declares possible values for the edit control commands. } TKEditCommand = ( { No command } ecNone, { Move caret left one char } ecLeft, { Move caret right one char } ecRight, { Move caret up one line } ecUp, { Move caret down one line } ecDown, { Move caret to beginning of line } ecLineStart, { Move caret to end of line } ecLineEnd, { Move caret left one word } ecWordLeft, { Move caret right one word } ecWordRight, { Move caret up one page } ecPageUp, { Move caret down one page } ecPageDown, { Move caret left one page } ecPageLeft, { Move caret right one page } ecPageRight, { Move caret to top of page } ecPageTop, { Move caret to bottom of page } ecPageBottom, { Move caret to absolute beginning } ecEditorTop, { Move caret to absolute end } ecEditorBottom, { Move caret to specific coordinates, Data = ^TPoint } ecGotoXY, { Move caret left one char } ecSelLeft, { Move caret right one char, affecting selection } ecSelRight, { Move caret up one line, affecting selection } ecSelUp, { Move caret down one line, affecting selection } ecSelDown, { Move caret to beginning of line, affecting selection } ecSelLineStart, { Move caret to end of line, affecting selection } ecSelLineEnd, { Move caret left one word, affecting selection } ecSelWordLeft, { Move caret right one word, affecting selection } ecSelWordRight, { Move caret up one page, affecting selection } ecSelPageUp, { Move caret down one page, affecting selection } ecSelPageDown, { Move caret left one page, affecting selection } ecSelPageLeft, { Move caret right one page, affecting selection } ecSelPageRight, { Move caret to top of page, affecting selection } ecSelPageTop, { Move caret to bottom of page, affecting selection } ecSelPageBottom, { Move caret to absolute beginning, affecting selection } ecSelEditorTop, { Move caret to absolute end, affecting selection } ecSelEditorBottom, { Move caret to specific coordinates, affecting selection, Data = ^TPoint } ecSelGotoXY, { Scroll up one line leaving caret position unchanged } ecScrollUp, { Scroll down one line leaving caret position unchanged } ecScrollDown, { Scroll left one char leaving caret position unchanged } ecScrollLeft, { Scroll right one char leaving caret position unchanged } ecScrollRight, { Scroll to center the caret position within client area } ecScrollCenter, { Undo previous action } ecUndo, { Redo last undone action } ecRedo, { Copy selection to clipboard } ecCopy, { Cut selection to clipboard } ecCut, { Paste clipboard to current position } ecPaste, { Insert character at current position, Data = ^Char } ecInsertChar, { Insert digits (digit string) at current position, Data = ^string (must contain digits only), TKCustomHexEditor only } ecInsertDigits, { Insert string (multiple characters) at current position, Data = ^string } ecInsertString, { Insert new line } ecInsertNewLine, { Delete last character (i.e. backspace key) } ecDeleteLastChar, { Delete character at caret (i.e. delete key) } ecDeleteChar, { Delete from caret to beginning of line } ecDeleteBOL, { Delete from caret to end of line } ecDeleteEOL, { Delete current line } ecDeleteLine, { Select everything } ecSelectAll, { Delete everything } ecClearAll, { Delete selection (no digit selection), TKCustomHexEditor only } ecClearIndexSelection, { Delete selection (digit selection as well) } ecClearSelection, { Search for text/digits } ecSearch, { Replace text/digits } ecReplace, { Set insert mode } ecInsertMode, { Set overwrite mode } ecOverwriteMode, { Toggle insert/overwrite mode } ecToggleMode, { Adjust editor when getting input focus } ecGotFocus, { Adjust editor when losing input focus } ecLostFocus ); { Declares possible values for control's DisabledDrawStyle property. } TKEditDisabledDrawStyle = ( { The lines will be painted with brighter colors when editor is disabled. } eddBright, { The lines will be painted with gray text and white background when editor is disabled. } eddGrayed, { The lines will be painted normally when editor is disabled. } eddNormal ); { @abstract(Declares the keystroke information structure for the Key member of the @link(TKEditCommandAssignment) structure) } TKEditKey = record Key: Word; Shift: TShiftState; end; { @abstract(Declares the @link(TKEditKeyMapping) array item) } TKEditCommandAssignment = record Key: TKEditKey; Command: TKEditCommand; end; TKEditCommandMap = array of TKEditCommandAssignment; { @abstract(Declares OnDropFiles event handler) } TKEditDropFilesEvent = procedure(Sender: TObject; X, Y: integer; Files: TStrings) of object; { Declares key mapping class for the KeyMapping property } TKEditKeyMapping = class(TObject) private function GetAssignment(AIndex: Integer): TKEditCommandAssignment; function GetKey(AIndex: TKEditCommand): TKEditKey; procedure SetKey(AIndex: TKEditCommand; const AValue: TKEditKey); protected FMap: TKEditCommandMap; procedure CreateMap; virtual; public constructor Create; procedure Assign(Source: TKEditKeyMapping); virtual; procedure AddKey(Command: TKEditCommand; Key: Word; Shift: TShiftState); class function EmptyMap: TKEditCommandAssignment; function FindCommand(AKey: Word; AShift: TShiftState): TKEditCommand; property Assignment[Index: Integer]: TKEditCommandAssignment read GetAssignment; property Key[AIndex: TKEditCommand]: TKEditKey read GetKey write SetKey; property Map: TKEditCommandMap read FMap; end; { Declares character mapping array for the edit control's CharMapping property } TKEditCharMapping = array of AnsiChar; { Pointer to @link(TKEditCharMapping) } PKEditCharMapping = ^TKEditCharMapping; { Declares options - possible values for the edit control's Options property } TKEditOption = ( { The editor will receive dropped files } eoDropFiles, { The blinking caret should be disabled } eoDisableCaret, { All undo/redo operations of the same kind will be grouped together } eoGroupUndo, { The editor allows undo/redo operations after the edit control's Modified property has been set to False } eoUndoAfterSave, { TKMemo only: Will draw each character separately. } eoDrawSingleChars, { TKMemo only: Use ScrollWindowEx to scroll the control. } eoScrollWindow, { TKMemo only: show formatting markers. } eoShowFormatting, { TKMemo only: acquire TAB characters. } eoWantTab, { TKMemo only: Will wrap text at each character. } eoWrapSingleChars ); { Options can be arbitrary combined } TKEditOptions = set of TKEditOption; { Declares possible values for the Action parameter in the @link(TKEditReplaceTextEvent) event } TKEditReplaceAction = ( { Quit replace sequence } eraCancel, { Replace this occurence } eraYes, { Don't replace this occurence } eraNo, { Replace all following occurences without prompting } eraAll ); { @abstract(Declares OnReplaceText event handler) } TKEditReplaceTextEvent = procedure(Sender: TObject; const TextToFind, TextToReplace: string; var Action: TKEditReplaceAction) of object; { Declares possible values for the ErrorReason member of the @link(TKEditSearchData) structure } TKEditSearchError = ( { No error occured } eseOk, { There is a character in the search string that cannot be interpreted as hexadecimal digits} eseNoDigitsFind, { There is a character in the replace string that cannot be interpreted as hexadecimal digits} eseNoDigitsReplace, { No other search string found } eseNoMatch ); { Declares search options - possible values for the Options member of the @link(TKEditSearchData) structure } TKEditSearchOption = ( { Replace all occurences } esoAll, { Search backwards } esoBackwards, { Search entire scope instead from current caret position } esoEntireScope, { Include to identify search - this element will be automatically cleared to provide the @link(TKEditSearchData) structure for additional search } esoFirstSearch, { Match case when a binary search should be executed } esoMatchCase, { Prompt user before a string is about to be replaced. This assumes @link(OnReplaceText) is assigned } esoPrompt, { Search the current selection only } esoSelectedOnly, { Treat the supplied search and/or replace strings as hexadecimal sequence. When the search string contains a character that cannot be interpreted as hexadecimal digit, the execution stops and @link(eseNoDigitsFind) error will be returned. Similarly, @link(eseNoDigitsReplace) errors will be returned on invalid replace string } esoTreatAsDigits, { Internal option - don't modify } esoWereDigits ); { Search options can be arbitrary combined } TKEditSearchOptions = set of TKEditSearchOption; { @abstract(Declares the search/replace description structure for the @link(ecSearch) and @link(ecReplace) commands) } TKEditSearchData = record ErrorReason: TKEditSearchError; Options: TKEditSearchOptions; SelStart, SelEnd: Int64; TextToFind, TextToReplace: string; end; { Pointer to @link(TKEditSearchData) } PKEditSearchData = ^TKEditSearchData; const { Default value for the @link(TKCustomHexEditor.DisabledDrawStyle) property } cEditDisabledDrawStyleDef = eddBright; { Returns default key mapping structure } function CreateDefaultKeyMapping: TKEditKeyMapping; { Returns default char mapping structure } function DefaultCharMapping: TKEditCharMapping; { Returns default search data structure } function DefaultSearchData: TKEditSearchData; { Returns True if focused window is some text editing window, such as TEdit. } function EditIsFocused(AMustAllowWrite: Boolean): Boolean; { Returns True if some text editing window is focused and contains a selectable text. } function EditFocusedTextCanCopy: Boolean; { Returns True if some non-readonly text editing window is focused and contains a selectable text. } function EditFocusedTextCanCut: Boolean; { Returns True if some non-readonly text editing window is focused. } function EditFocusedTextCanDelete: Boolean; { Returns True if some non-readonly text editing window is focused and clipboard is not empty. } function EditFocusedTextCanPaste: Boolean; { Returns True if the focused text editing window can perform an undo operation. } function EditFocusedTextCanUndo: Boolean; { Performs an undo operation on the focused text editing window. } procedure EditUndoFocused; { Performs a delete operation on the focused text editing window. } procedure EditDeleteFocused; { Performs a clipboard cut operation on the focused text editing window. } procedure EditCutFocused; { Performs a clipboard copy operation on the focused text editing window. } procedure EditCopyFocused; { Performs a clipboard paste operation on the focused text editing window. } procedure EditPasteFocused; { Performs a select all operation on the focused text editing window. } procedure EditSelectAllFocused; function PixelsPerInchX(AHandle: HWND): Integer; function PixelsPerInchY(AHandle: HWND): Integer; function TwipsPerPixelX(AHandle: HWND): Double; function TwipsPerPixelY(AHandle: HWND): Double; function PixelsToPoints(AValue: Integer; ADPI: Integer): Double; function PointsToPixels(AValue: Double; ADPI: Integer): Integer; function TwipsToPoints(AValue: Integer; ADPI: Integer): Double; function PointsToTwips(AValue: Double; ADPI: Integer): Integer; { Converts binary data into text using given character mapping. } function BinaryToText(Buffer: PBytes; SelStart, SelEnd: Int64; CharMapping: PKEditCharMapping): AnsiString; function ReplaceNonprintableCharacters(const AText: AnsiString; AMapping: TKEditCharMapping = nil): AnsiString; implementation uses KControls, KMemo; function PixelsPerInchX(AHandle: HWND): Integer; var DC: HDC; begin DC := GetDC(AHandle); try Result := GetDeviceCaps(DC, LOGPIXELSX); finally ReleaseDC(AHandle, DC); end; end; function PixelsPerInchY(AHandle: HWND): Integer; var DC: HDC; begin DC := GetDC(AHandle); try Result := GetDeviceCaps(DC, LOGPIXELSY); finally ReleaseDC(AHandle, DC); end; end; function TwipsPerPixelX(AHandle: HWND): Double; begin Result := 1440 / PixelsPerInchX(AHandle); end; function TwipsPerPixelY(AHandle: HWND): Double; begin Result := 1440 / PixelsPerInchY(AHandle); end; function PixelsToPoints(AValue, ADPI: Integer): Double; begin Result := AValue * 72 / ADPI; end; function PointsToPixels(AValue: Double; ADPI: Integer): Integer; begin Result := Round(AValue * ADPI / 72); end; function TwipsToPoints(AValue: Integer; ADPI: Integer): Double; begin Result := AValue * 1440 / ADPI; end; function PointsToTwips(AValue: Double; ADPI: Integer): Integer; begin Result := Round(AValue * ADPI / 1440); end; function BinaryToText(Buffer: PBytes; SelStart, SelEnd: Int64; CharMapping: PKEditCharMapping): AnsiString; var I: Integer; begin if SelEnd > SelStart then begin SetLength(Result, SelEnd - SelStart); System.Move(Buffer[SelStart], Result[1], SelEnd - SelStart); if CharMapping <> nil then for I := 1 to Length(Result) do Result[I] := CharMapping^[Byte(Result[I])]; end else Result := ''; end; function ReplaceNonprintableCharacters(const AText: AnsiString; AMapping: TKEditCharMapping = nil): AnsiString; var I: Integer; begin if AMapping = nil then AMapping := DefaultCharMapping; SetLength(Result, Length(AText)); for I := 1 to Length(AText) do Result[I] := AMapping[Ord(AText[I])]; end; function CreateDefaultKeyMapping: TKEditKeyMapping; begin Result := TKEditKeyMapping.Create; end; function DefaultCharMapping: TKEditCharMapping; var I: Integer; begin SetLength(Result, cCharMappingSize); for I := 0 to cCharMappingSize - 1 do if (I < $20) or (I >= $80) then Result[I] := '.' else Result[I] := AnsiChar(I); end; function DefaultSearchData: TKEditSearchData; begin with Result do begin ErrorReason := eseOk; Options := [esoAll, esoFirstSearch, esoPrompt, esoTreatAsDigits]; SelStart := 0; SelEnd := 0; TextToFind := ''; TextToReplace := ''; end; end; {$IFDEF MSWINDOWS} function EditFocusedHandle(AMustAllowWrite: Boolean): THandle; var Len: Integer; Wnd: HWND; S: string; C: TWinControl; begin Result := 0; Wnd := GetFocus; C := FindControl(Wnd); if (C <> nil) and (C is TCustomEdit) and (not AMustAllowWrite or not TEdit(C).ReadOnly) or (C is TCustomMemo) and (not AMustAllowWrite or not TMemo(C).ReadOnly) or (C is TComboBox) and (TComboBox(C).Style in [csSimple, csDropDown]) {$IFnDEF FPC} or (C is TRichEdit) and (not AMustAllowWrite or not TRichEdit(C).ReadOnly) {$ENDIF} or (C is TKCustomMemo) and (not AMustAllowWrite or not TKCustomMemo(C).ReadOnly) then Result := Wnd else begin SetLength(S, 100); Len := GetClassName(Wnd, PChar(S), 100); if Len > 0 then begin SetLength(S, Len); S := UpperCase(S); if (S = 'EDIT') then Result := Wnd; end; end; end; {$ENDIF} function EditIsFocused(AMustAllowWrite: Boolean): Boolean; {$IFDEF MSWINDOWS} begin Result := EditFocusedHandle(AMustAllowWrite) <> 0; end; {$ELSE} begin // can this be implemented somehow? Result := False; end; {$ENDIF} function EditFocusedTextHasSelection(AMustAllowWrite: Boolean): Boolean; {$IFDEF MSWINDOWS} var A, B: Integer; Wnd: THandle; begin Wnd := EditFocusedHandle(AMustAllowWrite); if Wnd <> 0 then begin SendMessage(Wnd, EM_GETSEL, WParam(@A), LParam(@B)); Result := A <> B; end else Result := False; end; {$ELSE} begin // can this be implemented somehow? Result := False; end; {$ENDIF} function EditFocusedTextCanCopy: Boolean; begin Result := EditFocusedTextHasSelection(False); end; function EditFocusedTextCanCut: Boolean; begin Result := EditFocusedTextHasSelection(True); end; function EditFocusedTextCanDelete: Boolean; begin Result := EditIsFocused(True); end; function EditFocusedTextCanPaste: Boolean; begin Result := EditIsFocused(True) and ClipBoard.HasFormat(CF_TEXT); end; function EditFocusedTextCanUndo: Boolean; begin {$IFDEF MSWINDOWS} Result := LongBool(SendMessage(GetFocus, EM_CANUNDO, 0, 0)); {$ELSE} // can this be implemented somehow? Result := False; {$ENDIF} end; procedure EditUndoFocused; begin {$IFDEF MSWINDOWS} SendMessage(GetFocus, WM_UNDO, 0, 0); {$ENDIF} end; procedure EditDeleteFocused; begin SendMessage(GetFocus, LM_CLEAR, 0, 0); end; procedure EditCutFocused; begin SendMessage(GetFocus, LM_CUT, 0, 0); end; procedure EditCopyFocused; begin SendMessage(GetFocus, LM_COPY, 0, 0); end; procedure EditPasteFocused; begin SendMessage(GetFocus, LM_PASTE, 0, 0); end; procedure EditSelectAllFocused; begin {$IFDEF MSWINDOWS} SendMessage(GetFocus, EM_SETSEL, 0, -1); {$ENDIF} end; { TKEditKeyMapping } constructor TKEditKeyMapping.Create; begin FMap := nil; CreateMap; end; procedure TKEditKeyMapping.Assign(Source: TKEditKeyMapping); begin FMap := Copy(Source.Map); end; procedure TKEditKeyMapping.CreateMap; begin AddKey(ecLeft, VK_LEFT, []); AddKey(ecRight, VK_RIGHT, []); AddKey(ecInsertNewLine, VK_RETURN, []); AddKey(ecUp, VK_UP, []); AddKey(ecDown, VK_DOWN, []); AddKey(ecLineStart, VK_HOME, []); AddKey(ecLineEnd, VK_END, []); AddKey(ecPageUp, VK_PRIOR, []); AddKey(ecPageDown, VK_NEXT, []); AddKey(ecPageLeft, VK_LEFT, [ssCtrl, ssAlt]); AddKey(ecPageRight, VK_RIGHT, [ssCtrl, ssAlt]); AddKey(ecPageTop, VK_PRIOR, [ssCtrl]); AddKey(ecPageBottom, VK_NEXT, [ssCtrl]); AddKey(ecEditorTop, VK_HOME, [ssCtrl]); AddKey(ecEditorBottom, VK_END, [ssCtrl]); AddKey(ecSelLeft, VK_LEFT, [ssShift]); AddKey(ecSelRight, VK_RIGHT, [ssShift]); AddKey(ecSelUp, VK_UP, [ssShift]); AddKey(ecSelDown, VK_DOWN, [ssShift]); AddKey(ecSelLineStart, VK_HOME, [ssShift]); AddKey(ecSelLineEnd, VK_END, [ssShift]); AddKey(ecSelPageUp, VK_PRIOR, [ssShift]); AddKey(ecSelPageDown, VK_NEXT, [ssShift]); AddKey(ecSelPageLeft, VK_LEFT, [ssShift, ssCtrl, ssAlt]); AddKey(ecSelPageRight, VK_RIGHT, [ssShift, ssCtrl, ssAlt]); AddKey(ecSelPageTop, VK_PRIOR, [ssShift, ssCtrl]); AddKey(ecSelPageBottom, VK_NEXT, [ssShift, ssCtrl]); AddKey(ecSelEditorTop, VK_HOME, [ssShift, ssCtrl]); AddKey(ecSelEditorBottom, VK_END, [ssShift, ssCtrl]); AddKey(ecSelWordLeft, VK_LEFT, [ssShift, ssCtrl]); AddKey(ecSelWordRight, VK_RIGHT, [ssShift, ssCtrl]); AddKey(ecScrollUp, VK_UP, [ssCtrl]); AddKey(ecScrollDown, VK_DOWN, [ssCtrl]); AddKey(ecWordLeft, VK_LEFT, [ssCtrl]); AddKey(ecWordRight, VK_RIGHT, [ssCtrl]); AddKey(ecScrollLeft, VK_LEFT, [ssShift, ssAlt]); AddKey(ecScrollRight, VK_RIGHT, [ssShift, ssAlt]); AddKey(ecScrollCenter, VK_RETURN, [ssCtrl]); AddKey(ecUndo, ord('Z'), [ssCtrl]); AddKey(ecUndo, VK_BACK, [ssAlt]); AddKey(ecRedo, ord('Z'), [ssShift, ssCtrl]); AddKey(ecRedo, VK_BACK, [ssShift, ssAlt]); AddKey(ecCopy, ord('C'), [ssCtrl]); AddKey(ecCopy, VK_INSERT, [ssCtrl]); AddKey(ecCut, ord('X'), [ssCtrl]); AddKey(ecCut, VK_DELETE, [ssShift]); AddKey(ecPaste, ord('V'), [ssCtrl]); AddKey(ecPaste, VK_INSERT, [ssShift]); AddKey(ecDeleteLastChar, VK_BACK, []); AddKey(ecDeleteLastChar, VK_BACK, [ssShift]); AddKey(ecDeleteChar, VK_DELETE, []); AddKey(ecDeleteBOL, ord('X'), [ssCtrl,ssShift]); AddKey(ecDeleteEOL, ord('Y'), [ssCtrl,ssShift]); AddKey(ecDeleteLine, ord('Y'), [ssCtrl]); AddKey(ecSelectAll, ord('A'), [ssCtrl]); AddKey(ecToggleMode, VK_INSERT, []); {$IFDEF DARWIN} // MAC specific, what I knew or guessed and worked for me AddKey(ecLineStart, VK_LEFT, [ssMeta]); AddKey(ecLineEnd, VK_RIGHT, [ssMeta]); AddKey(ecSelLineStart, VK_LEFT, [ssMeta, ssShift]); AddKey(ecSelLineEnd, VK_RIGHT, [ssMeta, ssShift]); AddKey(ecSelPageTop, VK_PRIOR, [ssMeta, ssShift]); AddKey(ecSelPageBottom, VK_NEXT, [ssMeta, ssShift]); AddKey(ecCopy, ord('C'), [ssMeta]); AddKey(ecCut, ord('X'), [ssMeta]); AddKey(ecPaste, ord('V'), [ssMeta]); {$ENDIF} end; class function TKEditKeyMapping.EmptyMap: TKEditCommandAssignment; begin Result.Command := ecNone; Result.Key.Key := 0; Result.Key.Shift := []; end; procedure TKEditKeyMapping.AddKey(Command: TKEditCommand; Key: Word; Shift: TShiftState); var I: Integer; begin I := Length(FMap); SetLength(FMap, I + 1); FMap[I].Command := Command; FMap[I].Key.Key := Key; FMap[I].Key.Shift := Shift; end; function TKEditKeyMapping.FindCommand(AKey: Word; AShift: TShiftState): TKEditCommand; var I: Integer; Key: TKEditKey; begin Result := ecNone; for I := 0 to Length(FMap) - 1 do begin Key := FMap[I].Key; if (Key.Key = AKey) and (Key.Shift = AShift) then begin Result := FMap[I].Command; Exit; end; end; end; function TKEditKeyMapping.GetKey(AIndex: TKEditCommand): TKEditKey; var I: Integer; begin Result.Key := 0; Result.Shift := []; for I := 0 to Length(FMap) - 1 do if FMap[I].Command = AIndex then begin Result := FMap[I].Key; Exit; end; end; function TKEditKeyMapping.GetAssignment(AIndex: Integer): TKEditCommandAssignment; begin if (AIndex >= 0) and (AIndex < Length(FMap)) then Result := FMap[AIndex] else Result := EmptyMap; end; procedure TKEditKeyMapping.SetKey(AIndex: TKEditCommand; const AValue: TKEditKey); var I: Integer; begin for I := 0 to Length(FMap) - 1 do if FMap[I].Command = AIndex then begin FMap[I].Key := AValue; Exit; end; end; end. tomboy-ng_0.34-1/kcontrols/source/kres.pas0000644000175000017500000003116614125207534020414 0ustar dbannondbannon{ @abstract(This file is part of the KControls component suite for Delphi and Lazarus.) @author(Tomas Krysl) Copyright (c) 2020 Tomas Krysl

License:
This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } unit kres; // lowercase name because of Lazarus/Linux {$include kcontrols.inc} {$WEAKPACKAGEUNIT ON} interface { Because the resourcestring concept used in Delphi is not always the best way to localize an application, I decided to implement routines which allow to modify the resourcestrings dynamically at runtime. They allow for direct localization e.g. from XML file without the need of the standard localization scheme for resourcestrings. Especially if you need to translate only some of the strings it is much easier approach. } { Standard resourcestrings localized to english by default } resourcestring // KGraphics texts sGrAlphaBitmap = 'KControls alpha bitmap'; // KDialogs texts sBrowseDirectory = 'Choose directory:'; // KEdits texts sEDBadSubDirName = 'The invalid subdirectory "%s" has been replaced with "%s".'; sEDCurrentDirAdded = 'Current path added to path "%s".'; sEDBadDir = 'The directory "%s" can be invalid.'; sEDBadDirCorr = 'Invalid or incomplete directory "%s" has been replaced with "%s".'; sEDBadPath = 'The path or file name "%s" can be incomplete or invalid.'; sEDBadPathCorr = 'Invalid path or file name "%s" has been replaced with "%s".'; sEDMissingFileName = 'Missing file name.'; sEDNoExistingDir = 'The directory "%s" doesn''t exist.'; sEDNoExistingPath = 'The file "%s" doesn''t exist.'; sEDFormatNotAccepted = 'The text either doesn''t represent a numeral or the numeric format cannot be accepted.'; sEDBadFloatValueAsStr = 'The text is not a float value in the range from %s to %s. Value corrected to %s.'; sEDBadIntValueAsStr = 'The text is not a decimal value in the range from %s to %s. Value corrected to %s.'; sEDBadHexValueAsStr = 'The text is not a hexadecimal value in the range from %s to %s. Value corrected to %s.'; sEDClipboardFmtNotAccepted = 'The current clipboard text cannot be accepted.'; sEDBrowse = 'Browse ...'; sEDAllFiles = 'All files (*.*)|*.*'; // KGraphics texts sGDIError = 'GDI object could not be created.'; sErrGraphicsLoadFromResource = 'Graphics could not be loaded from resource.'; // KHexEditor texts sHEAddressText = 'Address area text'; sHEAddressBkGnd = 'Address area background'; sHEBkGnd = 'Editor background'; sHEDigitTextEven = 'Digit area even column'; sHEDigitTextOdd = 'Digit area odd column'; sHEDigitBkgnd = 'Digit area background'; sHEHorzLines = 'Horizontal lines'; sHEInactiveCaretBkGnd = 'Inactive caret background'; sHEInactiveCaretSelBkGnd = 'Selected inactive caret background'; sHEInactiveCaretSelText = 'Selected inactive caret text'; sHEInactiveCaretText = 'Inactive caret text'; sHELinesHighLight = 'Lines highlight'; sHESelBkGnd = 'Selection background'; sHESelBkGndFocused = 'Focused selection background'; sHESelText = 'Selection text'; sHESelTextFocused = 'Focused selection text'; sHESeparators = 'Area separating lines'; sHETextText = 'Text area text'; sHETextBkGnd = 'Text area background'; sHEVertLines = 'Vertical lines'; // KIcons texts sIconIcons = 'Icons'; sIconCursors = 'Cursors'; sIconAllocationError = 'Error while allocating icon data'; sIconBitmapError = 'Invalid icon bitmap handles'; sIconFormatError = 'Invalid icon format'; sIconResourceError = 'Invalid icon resource'; sIconIndexError = 'Invalid icon resource index'; sIconInvalidModule = 'Invalid module or no icon resources'; sIconResizingError = 'Error while resizing icon'; sIconAssocResolveError = 'Error while resolving associated icon'; // KLog texts sLogError = 'Error'; sLogWarning = 'Warning'; sLogNote = 'Note'; sLogHint = 'Hint'; sLogInfo = 'Info'; sLogInputError = 'Input error'; sLogIOError = 'IO error'; // KMessagebox texts sMsgBoxYes = '&Yes'; sMsgBoxNo = '&No'; sMsgBoxOK = '&OK'; sMsgBoxCancel = 'Cancel'; sMsgBoxClose = '&Close'; sMsgBoxAbort = 'A&bort'; sMsgBoxRetry = '&Retry'; sMsgBoxIgnore = '&Ignore'; sMsgBoxAll = '&All'; sMsgBoxNoToAll = 'Non&e'; sMsgBoxYesToAll = 'Ye&s to all'; sMsgBoxHelp = '&Help'; // KPrinterSetup texts sPSPrinterSetup = 'Printer setup'; sPSAllPages = 'All pages (%d)'; sPSErrPrintSetup = 'Print setup error'; sPSErrNoPrinterInstalled = 'No printer is installed on this computer.'; sPSErrNoDefaultPrinter = 'No default printer selected, cannot continue. Please select default printer.'; sPSErrPrinterUnknown = 'Unknown error in printer interface. Please restart application and try again.'; sPSErrPrinterConfiguration = 'Printer configuration not supported.'; // KControlsDesign texts sInvalidGraphicFormat = 'Invalid graphic format.'; // KDBGrids texts sDataSetUnidirectional = 'Cannot use KDBGrid with a unidirectional dataset.'; // KMemoRTF texts sErrMemoLoadFromRTF = 'Error while reading RTF file.'; sErrMemoLoadImageFromRTF = 'Error while loading image from RTF file.'; sErrMemoSaveToRTF = 'Error while saving RTF file.'; // KMemoFrame texts sAppError = 'Application error'; sAppQuery = 'Application query'; sMemoDefaultFileName = 'document'; sQueryFileSave = 'File "%s" has been changed. Do you want to save it?'; sErrMemoLoadFromFile = 'Error while loading file "%s".'; sErrMemoSaveToFile = 'Error while saving file "%s".'; sMemoSampleTextBox = 'Enter the text box contents. The textbox can be placed anywhere in the document.'; { Localize given resourcestring directly. Usage: ResMod(@sYourResourceString, 'New text'); Note: Text passed to NewValue must persist through the entire application lifetime under Delphi, as only its pointer is taken! } procedure ResMod(Res: PResStringRec; const NewValue: string); { Localize all resourcestrings to Czech language. } procedure LocalizeToCzech; implementation {$IFnDEF FPC} uses Windows, KFunctions; {$ENDIF} {$IFDEF FPC} type PResModRec = ^TResModRec; TResModRec = record DefStr: string; NewStr: string; end; function ResModIterator(Name, Value: AnsiString; Hash: Longint; arg:pointer): AnsiString; begin if Value = PResModRec(arg).DefStr then Result := PResModRec(arg).NewStr else Result := ''; end; procedure ResMod(Res: PResStringRec; const NewValue: string); var RM: TResModRec; begin if (Res <> nil) and (Res^ <> '') then begin RM.DefStr := Res^; RM.NewStr := NewValue; SetResourceStrings(ResModIterator, @RM); end; end; {$ELSE} procedure ResMod(Res: PResStringRec; const NewValue: string); var OldProtect: LongWord; OK: Boolean; begin if (Res <> nil) and (Res.Module <> nil) then begin OK := VirtualProtect(Res, Sizeof(TResStringRec), PAGE_EXECUTE_READWRITE, @oldProtect); if OK then begin {$IFDEF COMPILER16_UP} // new code for Delphi XE2 and later Res.Identifier := NativeUInt(NewValue); {$ELSE} Res.Identifier := LongInt(NewValue); {$ENDIF} VirtualProtect(Res, SizeOf(TResStringRec), oldProtect, @oldProtect); end; end; end; {$ENDIF} procedure LocalizeToCzech; begin // KGraphics texts ResMod(@sGrAlphaBitmap, 'Alpha bitmap KControls'); // KDialogs texts ResMod(@sBrowseDirectory, 'Vyberte sloku:'); // KEdits texts ResMod(@sEDBadSubDirName, 'Neplatn podsloka "%s" byla nahrazena "%s".'); ResMod(@sEDCurrentDirAdded, 'Aktuln cesta byla pidna k cest "%s".'); ResMod(@sEDBadDir, 'Sloka "%s" me bt neplatn.'); ResMod(@sEDBadDirCorr, 'Neplatn nebo nekompletn sloka "%s" byla nahrazena "%s".'); ResMod(@sEDBadPath, 'Cesta nebo soubor "%s" nemus bt kompletn nebo platn.'); ResMod(@sEDBadPathCorr, 'Neplatn cesta nebo soubor "%s" byl(a) nahrazen(a) "%s".'); ResMod(@sEDMissingFileName, 'Chyb nzev souboru.'); ResMod(@sEDNoExistingDir, 'Sloka "%s" neexistuje.'); ResMod(@sEDNoExistingPath, 'Soubor "%s" neexistuje.'); ResMod(@sEDFormatNotAccepted, 'Text nen slem nebo seln formt nelze pijmout.'); ResMod(@sEDBadFloatValueAsStr, 'Text nen relnm slem v rozsahu od %s do %s. Hodnota opravena na %s.'); ResMod(@sEDBadIntValueAsStr, 'Text nen celm slem v rozsahu od %s do %s. Hodnota opravena na %s.'); ResMod(@sEDBadHexValueAsStr, 'Text nen hexadecimlnm slem od %s do %s. Hodnota opravena na %s.'); ResMod(@sEDClipboardFmtNotAccepted, 'Text ze schrnky nelze pijmout.'); ResMod(@sEDBrowse, 'Prochzet...'); ResMod(@sEDAllFiles, 'Vechny soubory (*.*)|*.*'); // KGraphics texts ResMod(@sGDIError, 'Objekt GDI nelze vytvoit.'); // KHexEditor texts ResMod(@sHEAddressText, 'Ps adresy - text'); ResMod(@sHEAddressBkGnd, 'Ps adresy - pozad'); ResMod(@sHEBkGnd, 'Pozad editoru'); ResMod(@sHEDigitTextEven, 'Ps slic sud sloupec - text'); ResMod(@sHEDigitTextOdd, 'Ps slic lich sloupec - text'); ResMod(@sHEDigitBkgnd, 'Ps slic - pozad'); ResMod(@sHEHorzLines, 'Vodorovn linky'); ResMod(@sHEInactiveCaretBkGnd, 'Neaktivn kurzor - pozad'); ResMod(@sHEInactiveCaretSelBkGnd, 'Neaktivn kurzor pozad vbru'); ResMod(@sHEInactiveCaretSelText, 'Neaktivn kurzor text vbru'); ResMod(@sHEInactiveCaretText, 'Neaktivn kurzor - text'); ResMod(@sHELinesHighLight, 'Zvraznn dk'); ResMod(@sHESelBkGnd, 'Pozad vbru'); ResMod(@sHESelBkGndFocused, 'Pozad aktivnho vbru'); ResMod(@sHESelText, 'Text vbru'); ResMod(@sHESelTextFocused, 'Text aktivnho vbru'); ResMod(@sHESeparators, 'Oddlovac linky ps'); ResMod(@sHETextText, 'Ps textu - text'); ResMod(@sHETextBkGnd, 'Ps textu - pozad'); ResMod(@sHEVertLines, 'Svisl linky'); // KIcons texts ResMod(@sIconIcons, 'Ikony'); ResMod(@sIconCursors, 'Kurzory'); ResMod(@sIconAllocationError, 'Chyba pi alokovn dat ikony'); ResMod(@sIconBitmapError, 'Neplatn popisovae bitmap ikony'); ResMod(@sIconFormatError, 'Neplatn formt ikony'); ResMod(@sIconResourceError, 'Neplatn zdroj ikony'); ResMod(@sIconIndexError, 'Neplatn index zdroje ikony'); ResMod(@sIconInvalidModule, 'Neplatn modul nebo chyb zdroje ikon'); ResMod(@sIconResizingError, 'Chyba pi zmn velikosti ikony'); ResMod(@sIconAssocResolveError, 'Chyba pi nahrvn asociovan ikony'); // KLog texts ResMod(@sLogError, 'Chyba'); ResMod(@sLogWarning, 'Varovn'); ResMod(@sLogNote, 'Poznmka'); ResMod(@sLogHint, 'Npovda'); ResMod(@sLogInfo, 'Informace'); ResMod(@sLogInputError, 'Chyba zadn'); ResMod(@sLogIOError, 'Chyba IO operace'); // KMessagebox texts ResMod(@sMsgBoxYes, '&Ano'); ResMod(@sMsgBoxNo, '&Ne'); ResMod(@sMsgBoxOK, '&OK'); ResMod(@sMsgBoxCancel, 'Storno'); ResMod(@sMsgBoxClose, 'Za&vt'); ResMod(@sMsgBoxAbort, '&Peruit'); ResMod(@sMsgBoxRetry, '&Znovu'); ResMod(@sMsgBoxIgnore, '&Ignorovat'); ResMod(@sMsgBoxAll, 'V&e'); ResMod(@sMsgBoxNoToAll, 'Ni&c'); ResMod(@sMsgBoxYesToAll, 'Ano pro ve'); ResMod(@sMsgBoxHelp, 'Npovda'); // KPrinterSetup texts ResMod(@sPSPrinterSetup, 'Nasteven tiskrny'); ResMod(@sPSAllPages, 'Vechny strnky (%d)'); ResMod(@sPSErrPrintSetup, 'Chybn nastaven tisku'); ResMod(@sPSErrNoPrinterInstalled, 'Na potai nen instalovna dn tiskrna.'); ResMod(@sPSErrNoDefaultPrinter, 'Nen zvolena vchoz tiskrna, nelze pokraovat. Zvolte vchoz tiskrnu.'); ResMod(@sPSErrPrinterUnknown, 'Neznm chyba v tiskovm rozhran. Prosm restartujte aplikaci a zkuste to znovu.'); ResMod(@sPSErrPrinterConfiguration, 'Konfigurace tiskrny nen podporovna.'); // KControlsDesign texts ResMod(@sInvalidGraphicFormat, 'Neplatn grafick formt.'); // KDBGrids texts ResMod(@sDataSetUnidirectional, 'Nelze pout KDBGrid s jednosmrnm datasetem.'); // KMemoRTF texts ResMod(@sErrMemoLoadFromRTF, 'Chyba pi ten souboru RTF.'); ResMod(@sErrMemoLoadImageFromRTF, 'Chyba pi ten obrzku z RTF souboru.'); ResMod(@sErrMemoSaveToRTF, 'Chyba pi zpisu souboru RTF.'); // KMemoFrame texts ResMod(@sAppError, 'Chyba aplikace'); ResMod(@sAppQuery, 'Dotaz aplikace'); ResMod(@sMemoDefaultFileName, 'dokument'); ResMod(@sQueryFileSave, 'Soubor "%s" byl zmnn. Pejete si jej uloit?'); ResMod(@sErrMemoLoadFromFile, 'Chyba pi ten souboru "%s".'); ResMod(@sErrMemoSaveToFile, 'Chyba pi zpisu souboru "%s".'); ResMod(@sMemoSampleTextBox, 'Vyplte obsah textovho pole. Pole lze umstit kdekoli v dokumentu.'); end; end. tomboy-ng_0.34-1/kcontrols/source/kcontrols.res0000644000175000017500000000162014125207534021464 0ustar dbannondbannon 4 ( @?wg P KPREVIEW_CURSOR_HAND_FREE0 @44 ( @??`P KPREVIEW_CURSOR_HAND_GRIP0 @4tomboy-ng_0.34-1/kcontrols/source/kmemortf.pas0000644000175000017500000043514614125207534021302 0ustar dbannondbannon{ @abstract(This file is part of the KControls component suite for Delphi and Lazarus.) @author(Tomas Krysl) Copyright (c) 2020 Tomas Krysl

License:
This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } unit kmemortf; // lowercase name because of Lazarus/Linux {$include kcontrols.inc} {$WEAKPACKAGEUNIT ON} interface uses Classes, Contnrs, Graphics, Controls, Types, KControls, KFunctions, KGraphics, KMemo; type TKMemoRTFCtrlMethod = procedure(ACtrl: Integer; var AText: AnsiString; AParam: Integer) of object; { Specifies the RTF control word descriptor. Is only used by RTF reader. } TKMemoRTFCtrl = class(TObject) private FCode: Integer; FCtrl: AnsiString; FMethod: TKMemoRTFCtrlMethod; public constructor Create; property Code: Integer read FCode write FCode; property Ctrl: AnsiString read FCtrl write FCtrl; property Method: TKMemoRTFCtrlMethod read FMethod write FMethod; end; { Specifies the RTF control word table. Is only used by RTF reader. Maybe using hash table would be even faster. } TKMemoRTFCtrlTable = class(TObjectList) private function GetItem(Index: Integer): TKMemoRTFCtrl; procedure SetItem(Index: Integer; const Value: TKMemoRTFCtrl); public procedure AddCtrl(const ACtrl: AnsiString; ACode: Integer; AMethod: TKMemoRTFCtrlMethod); function FindByCtrl(const ACtrl: AnsiString): TKMemoRtfCtrl; virtual; procedure SortTable; virtual; property Items[Index: Integer]: TKMemoRTFCtrl read GetItem write SetItem; default; end; { Specifies the RTF color descriptor. } TKMemoRTFColor = class(TObject) private FColorRec: TKColorRec; public constructor Create; property ColorRec: TKColorRec read FColorRec write FColorRec; property Red: Byte read FColorRec.R write FColorRec.R; property Green: Byte read FColorRec.G write FColorRec.G; property Blue: Byte read FColorRec.B write FColorRec.B; end; { Specifies the RTF color table. } TKMemoRTFColorTable = class(TObjectList) private function GetItem(Index: Integer): TKMemoRTFColor; procedure SetItem(Index: Integer; const Value: TKMemoRTFColor); public procedure AddColor(AColor: TColor); virtual; function GetColor(AIndex: Integer): TColor; virtual; function GetIndex(AColor: TColor): Integer; virtual; property Items[Index: Integer]: TKMemoRTFColor read GetItem write SetItem; default; end; { Specifies the RTF font descriptor. } TKMemoRTFFont = class(TObject) private FFont: TFont; FFontIndex: Integer; public constructor Create; destructor Destroy; override; property Font: TFont read FFont; property FontIndex: Integer read FFontIndex write FFontIndex; end; { Specifies the RTF font table. } TKMemoRTFFontTable = class(TObjectList) private function GetItem(Index: Integer): TKMemoRTFFont; procedure SetItem(Index: Integer; const Value: TKMemoRTFFont); public function AddFont(AFont: TFont): Integer; virtual; function GetFont(AFontIndex: Integer): TFont; virtual; function GetIndex(AFont: TFont): Integer; virtual; property Items[Index: Integer]: TKMemoRTFFont read GetItem write SetItem; default; end; { Specifies the RTF list level descriptor. } TKMemoRTFListLevel = class(TObject) private FFirstIndent: Integer; FJustify: Integer; FLeftIndent: Integer; FNumberType: Integer; FStartAt: Integer; FNumberingFormat: TKMemoNumberingFormat; FFontIndex: Integer; function GetNumberTypeAsNumbering: TKMemoParaNumbering; procedure SetNumberTypeAsNumbering(const Value: TKMemoParaNumbering); public constructor Create; destructor Destroy; override; property FirstIndent: Integer read FFirstIndent write FFirstIndent; property FontIndex: Integer read FFontIndex write FFontIndex; property Justify: Integer read FJustify write FJustify; property LeftIndent: Integer read FLeftIndent write FLeftIndent; property NumberingFormat: TKMemoNumberingFormat read FNumberingFormat; property NumberType: Integer read FNumberType write FNumberType; property NumberTypeAsNumbering: TKMemoParaNumbering read GetNumberTypeAsNumbering write SetNumberTypeAsNumbering; property StartAt: Integer read FStartAt write FStartAt; end; { Specifies the RTF list levels. } TKMemoRTFListLevels = class(TObjectList) private function GetItem(Index: Integer): TKMemoRTFListLevel; procedure SetItem(Index: Integer; const Value: TKMemoRTFListLevel); public property Items[Index: Integer]: TKMemoRTFListLevel read GetItem write SetItem; default; end; TKMemoRTFListTable = class; { Specifies the RTF list descriptor. } TKMemoRTFList = class(TObject) private FID: Integer; FLevels: TKMemoRTFListLevels; public constructor Create(AParent: TKMemoRTFListTable); destructor Destroy; override; property ID: Integer read FID write FID; property Levels: TKMemoRTFListLevels read FLevels; end; { Specifies the RTF list table. } TKMemoRTFListTable = class(TObjectList) private FOverrides: TKMemoDictionary; function GetItem(Index: Integer): TKMemoRTFList; procedure SetItem(Index: Integer; const Value: TKMemoRTFList); protected FIDCounter: Integer; public constructor Create; destructor Destroy; override; procedure AssignFromListTable(AListTable: TKMemoListTable; AFontTable: TKMemoRTFFontTable); procedure AssignToListTable(AListTable: TKMemoListTable; AFontTable: TKMemoRTFFontTable); function FindByID(AListID: Integer): Integer; function FindByIndex(AIndex: Integer): Integer; function IDByIndex(AIndex: Integer): Integer; function NextID: Integer; property Items[Index: Integer]: TKMemoRTFList read GetItem write SetItem; default; property Overrides: TKMemoDictionary read FOverrides; end; { Specifies the supported RTF shape object type. } TKMemoRTFShapeContentType = (sctUnknown, sctTextBox, sctImage, sctRectangle, sctText); { Specifies the RTF shape object since KMemo has no generic drawing object support. } TKMemoRTFShape = class(TObject) private FBackground: Boolean; FContentPosition: TKRect; FContentType: TKMemoRTFShapeContentType; FCtrlName: AnsiString; FCtrlValue: AnsiString; FFitToShape: Boolean; FFitToText: Boolean; FHorzPosCode: Integer; FBlock: TKMemoBlock; FStyle: TKMemoBlockStyle; FVertPosCode: Integer; FWrap: Integer; FWrapSide: Integer; FFillBlip: Boolean; procedure SetWrap(const Value: Integer); procedure SetWrapSide(const Value: Integer); function GetWrap: Integer; function GetWrapSide: Integer; protected procedure RTFWrapToWrapMode; virtual; procedure WrapModeToRTFWrap; virtual; public constructor Create; destructor Destroy; override; property Background: Boolean read FBackground write FBackground; property Block: TKMemoBlock read FBlock write FBlock; property ContentPosition: TKRect read FContentPosition; property ContentType: TKMemoRTFShapeContentType read FContentType write FContentType; property CtrlName: AnsiString read FCtrlName write FCtrlName; property CtrlValue: AnsiString read FCtrlValue write FCtrlValue; property FillBlip: Boolean read FFillBlip write FFillBlip; property FitToShape: Boolean read FFitToShape write FFitToShape; property FitToText: Boolean read FFitToText write FFitToText; property HorzPosCode: Integer read FHorzPosCode write FHorzPosCode; property Style: TKMemoBlockStyle read FStyle; property VertPosCode: Integer read FVertPosCode write FVertPosCode; property Wrap: Integer read GetWrap write SetWrap; property WrapSide: Integer read GetWrapSide write SetWrapSide; end; TKMemoRTFGroup = (rgNone, rgUnknown, rgColorTable, rgField, rgFieldInst, rgFieldResult, rgFontTable, rgFooter, rgHeader, rgInfo, rgListTable, rgList, rgListLevel, rgListLevelText, rgListOverrideTable, rgListOverride, rgPageBackground, rgPicture, rgPicProp, rgShape, rgShapeInst, rgShapePict, rgStyleSheet, rgTextBox); { Specifies the RTF reader state. This class is used by RTF reader to store reader state on the stack. } TKMemoRTFState = class(TObject) private FTextStyle: TKMemoTextStyle; FParaStyle: TKMemoParaStyle; FGroup: TKMemoRTFGroup; public constructor Create; destructor Destroy; override; procedure Assign(ASource: TKmemoRTFState); virtual; property Group: TKMemoRTFGroup read FGroup write FGroup; property ParaStyle: TKMemoParaStyle read FParaStyle write FParaStyle; property TextStyle: TKMemoTextStyle read FTextStyle write FTextStyle; end; { Specifies the stack for the RTF reader state. } TKMemoRTFStack = class(TStack) public function Push(AObject: TKMemoRTFState): TKMemoRTFState; function Pop: TKMemoRTFState; function Peek: TKMemoRTFState; end; TKMemoRTFHeaderProp = (rphNone, rphRtf, rphCodePage, rphDefaultFont, rphIgnoreCharsAfterUnicode, rphFontTable, rphColorTable, rphStyleSheet); TKMemoRTFDocumentProp = (rpdNone, rpdFooter, rpdFooterLeft, rpdFooterRight, rpdHeader, rpdHeaderLeft, rpdHeaderRight, rpdInfo); TKMemoRTFColorProp = (rpcNone, rpcRed, rpcGreen, rpcBlue); TKMemoRTFFieldProp = (rpfiNone, rpfiField, rpfiResult); TKMemoRTFFontProp = (rpfNone, rpfIndex, rpfCharset, rpfPitch); TKMemoRTFImageProp = (rpiNone, rpiPict, rpiJPeg, rpiPng, rpiEmf, rpiWmf, rpiWidth, rpiHeight, rpiCropBottom, rpiCropLeft, rpiCropRight, rpiCropTop, rpiReqWidth, rpiReqHeight, rpiScaleX, rpiScaleY); TKMemoRTFListProp = (rplNone, rplList, rplListOverride, rplListLevel, rplListId, rplListIndex, rplListText, rplLevelStartAt, rplLevelNumberType, rplLevelJustify, rplLevelText, rplLevelFontIndex, rplLevelFirstIndent, rplLevelLeftIndent, rplPnText); TKMemoRTFParaProp = (rppNone, rppParD, rppIndentFirst, rppIndentBottom, rppIndentLeft, rppIndentRight, rppIndentTop, rppAlignLeft, rppAlignCenter, rppAlignRight, rppAlignJustify, rppBackColor, rppNoWordWrap, rppBorderBottom, rppBorderLeft, rppBorderRight, rppBorderTop, rppBorderAll, rppBorderWidth, rppBorderNone, rppBorderRadius, rppBorderColor, rppLineSpacing, rppLineSpacingMode, rppPar, rppListIndex, rppListLevel, rppListStartAt); TKMemoRTFShapeProp = (rpsNone, rpsShape, rpsBottom, rpsLeft, rpsRight, rpsTop, rpsXColumn, rpsYPara, rpsWrap, rpsWrapSide, rpsSn, rpsSv, rpsShapeText); TKMemoRTFSpecialCharProp = (rpscNone, rpscTab, rpscLquote, rpscRQuote, rpscLDblQuote, rpscRDblQuote, rpscEnDash, rpscEmDash, rpscBullet, rpscNBSP, rpscEmSpace, rpscEnSpace, rpscAnsiChar, rpscUnicodeChar); TKMemoRTFTableProp = (rptbNone, rptbRowBegin, rptbCellEnd, rptbRowEnd, rptbLastRow, rptbRowPaddBottom, rptbRowPaddLeft, rptbRowPaddRight, rptbRowPaddTop, rptbBorderBottom, rptbBorderLeft, rptbPaddAll, rptbBorderRight, rptbBorderTop, rptbBorderWidth, rptbBorderNone, rptbBorderColor, rptbBackColor, rptbHorzMergeBegin, rptbHorzMerge, rptbVertMergeBegin, rptbVertMerge, rptbCellPaddBottom, rptbCellPaddLeft, rptbCellPaddRight, rptbCellPaddTop, rptbCellWidth, rptbCellX); TKMemoRTFTextProp = (rptNone, rptPlain, rptFontIndex, rptBold, rptItalic, rptUnderline, rptStrikeout, rptCaps, rptSmallCaps, rptFontSize, rptForeColor, rptBackColor, rptSubscript, rptSuperscript); TKMemoRTFUnknownProp = (rpuNone, rpuUnknownSym, rpuPageBackground, rpuPicProp, rpuShapeInst, rpuShapePict, rpuNonShapePict, rpuFieldInst, rpuListTable, rpuListOverrideTable); { Specifies the common ancestor for RTF streaming. } TKMemoRTFFiler = class(TObject) private protected FMemo: TKCustomMemo; FStream: TStream; FTwipsPerPixelX, FTwipsPerPixelY: Double; public constructor Create(AMemo: TKCustomMemo); virtual; function EMUToPoints(AValue: Integer): Integer; virtual; function PointsToEMU(AValue: Integer): Integer; virtual; function PixelsToTwipsX(AValue: Integer): Integer; virtual; function PixelsToTwipsY(AValue: Integer): Integer; virtual; function TwipsToPixelsX(AValue: Integer): Integer; virtual; function TwipsToPixelsY(AValue: Integer): Integer; virtual; end; { Specifies the RTF reader. } TKMemoRTFReader = class(TKMemoRTFFiler) private function GetActiveFont: TKMemoRTFFont; function GetActiveColor: TKMemoRTFColor; function GetActiveImage: TKMemoImageBlock; function GetActiveShape: TKMemoRTFShape; function GetActiveContainer: TKMemoContainer; function GetActiveTable: TKMemoTable; function GetActiveList: TKMemoRTFList; function GetActiveListLevel: TKMemoRTFListLevel; function GetActiveListOverride: TKMemoDictionaryItem; protected FActiveBlocks: TKMemoBlocks; FActiveColor: TKMemoRTFColor; FActiveContainer: TKMemoContainer; FActiveFont: TKMemoRTFFont; FActiveImage: TKMemoImageBlock; FActiveImageClass: TGraphicClass; FActiveImageIsEMF: Boolean; FActiveList: TKMemoRTFList; FActiveListLevel: TKMemoRTFListLevel; FActiveListOverride: TKMemoDictionaryItem; FActiveParaBorder: TAlign; FActiveShape: TKMemoRTFShape; FActiveString: TKString; FActiveState: TKMemoRTFState; FActiveTable: TKMemoTable; FActiveTableBorder: TAlign; FActiveTableCell: TKMemoTableCell; FActiveTableCellXPos: Integer; FActiveTableCol: Integer; FActiveTableColCount: Integer; FActiveTableLastRow: Boolean; FActiveTableRow: TKMemoTableRow; FActiveTableRowPadd: TRect; FActiveText: TKMemoTextBlock; FActiveURL: TKString; FAtIndex: TKMemoBlockIndex; FColorTable: TKMemoRTFColorTable; FCtrlTable: TKMemoRTFCtrlTable; FDefaultCodePage: Integer; FDefaultFontIndex: Integer; FFontTable: TKMemoRTFFontTable; FIgnoreChars: Integer; FIgnoreCharsAfterUnicode: Integer; FIndexStack: TKMemoIndexObjectStack; FGraphicClass: TGraphicClass; FListTable: TKMemoRTFListTable; FStack: TKMemoRTFStack; procedure AddText(const APart: TKString); virtual; procedure AddTextToNumberingFormat(const APart: TKString); virtual; procedure ApplyFont(ATextStyle: TKMemoTextStyle; AFontIndex: Integer); virtual; procedure ApplyHighlight(ATextStyle: TKMemoTextStyle; AHighlightCode: Integer); virtual; procedure FillCtrlTable; virtual; function ParamToBool(const AValue: AnsiString): Boolean; virtual; function ParamToColor(const AValue: AnsiString): TColor; virtual; function ParamToInt(const AValue: AnsiString): Integer; virtual; function ParamToEMU(const AValue: AnsiString): Integer; virtual; procedure FlushColor; virtual; procedure FlushContainer; virtual; procedure FlushFont; virtual; procedure FlushHyperlink; virtual; procedure FlushImage; virtual; procedure FlushList; virtual; procedure FlushListLevel; virtual; procedure FlushListOverride; virtual; procedure FlushParagraph; virtual; procedure FlushShape; virtual; procedure FlushTable; virtual; procedure FlushText; virtual; function HighlightCodeToColor(AValue: Integer): TColor; virtual; procedure PopFromStack(ACtrl: Integer; var AText: AnsiString; AParam: Integer); virtual; procedure PushToStack(ACtrl: Integer; var AText: AnsiString; AParam: Integer); virtual; function ReadNext(out ACtrl, AText: AnsiString; out AParam: Int64): Boolean; virtual; procedure ReadColorGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); virtual; procedure ReadDocumentGroups(ACtrl: Integer; var AText: AnsiString; AParam: Integer); virtual; procedure ReadFieldGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); virtual; procedure ReadFontGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); virtual; procedure ReadHeaderGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); virtual; procedure ReadListGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); virtual; procedure ReadParaFormatting(ACtrl: Integer; var AText: AnsiString; AParam: Integer); virtual; procedure ReadPictureGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); virtual; procedure ReadShapeGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); virtual; procedure ReadSpecialCharacter(ACtrl: Integer; var AText: AnsiString; AParam: Integer); virtual; procedure ReadStream; virtual; procedure ReadTableFormatting(ACtrl: Integer; var AText: AnsiString; AParam: Integer); virtual; procedure ReadTextFormatting(ACtrl: Integer; var AText: AnsiString; AParam: Integer); virtual; procedure ReadUnknownGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); virtual; property ActiveColor: TKMemoRTFColor read GetActiveColor; property ActiveContainer: TKMemoContainer read GetActiveContainer; property ActiveFont: TKMemoRTFFont read GetActiveFont; property ActiveList: TKMemoRTFList read GetActiveList; property ActiveListLevel: TKMemoRTFListLevel read GetActiveListLevel; property ActiveListOverride: TKMemoDictionaryItem read GetActiveListOverride; property ActiveImage: TKMemoImageBlock read GetActiveImage; property ActiveShape: TKMemoRTFShape read GetActiveShape; property ActiveTable: TKMemoTable read GetActiveTable; public constructor Create(AMemo: TKCustomMemo); override; destructor Destroy; override; procedure LoadFromFile(const AFileName: TKString; AActiveBlocks: TKMemoBlocks; AtIndex: TKMemoSelectionIndex); virtual; procedure LoadFromStream(AStream: TStream; AActiveBlocks: TKMemoBlocks; AtIndex: TKMemoSelectionIndex); virtual; end; { Specifies the RTF writer. } TKMemoRTFWriter = class(TKMemoRTFFiler) private FReadableOutput: Boolean; protected FCodePage: Integer; FColorTable: TKMemoRTFColorTable; FFontTable: TKMemoRTFFontTable; FGroupLevel: Integer; FListTable: TKMemoRTFListTable; FSelectedOnly: Boolean; function BoolToParam(AValue: Boolean): AnsiString; virtual; function CanSave(ABlock: TKMemoBlock): Boolean; virtual; function ColorToHighlightCode(AValue: TColor): Integer; virtual; function ColorToParam(AValue: TColor): AnsiString; virtual; function EMUToParam(AValue: Integer): AnsiString; virtual; procedure FillColorTable(ABlocks: TKMemoBlocks); virtual; procedure FillFontTable(ABlocks: TKMemoBlocks); virtual; procedure WriteBackground; virtual; procedure WriteBody(ABlocks: TKMemoBlocks; AInsideOfTable: Boolean); virtual; procedure WriteColorTable; virtual; procedure WriteContainer(ABlock: TKMemoContainer; AInsideTable: Boolean); virtual; procedure WriteCtrl(const ACtrl: AnsiString); procedure WriteCtrlParam(const ACtrl: AnsiString; AParam: Integer); procedure WriteFontTable; virtual; procedure WriteGroupBegin; procedure WriteGroupEnd; procedure WriteHeader(ABlocks: TKMemoBlocks); virtual; procedure WriteHyperlinkBegin(ABlock: TKMemoHyperlink); virtual; procedure WriteHyperlinkEnd; virtual; procedure WriteImage(ABlock: TKmemoImageBlock); virtual; procedure WriteImageBlock(ABlock: TKmemoImageBlock; AInsideTable: Boolean); virtual; procedure WriteListTable; virtual; procedure WriteListText(ANumberBlock: TKMemoTextBlock); virtual; procedure WriteParagraph(ABlock: TKMemoParagraph; AInsideTable: Boolean); virtual; procedure WriteParaStyle(AParaStyle: TKMemoParaStyle); virtual; procedure WritePicture(AImage: TGraphic); virtual; procedure WriteSemiColon; procedure WriteShape(AShape: TKMemoRTFShape; AInsideTable: Boolean); virtual; procedure WriteShapeProp(const APropName, APropValue: AnsiString); virtual; procedure WriteShapeProperties(AShape: TKMemoRTFShape); virtual; procedure WriteShapePropName(const APropName: AnsiString); procedure WriteShapePropValue(const APropValue: AnsiString); procedure WriteSpace; procedure WriteString(const AText: AnsiString); procedure WriteTable(ABlock: TKMemoTable); virtual; procedure WriteTableRowProperties(ATable: TKMemoTable; ARowIndex, ASavedRowIndex: Integer); virtual; procedure WriteTextBlock(ABlock: TKMemoTextBlock; ASelectedOnly: Boolean); virtual; procedure WriteTextStyle(ATextStyle: TKMemoTextStyle); virtual; procedure WriteUnicodeString(const AText: TKString); virtual; procedure WriteUnknownGroup; public constructor Create(AMemo: TKCustomMemo); override; destructor Destroy; override; procedure SaveToFile(const AFileName: TKString; ASelectedOnly: Boolean); virtual; procedure SaveToStream(AStream: TStream; ASelectedOnly: Boolean; AActiveBlocks: TKMemoBlocks = nil); virtual; property ReadableOutput: Boolean read FReadableOutput write FReadableOutput; end; function CharSetToCP(ACharSet: TFontCharSet): Integer; function CPToCharSet(ACodePage: Integer): TFontCharSet; implementation uses Math, SysUtils, KEditCommon, KHexEditor, KRes {$IFDEF FPC} , LCLIntf, LCLProc, LConvEncoding, LCLType, LazUTF8 {$ELSE} , JPeg, Windows {$ENDIF} ; const cRTFHyperlink = 'HYPERLINK'; function CharSetToCP(ACharSet: TFontCharSet): Integer; begin case ACharset of 1: Result := 0; //Default 2: Result := 42; //Symbol 77: Result := 10000; //Mac Roman 78: Result := 10001; //Mac Shift Jis 79: Result := 10003; //Mac Hangul 80: Result := 10008; //Mac GB2312 81: Result := 10002; //Mac Big5 83: Result := 10005; //Mac Hebrew 84: Result := 10004; //Mac Arabic 85: Result := 10006; //Mac Greek 86: Result := 10081; //Mac Turkish 87: Result := 10021; //Mac Thai 88: Result := 10029; //Mac East Europe 89: Result := 10007; //Mac Russian 128: Result := 932; //Shift JIS 129: Result := 949; //Hangul 130: Result := 1361; //Johab 134: Result := 936; //GB2312 136: Result := 950; //Big5 161: Result := 1253; //Greek 162: Result := 1254; //Turkish 163: Result := 1258; //Vietnamese 177: Result := 1255; //Hebrew 178: Result := 1256; //Arabic 186: Result := 1257; //Baltic 204: Result := 1251; //Russian 222: Result := 874; //Thai 238: Result := 1250; //Eastern European 254: Result := 437; //PC 437 255: Result := 850; //OEM else Result := SystemCodePage; //system default end; end; function CPToCharSet(ACodePage: Integer): TFontCharSet; begin case ACodePage of 0: Result := 1; //Default 42: Result := 2; //Symbol 10000: Result := 77; //Mac Roman 10001: Result := 78; //Mac Shift Jis 10003: Result := 79; //Mac Hangul 10008: Result := 80; //Mac GB2312 10002: Result := 81; //Mac Big5 10005: Result := 83; //Mac Hebrew 10004: Result := 84; //Mac Arabic 10006: Result := 85; //Mac Greek 10081: Result := 86; //Mac Turkish 10021: Result := 87; //Mac Thai 10029: Result := 88; //Mac East Europe 10007: Result := 89; //Mac Russian 932: Result := 128; //Shift JIS 949: Result := 129; //Hangul 1361: Result := 130; //Johab 936: Result := 134; //GB2312 950: Result := 136; //Big5 1253: Result := 161; //Greek 1254: Result := 162; //Turkish 1258: Result := 163; //Vietnamese 1255: Result := 177; //Hebrew 1256: Result := 178; //Arabic 1257: Result := 186; //Baltic 1251: Result := 204; //Russian 874: Result := 222; //Thai 1250: Result := 238; //Eastern European 437: Result := 254; //PC 437 850: Result := 255; //OEM else Result := 0; //ANSI end; end; function AdobeSymbolToUTF16(AValue: Integer): Integer; begin case AValue of $20: Result := $0020; //SPACE //space {/$20: Result := $00A0; //NO-BREAK SPACE //space } $21: Result := $0021; //EXCLAMATION MARK //exclam $22: Result := $2200; //FOR ALL //universal $23: Result := $0023; //NUMBER SIGN //numbersign $24: Result := $2203; //THERE EXISTS //existential $25: Result := $0025; //PERCENT SIGN //percent $26: Result := $0026; //AMPERSAND //ampersand $27: Result := $220B; //CONTAINS AS MEMBER //suchthat $28: Result := $0028; //LEFT PARENTHESIS //parenleft $29: Result := $0029; //RIGHT PARENTHESIS //parenright $2A: Result := $2217; //ASTERISK OPERATOR //asteriskmath $2B: Result := $002B; //PLUS SIGN //plus $2C: Result := $002C; //COMMA //comma $2D: Result := $2212; //MINUS SIGN //minus $2E: Result := $002E; //FULL STOP //period $2F: Result := $002F; //SOLIDUS //slash $30: Result := $0030; //DIGIT ZERO //zero $31: Result := $0031; //DIGIT ONE //one $32: Result := $0032; //DIGIT TWO //two $33: Result := $0033; //DIGIT THREE //three $34: Result := $0034; //DIGIT FOUR //four $35: Result := $0035; //DIGIT FIVE //five $36: Result := $0036; //DIGIT SIX //six $37: Result := $0037; //DIGIT SEVEN //seven $38: Result := $0038; //DIGIT EIGHT //eight $39: Result := $0039; //DIGIT NINE //nine $3A: Result := $003A; //COLON //colon $3B: Result := $003B; //SEMICOLON //semicolon $3C: Result := $003C; //LESS-THAN SIGN //less $3D: Result := $003D; //EQUALS SIGN //equal $3E: Result := $003E; //GREATER-THAN SIGN //greater $3F: Result := $003F; //QUESTION MARK //question $40: Result := $2245; //APPROXIMATELY EQUAL TO //congruent $41: Result := $0391; //GREEK CAPITAL LETTER ALPHA //Alpha $42: Result := $0392; //GREEK CAPITAL LETTER BETA //Beta $43: Result := $03A7; //GREEK CAPITAL LETTER CHI //Chi $44: Result := $0394; //GREEK CAPITAL LETTER DELTA //Delta {/$44: Result := $2206; //INCREMENT //Delta} $45: Result := $0395; //GREEK CAPITAL LETTER EPSILON //Epsilon $46: Result := $03A6; //GREEK CAPITAL LETTER PHI //Phi $47: Result := $0393; //GREEK CAPITAL LETTER GAMMA //Gamma $48: Result := $0397; //GREEK CAPITAL LETTER ETA //Eta $49: Result := $0399; //GREEK CAPITAL LETTER IOTA //Iota $4A: Result := $03D1; //GREEK THETA SYMBOL //theta1 $4B: Result := $039A; //GREEK CAPITAL LETTER KAPPA //Kappa $4C: Result := $039B; //GREEK CAPITAL LETTER LAMDA //Lambda $4D: Result := $039C; //GREEK CAPITAL LETTER MU //Mu $4E: Result := $039D; //GREEK CAPITAL LETTER NU //Nu $4F: Result := $039F; //GREEK CAPITAL LETTER OMICRON //Omicron $50: Result := $03A0; //GREEK CAPITAL LETTER PI //Pi $51: Result := $0398; //GREEK CAPITAL LETTER THETA //Theta $52: Result := $03A1; //GREEK CAPITAL LETTER RHO //Rho $53: Result := $03A3; //GREEK CAPITAL LETTER SIGMA //Sigma $54: Result := $03A4; //GREEK CAPITAL LETTER TAU //Tau $55: Result := $03A5; //GREEK CAPITAL LETTER UPSILON //Upsilon $56: Result := $03C2; //GREEK SMALL LETTER FINAL SIGMA //sigma1 $57: Result := $03A9; //GREEK CAPITAL LETTER OMEGA //Omega {/$57: Result := $2126; //OHM SIGN //Omega} $58: Result := $039E; //GREEK CAPITAL LETTER XI //Xi $59: Result := $03A8; //GREEK CAPITAL LETTER PSI //Psi $5A: Result := $0396; //GREEK CAPITAL LETTER ZETA //Zeta $5B: Result := $005B; //LEFT SQUARE BRACKET //bracketleft $5C: Result := $2234; //THEREFORE //therefore $5D: Result := $005D; //RIGHT SQUARE BRACKET //bracketright $5E: Result := $22A5; //UP TACK //perpendicular $5F: Result := $005F; //LOW LINE //underscore $60: Result := $F8E5; //RADICAL EXTENDER //radicalex (CUS) $61: Result := $03B1; //GREEK SMALL LETTER ALPHA //alpha $62: Result := $03B2; //GREEK SMALL LETTER BETA //beta $63: Result := $03C7; //GREEK SMALL LETTER CHI //chi $64: Result := $03B4; //GREEK SMALL LETTER DELTA //delta $65: Result := $03B5; //GREEK SMALL LETTER EPSILON //epsilon $66: Result := $03C6; //GREEK SMALL LETTER PHI //phi $67: Result := $03B3; //GREEK SMALL LETTER GAMMA //gamma $68: Result := $03B7; //GREEK SMALL LETTER ETA //eta $69: Result := $03B9; //GREEK SMALL LETTER IOTA //iota $6A: Result := $03D5; //GREEK PHI SYMBOL //phi1 $6B: Result := $03BA; //GREEK SMALL LETTER KAPPA //kappa $6C: Result := $03BB; //GREEK SMALL LETTER LAMDA //lambda $6D: Result := $00B5; //MICRO SIGN //mu {/$6D: Result := $03BC; //GREEK SMALL LETTER MU //mu} $6E: Result := $03BD; //GREEK SMALL LETTER NU //nu $6F: Result := $03BF; //GREEK SMALL LETTER OMICRON //omicron $70: Result := $03C0; //GREEK SMALL LETTER PI //pi $71: Result := $03B8; //GREEK SMALL LETTER THETA //theta $72: Result := $03C1; //GREEK SMALL LETTER RHO //rho $73: Result := $03C3; //GREEK SMALL LETTER SIGMA //sigma $74: Result := $03C4; //GREEK SMALL LETTER TAU //tau $75: Result := $03C5; //GREEK SMALL LETTER UPSILON //upsilon $76: Result := $03D6; //GREEK PI SYMBOL //omega1 $77: Result := $03C9; //GREEK SMALL LETTER OMEGA //omega $78: Result := $03BE; //GREEK SMALL LETTER XI //xi $79: Result := $03C8; //GREEK SMALL LETTER PSI //psi $7A: Result := $03B6; //GREEK SMALL LETTER ZETA //zeta $7B: Result := $007B; //LEFT CURLY BRACKET //braceleft $7C: Result := $007C; //VERTICAL LINE //bar $7D: Result := $007D; //RIGHT CURLY BRACKET //braceright $7E: Result := $007E; //TILDE OPERATOR //similar $A0: Result := $20AC; //EURO SIGN //Euro $A1: Result := $03D2; //GREEK UPSILON WITH HOOK SYMBOL //Upsilon1 $A2: Result := $2032; //PRIME //minute $A3: Result := $2264; //LESS-THAN OR EQUAL TO //lessequal $A4: Result := $2044; //FRACTION SLASH //fraction {/$A4: Result := $2215; //DIVISION SLASH //fraction} $A5: Result := $221E; //INFINITY //infinity $A6: Result := $0192; //LATIN SMALL LETTER F WITH HOOK //florin $A7: Result := $2663; //BLACK CLUB SUIT //club $A8: Result := $2666; //BLACK DIAMOND SUIT //diamond $A9: Result := $2665; //BLACK HEART SUIT //heart $AA: Result := $2660; //BLACK SPADE SUIT //spade $AB: Result := $2194; //LEFT RIGHT ARROW //arrowboth $AC: Result := $2190; //LEFTWARDS ARROW //arrowleft $AD: Result := $2191; //UPWARDS ARROW //arrowup $AE: Result := $2192; //RIGHTWARDS ARROW //arrowright $AF: Result := $2193; //DOWNWARDS ARROW //arrowdown $B0: Result := $00B0; //DEGREE SIGN //degree $B1: Result := $00B1; //PLUS-MINUS SIGN //plusminus $B2: Result := $2033; //DOUBLE PRIME //second $B3: Result := $2265; //GREATER-THAN OR EQUAL TO //greaterequal $B4: Result := $00D7; //MULTIPLICATION SIGN //multiply $B5: Result := $221D; //PROPORTIONAL TO //proportional $B6: Result := $2202; //PARTIAL DIFFERENTIAL //partialdiff $B7: Result := $2022; //BULLET //bullet $B8: Result := $00F7; //DIVISION SIGN //divide $B9: Result := $2260; //NOT EQUAL TO //notequal $BA: Result := $2261; //IDENTICAL TO //equivalence $BB: Result := $2248; //ALMOST EQUAL TO //approxequal $BC: Result := $2026; //HORIZONTAL ELLIPSIS //ellipsis $BD: Result := $F8E6; //VERTICAL ARROW EXTENDER //arrowvertex (CUS) $BE: Result := $F8E7; //HORIZONTAL ARROW EXTENDER //arrowhorizex (CUS) $BF: Result := $21B5; //DOWNWARDS ARROW WITH CORNER LEFTWARDS //carriagereturn $C0: Result := $2135; //ALEF SYMBOL //aleph $C1: Result := $2111; //BLACK-LETTER CAPITAL I //Ifraktur $C2: Result := $211C; //BLACK-LETTER CAPITAL R //Rfraktur $C3: Result := $2118; //SCRIPT CAPITAL P //weierstrass $C4: Result := $2297; //CIRCLED TIMES //circlemultiply $C5: Result := $2295; //CIRCLED PLUS //circleplus $C6: Result := $2205; //EMPTY SET //emptyset $C7: Result := $2229; //INTERSECTION //intersection $C8: Result := $222A; //UNION //union $C9: Result := $2283; //SUPERSET OF //propersuperset $CA: Result := $2287; //SUPERSET OF OR EQUAL TO //reflexsuperset $CB: Result := $2284; //NOT A SUBSET OF //notsubset $CC: Result := $2282; //SUBSET OF //propersubset $CD: Result := $2286; //SUBSET OF OR EQUAL TO //reflexsubset $CE: Result := $2208; //ELEMENT OF //element $CF: Result := $2209; //NOT AN ELEMENT OF //notelement $D0: Result := $2220; //ANGLE //angle $D1: Result := $2207; //NABLA //gradient $D2: Result := $F6DA; //REGISTERED SIGN SERIF //registerserif (CUS) $D3: Result := $F6D9; //COPYRIGHT SIGN SERIF //copyrightserif (CUS) $D4: Result := $F6DB; //TRADE MARK SIGN SERIF //trademarkserif (CUS) $D5: Result := $220F; //N-ARY PRODUCT //product $D6: Result := $221A; //SQUARE ROOT //radical $D7: Result := $22C5; //DOT OPERATOR //dotmath $D8: Result := $00AC; //NOT SIGN //logicalnot $D9: Result := $2227; //LOGICAL AND //logicaland $DA: Result := $2228; //LOGICAL OR //logicalor $DB: Result := $21D4; //LEFT RIGHT DOUBLE ARROW //arrowdblboth $DC: Result := $21D0; //LEFTWARDS DOUBLE ARROW //arrowdblleft $DD: Result := $21D1; //UPWARDS DOUBLE ARROW //arrowdblup $DE: Result := $21D2; //RIGHTWARDS DOUBLE ARROW //arrowdblright $DF: Result := $21D3; //DOWNWARDS DOUBLE ARROW //arrowdbldown $E0: Result := $25CA; //LOZENGE //lozenge $E1: Result := $2329; //LEFT-POINTING ANGLE BRACKET //angleleft $E2: Result := $F8E8; //REGISTERED SIGN SANS SERIF //registersans (CUS) $E3: Result := $F8E9; //COPYRIGHT SIGN SANS SERIF //copyrightsans (CUS) $E4: Result := $F8EA; //TRADE MARK SIGN SANS SERIF //trademarksans (CUS) $E5: Result := $2211; //N-ARY SUMMATION //summation $E6: Result := $F8EB; //LEFT PAREN TOP //parenlefttp (CUS) $E7: Result := $F8EC; //LEFT PAREN EXTENDER //parenleftex (CUS) $E8: Result := $F8ED; //LEFT PAREN BOTTOM //parenleftbt (CUS) $E9: Result := $F8EE; //LEFT SQUARE BRACKET TOP //bracketlefttp (CUS) $EA: Result := $F8EF; //LEFT SQUARE BRACKET EXTENDER //bracketleftex (CUS) $EB: Result := $F8F0; //LEFT SQUARE BRACKET BOTTOM //bracketleftbt (CUS) $EC: Result := $F8F1; //LEFT CURLY BRACKET TOP //bracelefttp (CUS) $ED: Result := $F8F2; //LEFT CURLY BRACKET MID //braceleftmid (CUS) $EE: Result := $F8F3; //LEFT CURLY BRACKET BOTTOM //braceleftbt (CUS) $EF: Result := $F8F4; //CURLY BRACKET EXTENDER //braceex (CUS) $F1: Result := $232A; //RIGHT-POINTING ANGLE BRACKET //angleright $F2: Result := $222B; //INTEGRAL //integral $F3: Result := $2320; //TOP HALF INTEGRAL //integraltp $F4: Result := $F8F5; //INTEGRAL EXTENDER //integralex (CUS) $F5: Result := $2321; //BOTTOM HALF INTEGRAL //integralbt $F6: Result := $F8F6; //RIGHT PAREN TOP //parenrighttp (CUS) $F7: Result := $F8F7; //RIGHT PAREN EXTENDER //parenrightex (CUS) $F8: Result := $F8F8; //RIGHT PAREN BOTTOM //parenrightbt (CUS) $F9: Result := $F8F9; //RIGHT SQUARE BRACKET TOP //bracketrighttp (CUS) $FA: Result := $F8FA; //RIGHT SQUARE BRACKET EXTENDER //bracketrightex (CUS) $FB: Result := $F8FB; //RIGHT SQUARE BRACKET BOTTOM //bracketrightbt (CUS) $FC: Result := $F8FC; //RIGHT CURLY BRACKET TOP //bracerighttp (CUS) $FD: Result := $F8FD; //RIGHT CURLY BRACKET MID //bracerightmid (CUS) $FE: Result := $F8FE; //RIGHT CURLY BRACKET BOTTOM //bracerightbt (CUS) else Result := AValue; end; end; { TKMemoRTFCtrlItem } constructor TKMemoRTFCtrl.Create; begin FCode := 0; FCtrl := ''; FMethod := nil; end; { TKMemoRTFCtrlTable } function KMemoRTFSearchCompare(Data: Pointer; Index: Integer; KeyPtr: Pointer): Integer; var Tbl: TKMemoRTFCtrlTable; TblCtrl, Ctrl: AnsiString; begin Tbl := TKMemoRTFCtrlTable(Data); Ctrl := AnsiString(keyPtr); TblCtrl := Tbl[Index].Ctrl; if Ctrl > TblCtrl then Result := 1 else if Ctrl < TblCtrl then Result := -1 else Result := 0; end; function KMemoRTFSortCompare(Data: Pointer; Index1, Index2: Integer): Integer; var Tbl: TKMemoRTFCtrlTable; TblCtrl1, TblCtrl2: AnsiString; begin Tbl := TKMemoRTFCtrlTable(Data); TblCtrl1 := Tbl[Index1].Ctrl; TblCtrl2 := Tbl[Index2].Ctrl; if TblCtrl1 > TblCtrl2 then Result := 1 else if TblCtrl1 < TblCtrl2 then Result := -1 else Result := 0; end; procedure KMemoRTFSortExchange(Data: Pointer; Index1, Index2: Integer); var Tbl: TKMemoRTFCtrlTable; begin Tbl := TKMemoRTFCtrlTable(Data); Tbl.Exchange(Index1, Index2); end; procedure TKMemoRTFCtrlTable.AddCtrl(const ACtrl: AnsiString; ACode: Integer; AMethod: TKMemoRTFCtrlMethod); var Item: TKMemoRTFCtrl; begin Item := TKMemoRTFCtrl.Create; Item.Ctrl := ACtrl; Item.Code := ACode; Item.Method := AMethod; inherited Add(Item); end; function TKMemoRTFCtrlTable.FindByCtrl(const ACtrl: AnsiString): TKMemoRtfCtrl; var Index: Integer; begin Index := BinarySearch(Self, Count, Pointer(ACtrl), KMemoRTFSearchCompare, True); if Index >= 0 then Result := Items[Index] else Result := nil; end; function TKMemoRTFCtrlTable.GetItem(Index: Integer): TKMemoRTFCtrl; begin Result := TKMemoRTFCtrl(inherited GetItem(Index)); end; procedure TKMemoRTFCtrlTable.SetItem(Index: Integer; const Value: TKMemoRTFCtrl); begin inherited SetItem(Index, Value); end; procedure TKMemoRTFCtrlTable.SortTable; begin QuickSort(Self, Count, KMemoRTFSortCompare, KMemoRTFSortExchange, True); end; { TKMemoRTFColor } constructor TKMemoRTFColor.Create; begin FColorRec.Value := 0; end; { TKMemoRTFColorTable } procedure TKMemoRTFColorTable.AddColor(AColor: TColor); var RTFColor: TKMemoRTFColor; begin if AColor <> clNone then begin if GetIndex(AColor) < 0 then begin RTFColor := TKMemoRTFColor.Create; RTFColor.ColorRec := ColorToColorRec(AColor); Add(RTFColor); end; end; end; function TKMemoRTFColorTable.getColor(AIndex: Integer): TColor; begin if (AIndex >= 0) and (AIndex < Count) then Result := ColorRecToColor(Items[AIndex].ColorRec) else Result := clNone; end; function TKMemoRTFColorTable.GetIndex(AColor: TColor): Integer; var I: Integer; Color, ColorRec: TKColorRec; begin Color := ColorToColorRec(AColor); Result := -1; for I := 0 to Count - 1 do begin ColorRec := Items[I].ColorRec; if ColorRec.Value = Color.Value then begin Result := I; Break; end; end; end; function TKMemoRTFColorTable.GetItem(Index: Integer): TKMemoRTFColor; begin Result := TKMemoRTFColor(inherited GetItem(Index)); end; procedure TKMemoRTFColorTable.SetItem(Index: Integer; const Value: TKMemoRTFColor); begin inherited SetItem(Index, Value); end; { TKMemoRTFFont } constructor TKMemoRTFFont.Create; begin FFont := TFont.Create; end; destructor TKMemoRTFFont.Destroy; begin FFont.Free; inherited; end; { TKMemoRTFFontTable } function TKMemoRTFFontTable.AddFont(AFont: TFont): Integer; var RTFFont: TKMemoRTFFont; begin Result := GetIndex(AFont); if Result < 0 then begin RTFFont := TKmemoRTFFont.Create; RTFFont.Font.Assign(AFont); RTFFont.FontIndex := Count; Result := Add(RTFFont); end; end; function TKMemoRTFFontTable.GetFont(AFontIndex: Integer): TFont; var I: Integer; Item: TKMemoRTFFont; begin Result := nil; for I := 0 to Count - 1 do begin Item := Items[I]; if Item.FontIndex = AFontIndex then begin Result := Item.Font; Exit; end; end; end; function TKMemoRTFFontTable.GetIndex(AFont: TFont): Integer; var I: Integer; Font: TFont; begin Result := -1; for I := 0 to Count - 1 do begin Font := Items[I].Font; if (Font.Name = AFont.Name) and (Font.Charset = AFont.Charset) and (Font.Pitch = AFont.Pitch) then begin Result := I; Break; end; end; end; function TKMemoRTFFontTable.GetItem(Index: Integer): TKMemoRTFFont; begin Result := TKMemoRTFFont(inherited GetItem(Index)); end; procedure TKMemoRTFFontTable.SetItem(Index: Integer; const Value: TKMemoRTFFont); begin inherited SetItem(Index, Value); end; { TKMemoRTFListLevel } constructor TKMemoRTFListLevel.Create; begin FFirstIndent := 0; FFontIndex := -1; FNumberingFormat := TKMemoNumberingFormat.Create; FJustify := 0; FLeftIndent := 0; FNumberType := 0; FStartAt := 1; end; destructor TKMemoRTFListLevel.Destroy; begin FNumberingFormat.Free; inherited; end; function TKMemoRTFListLevel.GetNumberTypeAsNumbering: TKMemoParaNumbering; begin // we support only basic types of Word numberings... case FNumberType of 1: Result := pnuRomanHi; 2: Result := pnuRomanLo; 3: Result := pnuLetterHi; 4: Result := pnuLetterLo; 23: Result := pnuBullets; 255: Result := pnuNone; else Result := pnuArabic; end; end; procedure TKMemoRTFListLevel.SetNumberTypeAsNumbering(const Value: TKMemoParaNumbering); begin case Value of pnuBullets, pnuTriangleBullets, pnuArrowOneBullets, pnuArrowTwoBullets, pnuCircleBullets: FNumberType := 23; // maps to bullet, TODO: find out how other bullet styles are stored in RTF... pnuArabic: FNumberType := 0; pnuLetterLo: FNumberType := 4; pnuLetterHi: FNumberType := 3; pnuRomanLo: FNumberType := 2; pnuRomanHi: FNumberType := 1; else FNumberType := 255; // pnuNone end; end; { TKMemoRTFListLevels } function TKMemoRTFListLevels.GetItem(Index: Integer): TKMemoRTFListLevel; begin Result := TKMemoRTFListLevel(inherited GetItem(Index)); end; procedure TKMemoRTFListLevels.SetItem(Index: Integer; const Value: TKMemoRTFListLevel); begin inherited SetItem(Index, Value); end; { TKMemoRTFList } constructor TKMemoRTFList.Create(AParent: TKMemoRTFListTable); begin if AParent <> nil then FID := AParent.NextID else FID := Random(MaxInt); FLevels := TKMemoRTFListLevels.Create; end; destructor TKMemoRTFList.Destroy; begin FLevels.Free; inherited; end; { TKMemoRTFListTable } constructor TKMemoRTFListTable.Create; begin inherited; FIdCounter := 0; FOverrides := TKMemoDictionary.Create; end; destructor TKMemoRTFListTable.Destroy; begin FOverrides.Free; inherited; end; procedure TKMemoRTFListTable.AssignFromListTable(AListTable: TKMemoListTable; AFontTable: TKMemoRTFFontTable); var List: TKMemoList; ListLevel: TKMemoListLevel; RTFList: TKMemoRTFList; RTFListLevel: TKMemoRTFListLevel; NFItem: TKMemoNumberingFormatItem; I, J, K, Len: Integer; begin Clear; for I := 0 to AListTable.Count - 1 do begin List := AListTable.Items[I]; RTFList := TKMemoRTFList.Create(Self); RTFList.ID := List.ID; for J := 0 to List.Levels.Count - 1 do begin ListLevel := List.Levels[J]; RTFListLevel := TKMemoRTFListLevel.Create; RTFListLevel.FirstIndent := ListLevel.FirstIndent; RTFListLevel.LeftIndent := ListLevel.LeftIndent; if ListLevel.NumberingFontChanged then RTFListLevel.FontIndex := AFontTable.AddFont(ListLevel.NumberingFont); RTFListLevel.NumberTypeAsNumbering := ListLevel.Numbering; RTFListLevel.NumberingFormat.Assign(ListLevel.NumberingFormat); // fixup numbering format for RTF save // add length field Len := 0; for K := 0 to RTFListLevel.NumberingFormat.Count - 1 do begin NFItem := RTFListLevel.NumberingFormat[K]; if (NFItem.Level >= 0) and (NFItem.Text = '') then Inc(Len) else Inc(Len, StringLength(NFItem.Text)); end; RTFListLevel.NumberingFormat.InsertItem(0, Len, ''); RTFListLevel.StartAt := ListLevel.NumberStartAt; RTFList.Levels.Add(RTFListLevel); end; Add(RTFList); FOverrides.AddItem(I, RTFList.ID); end; end; procedure TKMemoRTFListTable.AssignToListTable(AListTable: TKMemoListTable; AFontTable: TKMemoRTFFontTable); var List: TKMemoList; ListLevel: TKMemoListLevel; RTFList: TKMemoRTFList; RTFListLevel: TKMemoRTFListLevel; NFItem: TKMemoNumberingFormatItem; Font: TFont; I, J, K, L, UnicodeValue: Integer; S: TKString; begin AListTable.LockUpdate; try for I := 0 to Count - 1 do begin RTFList := Items[I]; List := AListTable.FindByID(RTFList.ID); if List = nil then begin List := TKMemoList.Create; List.Parent := AListTable; List.ID := RTFList.ID; AListTable.Add(List); end; List.Levels.Clear; for J := 0 to RTFList.Levels.Count - 1 do begin RTFListLevel := RTFList.Levels[J]; ListLevel := TKMemoListLevel.Create; ListLevel.Parent := List.Levels; ListLevel.FirstIndent := RTFListLevel.FirstIndent; ListLevel.LeftIndent := RTFListLevel.LeftIndent; ListLevel.Numbering := RTFListLevel.NumberTypeAsNumbering; ListLevel.NumberingFormat.Assign(RTFListLevel.NumberingFormat); ListLevel.NumberStartAt := RTFListLevel.StartAt; if RTFListLevel.FontIndex >= 0 then begin Font := AFontTable.GetFont(RTFListLevel.FontIndex); if Font <> nil then begin ListLevel.NumberingFont.Assign(Font); if ListLevel.NumberingFont.Name = 'Symbol' then begin ListLevel.NumberingFont.Name := 'Arial'; ListLevel.NumberingFont.Charset := 0; for K := 0 to ListLevel.NumberingFormat.Count - 1 do begin NFItem := ListLevel.NumberingFormat[K]; S := ''; for L := 1 to StringLength(NFItem.Text) do begin UnicodeValue := Ord(NativeUTFToUnicode(StringCopy(NFItem.Text, L, 1))); S := S + UnicodeToNativeUTF(WideChar(AdobeSymbolToUTF16(Byte(UnicodeValue)))); end; NFItem.Text := S; end; end; end; end; List.Levels.Add(ListLevel); end; end; finally AListTable.UnLockUpdate; end; end; function TKMemoRTFListTable.FindByID(AListID: Integer): Integer; var I: Integer; begin Result := -1; for I := 0 to Count - 1 do if Items[I].ID = AListID then begin Result := I; Break; end; end; function TKMemoRTFListTable.FindByIndex(AIndex: Integer): Integer; var I: Integer; begin Result := -1; for I := 0 to FOverrides.Count - 1 do if FOverrides.Items[I].Index = AIndex then begin Result := FindByID(FOverrides.Items[I].Value); Break; end; end; function TKMemoRTFListTable.GetItem(Index: Integer): TKMemoRTFList; begin Result := TKMemoRTFList(inherited GetItem(Index)); end; function TKMemoRTFListTable.IDByIndex(AIndex: Integer): Integer; var I: Integer; begin I := FindByIndex(AIndex); if I >= 0 then Result := Items[I].ID else Result := cInvalidListID; end; function TKMemoRTFListTable.NextID: Integer; begin Result := FIDCounter; Inc(FIDCounter); end; procedure TKMemoRTFListTable.SetItem(Index: Integer; const Value: TKMemoRTFList); begin inherited SetItem(Index, Value); end; { TKMemoRTFShape } constructor TKMemoRTFShape.Create; begin FBackground := False; FContentPosition := TKRect.Create; FContentType := sctUnknown; FFillBlip := False; FFitToShape := False; FFitToText := True; FHorzPosCode := 0; FBlock := nil; FStyle := TKMemoBlockStyle.Create; FStyle.Brush.Color := clWhite; FStyle.ContentMargin.AssignFromValues(5, 5, 5, 5); FVertPosCode := 0; FWrap := 0; FWrapSide := 0; end; destructor TKMemoRTFShape.Destroy; begin FContentPosition.Free; FStyle.Free; inherited; end; function TKMemoRTFShape.GetWrap: Integer; begin WrapModeToRTFWrap; Result := FWrap; end; function TKMemoRTFShape.GetWrapSide: Integer; begin WrapModeToRTFWrap; Result := FWrapSide; end; procedure TKMemoRTFShape.SetWrap(const Value: Integer); begin FWrap := Value; RTFWrapToWrapMode; end; procedure TKMemoRTFShape.SetWrapSide(const Value: Integer); begin FWrapSide := Value; RTFWrapToWrapMode; end; procedure TKMemoRTFShape.WrapModeToRTFWrap; begin FWrapSide := 0; FWrap := 0; case FStyle.WrapMode of wrAround: FWrap := 2; wrAroundLeft: begin FWrap := 2; FWrapSide := 1; end; wrAroundRight: begin FWrap := 2; FWrapSide := 2; end; wrTight: FWrap := 2; // FWrap should be 4, change when tight wrapping supported wrTightLeft: begin FWrap := 2; FWrapSide := 1; end; // FWrap should be 4, change when tight wrapping supported wrTightRight: begin FWrap := 2; FWrapSide := 2; end; // FWrap should be 4, change when tight wrapping supported wrTopBottom: FWrap := 1; wrNone: FWrap := 3; end; end; procedure TKMemoRTFShape.RTFWrapToWrapMode; begin case FWrap of 1: FStyle.WrapMode := wrTopBottom; 2: case FWrapSide of 1: FStyle.WrapMode := wrAroundLeft; 2: FStyle.WrapMode := wrAroundRight; else FStyle.WrapMode := wrAround; end; 3: FStyle.WrapMode := wrNone; 4: case FWrapSide of 1: FStyle.WrapMode := wrTightLeft; 2: FStyle.WrapMode := wrTightRight; else FStyle.WrapMode := wrTight; end; else FStyle.WrapMode := wrAround; end; end; { TKMemoRTFState } procedure TKMemoRTFState.Assign(ASource: TKmemoRTFState); begin if ASource <> nil then begin FGroup := ASource.Group; FParaStyle.Assign(ASource.ParaStyle); FTextStyle.Assign(ASource.TextStyle); // don't assign the IsShape and IsPicture properties, they should not be inherited end; end; constructor TKMemoRTFState.Create; begin FGroup := rgNone; FParaStyle := TKMemoParaStyle.Create; FTextStyle := TKMemoTextStyle.Create; end; destructor TKMemoRTFState.Destroy; begin FParaStyle.Free; FTextStyle.Free; inherited; end; { TKMemoRTFStack } function TKMemoRTFStack.Peek: TKMemoRTFState; begin Result := TKMemoRTFState(inherited Peek); end; function TKMemoRTFStack.Pop: TKMemoRTFState; begin Result := TKMemoRTFState(inherited Pop); end; function TKMemoRTFStack.Push(AObject: TKMemoRTFState): TKMemoRTFState; begin Result := TKMemoRTFState(inherited Push(AObject)); end; { TKMemoRTFFiler } constructor TKMemoRTFFiler.Create(AMemo: TKCustomMemo); begin if (AMemo <> nil) and AMemo.HandleAllocated then begin FTwipsPerPixelX := TwipsPerPixelX(AMemo.Handle); FTwipsPerPixelY := TwipsPerPixelY(AMemo.Handle); end else begin FTwipsPerPixelX := TwipsPerPixelX(0); FTwipsPerPixelY := TwipsPerPixelY(0); end; FMemo := AMemo; FStream := nil; end; function TKMemoRTFFiler.EMUToPoints(AValue: Integer): Integer; begin Result := DivUp(AValue, 12700); end; function TKMemoRTFFiler.PointsToEMU(AValue: Integer): Integer; begin Result := AValue * 12700; end; function TKMemoRTFFiler.PixelsToTwipsX(AValue: Integer): Integer; begin Result := Round(AValue * FTwipsPerPixelX); end; function TKMemoRTFFiler.PixelsToTwipsY(AValue: Integer): Integer; begin Result := Round(AValue * FTwipsPerPixelY); end; function TKMemoRTFFiler.TwipsToPixelsX(AValue: Integer): Integer; begin Result := Round(AValue / FTwipsPerPixelX); end; function TKMemoRTFFiler.TwipsToPixelsY(AValue: Integer): Integer; begin Result := Round(AValue / FTwipsPerPixelY); end; { TKMemoRTFReader } constructor TKMemoRTFReader.Create(AMemo: TKCustomMemo); begin inherited; FColorTable := TKMemoRTFColorTable.Create; FCtrlTable := TKMemoRTFCtrlTable.Create; FFontTable := TKMemoRTFFontTable.Create; FIndexStack := TKMemoIndexObjectStack.Create; FListTable := TKMemoRTFListTable.Create; FStack := TKMemoRTFStack.Create; FStream := nil; FillCtrlTable; FCtrlTable.SortTable; end; destructor TKMemoRTFReader.Destroy; begin FColorTable.Free; FCtrlTable.Free; FFontTable.Free; FIndexStack.Free; FListTable.Free; FStack.Free; inherited; end; procedure TKMemoRTFReader.FillCtrlTable; begin // control symbols FCtrlTable.AddCtrl('{', 0, PushToStack); FCtrlTable.AddCtrl('}', 0, PopFromStack); FCtrlTable.AddCtrl('*', Integer(rpuUnknownSym), ReadUnknownGroup); FCtrlTable.AddCtrl('shpinst', Integer(rpuShapeInst), ReadUnknownGroup); FCtrlTable.AddCtrl('shppict', Integer(rpuShapePict), ReadUnknownGroup); FCtrlTable.AddCtrl('nonshppict', Integer(rpuNonShapePict), ReadUnknownGroup); FCtrlTable.AddCtrl('background', Integer(rpuPageBackground), ReadUnknownGroup); FCtrlTable.AddCtrl('picprop', Integer(rpuPicProp), ReadUnknownGroup); FCtrlTable.AddCtrl('fldinst', Integer(rpuFieldInst), ReadUnknownGroup); FCtrlTable.AddCtrl('listtable', Integer(rpuListTable), ReadUnknownGroup); FCtrlTable.AddCtrl('listoverridetable', Integer(rpuListOverrideTable), ReadUnknownGroup); // header ctrls FCtrlTable.AddCtrl('rtf', Integer(rphRtf), ReadHeaderGroup); FCtrlTable.AddCtrl('ansicpg', Integer(rphCodePage), ReadHeaderGroup); FCtrlTable.AddCtrl('deff', Integer(rphDefaultFont), ReadHeaderGroup); FCtrlTable.AddCtrl('uc', Integer(rphIgnoreCharsAfterUnicode), ReadHeaderGroup); FCtrlTable.AddCtrl('fonttbl', Integer(rphFontTable), ReadHeaderGroup); FCtrlTable.AddCtrl('colortbl', Integer(rphColorTable), ReadHeaderGroup); FCtrlTable.AddCtrl('stylesheet', Integer(rphStyleSheet), ReadHeaderGroup); // document ctrls FCtrlTable.AddCtrl('footer', Integer(rpdFooter), ReadDocumentGroups); FCtrlTable.AddCtrl('footerl', Integer(rpdFooterLeft), ReadDocumentGroups); FCtrlTable.AddCtrl('footerr', Integer(rpdFooterRight), ReadDocumentGroups); FCtrlTable.AddCtrl('header', Integer(rpdHeader), ReadDocumentGroups); FCtrlTable.AddCtrl('headerl', Integer(rpdHeaderLeft), ReadDocumentGroups); FCtrlTable.AddCtrl('headerr', Integer(rpdHeaderRight), ReadDocumentGroups); FCtrlTable.AddCtrl('info', Integer(rpdInfo), ReadDocumentGroups); // color table ctrls FCtrlTable.AddCtrl('red', Integer(rpcRed), ReadColorGroup); FCtrlTable.AddCtrl('green', Integer(rpcGreen), ReadColorGroup); FCtrlTable.AddCtrl('blue', Integer(rpcBlue), ReadColorGroup); // field ctrls FCtrlTable.AddCtrl('field', Integer(rpfiField), ReadFieldGroup); FCtrlTable.AddCtrl('fldrslt', Integer(rpfiResult), ReadFieldGroup); // font table ctrls FCtrlTable.AddCtrl('f', Integer(rpfIndex), ReadFontGroup); FCtrlTable.AddCtrl('fcharset', Integer(rpfCharset), ReadFontGroup); FCtrlTable.AddCtrl('fprq', Integer(rpfPitch), ReadFontGroup); // list (override) table ctrls FCtrlTable.AddCtrl('list', Integer(rplList), ReadListGroup); FCtrlTable.AddCtrl('listoverride', Integer(rplListOverride), ReadListGroup); FCtrlTable.AddCtrl('listlevel', Integer(rplListLevel), ReadListGroup); FCtrlTable.AddCtrl('listid', Integer(rplListId), ReadListGroup); FCtrlTable.AddCtrl('listtext', Integer(rplListText), ReadListGroup); FCtrlTable.AddCtrl('levelstartat', Integer(rplLevelStartAt), ReadListGroup); FCtrlTable.AddCtrl('levelnfc', Integer(rplLevelNumberType), ReadListGroup); FCtrlTable.AddCtrl('leveljc', Integer(rplLevelJustify), ReadListGroup); FCtrlTable.AddCtrl('leveltext', Integer(rplLevelText), ReadListGroup); FCtrlTable.AddCtrl('pntext', Integer(rplPnText), ReadListGroup); // paragraph formatting ctrls FCtrlTable.AddCtrl('pard', Integer(rppParD), ReadParaFormatting); FCtrlTable.AddCtrl('fi', Integer(rppIndentFirst), ReadParaFormatting); FCtrlTable.AddCtrl('li', Integer(rppIndentLeft), ReadParaFormatting); FCtrlTable.AddCtrl('ri', Integer(rppIndentRight), ReadParaFormatting); FCtrlTable.AddCtrl('sb', Integer(rppIndentTop), ReadParaFormatting); FCtrlTable.AddCtrl('sa', Integer(rppIndentBottom), ReadParaFormatting); FCtrlTable.AddCtrl('ql', Integer(rppAlignLeft), ReadParaFormatting); FCtrlTable.AddCtrl('qc', Integer(rppAlignCenter), ReadParaFormatting); FCtrlTable.AddCtrl('qr', Integer(rppAlignRight), ReadParaFormatting); FCtrlTable.AddCtrl('qj', Integer(rppAlignJustify), ReadParaFormatting); FCtrlTable.AddCtrl('cbpat', Integer(rppBackColor), ReadParaFormatting); FCtrlTable.AddCtrl('nowwrap', Integer(rppNoWordWrap), ReadParaFormatting); FCtrlTable.AddCtrl('brdrb', Integer(rppBorderBottom), ReadParaFormatting); FCtrlTable.AddCtrl('brdrl', Integer(rppBorderLeft), ReadParaFormatting); FCtrlTable.AddCtrl('brdrr', Integer(rppBorderRight), ReadParaFormatting); FCtrlTable.AddCtrl('brdrt', Integer(rppBorderTop), ReadParaFormatting); FCtrlTable.AddCtrl('box', Integer(rppBorderAll), ReadParaFormatting); FCtrlTable.AddCtrl('brdrw', Integer(rppBorderWidth), ReadParaFormatting); FCtrlTable.AddCtrl('brdrnone', Integer(rppBorderNone), ReadParaFormatting); FCtrlTable.AddCtrl('brdrradius', Integer(rppBorderRadius), ReadParaFormatting); FCtrlTable.AddCtrl('brdrcf', Integer(rppBorderColor), ReadParaFormatting); FCtrlTable.AddCtrl('sl', Integer(rppLineSpacing), ReadParaFormatting); FCtrlTable.AddCtrl('slmult', Integer(rppLineSpacingMode), ReadParaFormatting); FCtrlTable.AddCtrl('par', Integer(rppPar), ReadParaFormatting); FCtrlTable.AddCtrl('ls', Integer(rppListIndex), ReadParaFormatting); FCtrlTable.AddCtrl('ilvl', Integer(rppListLevel), ReadParaFormatting); FCtrlTable.AddCtrl('lsstartat', Integer(rppListStartAt), ReadParaFormatting); // picture group ctrls FCtrlTable.AddCtrl('pict', Integer(rpiPict), ReadPictureGroup); FCtrlTable.AddCtrl('jpegblip', Integer(rpiJpeg), ReadPictureGroup); FCtrlTable.AddCtrl('pngblip', Integer(rpiPng), ReadPictureGroup); FCtrlTable.AddCtrl('emfblip', Integer(rpiEmf), ReadPictureGroup); FCtrlTable.AddCtrl('wmetafile', Integer(rpiWmf), ReadPictureGroup); FCtrlTable.AddCtrl('picw', Integer(rpiWidth), ReadPictureGroup); FCtrlTable.AddCtrl('pich', Integer(rpiHeight), ReadPictureGroup); FCtrlTable.AddCtrl('piccropb', Integer(rpiCropBottom), ReadPictureGroup); FCtrlTable.AddCtrl('piccropl', Integer(rpiCropLeft), ReadPictureGroup); FCtrlTable.AddCtrl('piccropr', Integer(rpiCropRight), ReadPictureGroup); FCtrlTable.AddCtrl('piccropt', Integer(rpiCropTop), ReadPictureGroup); FCtrlTable.AddCtrl('picscalex', Integer(rpiScaleX), ReadPictureGroup); FCtrlTable.AddCtrl('picscaley', Integer(rpiScaleY), ReadPictureGroup); FCtrlTable.AddCtrl('picwgoal', Integer(rpiReqWidth), ReadPictureGroup); FCtrlTable.AddCtrl('pichgoal', Integer(rpiReqHeight), ReadPictureGroup); // shape ctrls FCtrlTable.AddCtrl('shp', Integer(rpsShape), ReadShapeGroup); FCtrlTable.AddCtrl('shpbottom', Integer(rpsBottom), ReadShapeGroup); FCtrlTable.AddCtrl('shpleft', Integer(rpsLeft), ReadShapeGroup); FCtrlTable.AddCtrl('shpright', Integer(rpsRight), ReadShapeGroup); FCtrlTable.AddCtrl('shptop', Integer(rpsTop), ReadShapeGroup); FCtrlTable.AddCtrl('shpbxcolumn', Integer(rpsXColumn), ReadShapeGroup); FCtrlTable.AddCtrl('shpbypara', Integer(rpsYPara), ReadShapeGroup); FCtrlTable.AddCtrl('shpwr', Integer(rpsWrap), ReadShapeGroup); FCtrlTable.AddCtrl('shpwrk', Integer(rpsWrapSide), ReadShapeGroup); FCtrlTable.AddCtrl('sn', Integer(rpsSn), ReadShapeGroup); FCtrlTable.AddCtrl('sv', Integer(rpsSv), ReadShapeGroup); FCtrlTable.AddCtrl('shptxt', Integer(rpsShapeText), ReadShapeGroup); // special character ctrls FCtrlTable.AddCtrl('tab', Integer(rpscTab), ReadSpecialCharacter); FCtrlTable.AddCtrl('lquote', Integer(rpscLQuote), ReadSpecialCharacter); FCtrlTable.AddCtrl('rquote', Integer(rpscRQuote), ReadSpecialCharacter); FCtrlTable.AddCtrl('ldblquote', Integer(rpscLDblQuote), ReadSpecialCharacter); FCtrlTable.AddCtrl('rdblquote', Integer(rpscRDblQuote), ReadSpecialCharacter); FCtrlTable.AddCtrl('endash', Integer(rpscEnDash), ReadSpecialCharacter); FCtrlTable.AddCtrl('emdash', Integer(rpscEmDash), ReadSpecialCharacter); FCtrlTable.AddCtrl('bullet', Integer(rpscBullet), ReadSpecialCharacter); FCtrlTable.AddCtrl('~', Integer(rpscNBSP), ReadSpecialCharacter); FCtrlTable.AddCtrl('emspace', Integer(rpscEmSpace), ReadSpecialCharacter); FCtrlTable.AddCtrl('enspace', Integer(rpscEnSpace), ReadSpecialCharacter); FCtrlTable.AddCtrl('''', Integer(rpscAnsiChar), ReadSpecialCharacter); FCtrlTable.AddCtrl('u', Integer(rpscUnicodeChar), ReadSpecialCharacter); // table formatting ctrls FCtrlTable.AddCtrl('trowd', Integer(rptbRowBegin), ReadTableFormatting); FCtrlTable.AddCtrl('intbl', Integer(rptbRowBegin), ReadTableFormatting); FCtrlTable.AddCtrl('cell', Integer(rptbCellEnd), ReadTableFormatting); FCtrlTable.AddCtrl('row', Integer(rptbRowEnd), ReadTableFormatting); FCtrlTable.AddCtrl('lastrow', Integer(rptbLastRow), ReadTableFormatting); FCtrlTable.AddCtrl('trpaddb', Integer(rptbRowPaddBottom), ReadTableFormatting); FCtrlTable.AddCtrl('trpaddl', Integer(rptbRowPaddLeft), ReadTableFormatting); FCtrlTable.AddCtrl('trpaddr', Integer(rptbRowPaddRight), ReadTableFormatting); FCtrlTable.AddCtrl('trpaddt', Integer(rptbRowPaddTop), ReadTableFormatting); FCtrlTable.AddCtrl('trgaph', Integer(rptbPaddAll), ReadTableFormatting); FCtrlTable.AddCtrl('clbrdrb', Integer(rptbBorderBottom), ReadTableFormatting); FCtrlTable.AddCtrl('clbrdrl', Integer(rptbBorderLeft), ReadTableFormatting); FCtrlTable.AddCtrl('clbrdrr', Integer(rptbBorderRight), ReadTableFormatting); FCtrlTable.AddCtrl('clbrdrt', Integer(rptbBorderTop), ReadTableFormatting); FCtrlTable.AddCtrl('clpadb', Integer(rptbCellPaddBottom), ReadTableFormatting); FCtrlTable.AddCtrl('clpadl', Integer(rptbCellPaddLeft), ReadTableFormatting); FCtrlTable.AddCtrl('clpadr', Integer(rptbCellPaddRight), ReadTableFormatting); FCtrlTable.AddCtrl('clpadt', Integer(rptbCellPaddTop), ReadTableFormatting); // FCtrlTable.AddCtrl('brdrw', Integer(rptbBorderWidth), ReadTableFormatting); // see ReadParaFormatting // FCtrlTable.AddCtrl('brdrnone', Integer(rptbBorderNone), ReadTableFormatting); // see ReadParaFormatting // FCtrlTable.AddCtrl('brdrcf', Integer(rptbBorderColor), ReadParaFormatting); // see ReadParaFormatting FCtrlTable.AddCtrl('clcbpat', Integer(rptbBackColor), ReadTableFormatting); FCtrlTable.AddCtrl('clmgf', Integer(rptbHorzMergeBegin), ReadTableFormatting); FCtrlTable.AddCtrl('clhmrg', Integer(rptbHorzMerge), ReadTableFormatting); FCtrlTable.AddCtrl('clvmgf', Integer(rptbVertMergeBegin), ReadTableFormatting); FCtrlTable.AddCtrl('clvmrg', Integer(rptbVertMerge), ReadTableFormatting); FCtrlTable.AddCtrl('clwWidth', Integer(rptbCellWidth), ReadTableFormatting); FCtrlTable.AddCtrl('cellx', Integer(rptbCellX), ReadTableFormatting); // text formatting ctrls FCtrlTable.AddCtrl('plain', Integer(rptPlain), ReadTextFormatting); // FCtrlTable.AddCtrl('f', Integer(rptFontIndex), ReadTextFormatting); see ReadFontGroup FCtrlTable.AddCtrl('b', Integer(rptBold), ReadTextFormatting); FCtrlTable.AddCtrl('i', Integer(rptItalic), ReadTextFormatting); FCtrlTable.AddCtrl('ul', Integer(rptUnderline), ReadTextFormatting); FCtrlTable.AddCtrl('strike', Integer(rptStrikeout), ReadTextFormatting); FCtrlTable.AddCtrl('caps', Integer(rptCaps), ReadTextFormatting); FCtrlTable.AddCtrl('scaps', Integer(rptSmallCaps), ReadTextFormatting); FCtrlTable.AddCtrl('fs', Integer(rptFontSize), ReadTextFormatting); FCtrlTable.AddCtrl('cf', Integer(rptForeColor), ReadTextFormatting); FCtrlTable.AddCtrl('cb', Integer(rptBackColor), ReadTextFormatting); FCtrlTable.AddCtrl('highlight', Integer(rptBackColor), ReadTextFormatting); FCtrlTable.AddCtrl('sub', Integer(rptSubscript), ReadTextFormatting); FCtrlTable.AddCtrl('super', Integer(rptSuperscript), ReadTextFormatting); end; procedure TKMemoRTFReader.AddText(const APart: TKString); var S: TKString; begin S := APart; while (FIgnoreChars > 0) and (S <> '') do begin Delete(S, 1, 1); Dec(FIgnoreChars); end; if S <> '' then begin if FActiveState.TextStyle.StyleChanged then FlushText; if FActiveText = nil then begin FActiveText := TKMemoTextBlock.Create; FActiveText.TextStyle.Assign(FActiveState.TextStyle); end; FActiveState.TextStyle.StyleChanged := False; FActiveString := FActiveString + S; end; end; procedure TKMemoRTFReader.AddTextToNumberingFormat(const APart: TKString); var S: TKString; begin if APart <> '' then begin S := APart; while (FIgnoreChars > 0) and (S <> '') do begin Delete(S, 1, 1); Dec(FIgnoreChars); end; if S <> '' then begin if Ord(S[1]) < $20 then ActiveListLevel.NumberingFormat.AddItem(Ord(S[1]), '') else ActiveListLevel.NumberingFormat.AddItem(-1, S); end; end; end; procedure TKMemoRTFReader.ApplyFont(ATextStyle: TKMemoTextStyle; AFontIndex: Integer); var Font: TFont; begin Font := FFontTable.GetFont(AFontIndex); if Font <> nil then begin ATextStyle.Font.Name := Font.Name; ATextStyle.Font.Charset := Font.Charset; ATextStyle.Font.Pitch := Font.Pitch; end; end; procedure TKMemoRTFReader.ApplyHighlight(ATextStyle: TKMemoTextStyle; AHighlightCode: Integer); var Color: TColor; begin Color := HighlightCodeToColor(AHighlightCode); if Color <> clNone then ATextStyle.Brush.Color := Color else ATextStyle.Brush.Style := bsClear; end; procedure TKMemoRTFReader.FlushColor; begin if FActiveColor <> nil then FColorTable.Add(FActiveColor) else FColorTable.Add(ActiveColor); FActiveColor := nil; end; procedure TKMemoRTFReader.FlushContainer; begin if FActiveContainer <> nil then begin FActiveBlocks := FActiveContainer.ParentBlocks; FAtIndex := FIndexStack.PopValue; FActiveBlocks.AddAt(FActiveContainer, FAtIndex); Inc(FAtIndex); FActiveContainer := nil; end; end; procedure TKMemoRTFReader.FlushFont; begin if FActiveFont <> nil then begin FFontTable.Add(FActiveFont); FActiveFont := nil; end; end; procedure TKMemoRTFReader.FlushHyperlink; begin FlushText; FActiveURL := ''; end; procedure TKMemoRTFReader.FlushImage; begin if FActiveImage <> nil then begin FActiveBlocks.AddAt(FActiveImage, FAtIndex); Inc(FAtIndex); FActiveImage := nil; end; end; procedure TKMemoRTFReader.FlushList; begin if FActiveList <> nil then begin if FActiveList.Levels.Count > 0 then begin FListTable.Add(FActiveList); FActiveList := nil; end else FreeAndNil(FActiveList); end; end; procedure TKMemoRTFReader.FlushListLevel; var NFItem: TKMemoNumberingFormatItem; S: TKString; begin if FActiveListLevel <> nil then begin // fixup numbering format FActiveListLevel.NumberingFormat.Delete(0); // first item should be length, remove it NFItem := FActiveListLevel.NumberingFormat[FActiveListLevel.NumberingFormat.Count - 1]; S := NFItem.Text; // last item should be string and end with a semicolon, remove it if S[Length(S)] = ';' then begin System.Delete(S, Length(S), 1); NFItem.Text := S; end; ActiveList.Levels.Add(FActiveListLevel); FActiveListLevel := nil; end; end; procedure TKMemoRTFReader.FlushListOverride; begin if FActiveListOverride <> nil then begin FListTable.Overrides.Add(FActiveListOverride); FActiveListOverride := nil; end; end; procedure TKMemoRTFReader.FlushParagraph; var PA: TKMemoParagraph; begin PA := FActiveBlocks.AddParagraph(FAtIndex); PA.TextStyle.Assign(FActiveState.TextStyle); PA.ParaStyle.Assign(FActiveState.ParaStyle); Inc(FAtIndex); FActiveParaBorder := alNone; end; procedure TKMemoRTFReader.FlushShape; var State: TKMemoRTFState; begin if FActiveShape <> nil then begin case FActiveShape.ContentType of sctImage: begin // image was inside shape if FActiveImage <> nil then begin // position always relative FActiveImage.Position := mbpRelative; // shape positioning tags override the image size/scale tags (MS Word behavior) if FActiveShape.ContentPosition.Width > 0 then FActiveImage.ScaleX := MulDiv(FActiveShape.ContentPosition.Width, 100, FActiveImage.NativeOrExplicitWidth); if FActiveShape.ContentPosition.Height > 0 then FActiveImage.ScaleY := MulDiv(FActiveShape.ContentPosition.Height, 100, FActiveImage.NativeOrExplicitHeight); if FActiveShape.HorzPosCode = 2 then FActiveImage.LeftOffset := FActiveShape.ContentPosition.Left; if FActiveShape.VertPosCode = 2 then FActiveImage.TopOffset := FActiveShape.ContentPosition.Top; FActiveImage.ImageStyle.Assign(FActiveShape.Style); FlushImage; end; end; sctRectangle: begin // currently only document background supported, look if it is the case State := FStack.Peek; if (State <> nil) and (State.Group = rgPageBackground) then begin if FActiveShape.FillBlip then begin if FActiveImage <> nil then begin if FMemo <> nil then FMemo.Background.Image.Assign(FActiveImage.Image); FreeAndNil(FActiveImage); end; end else if FMemo <> nil then FMemo.Colors.BkGnd := FActiveShape.Style.Brush.Color; end; end; sctTextBox: begin if FActiveContainer <> nil then begin // container was inside shape ActiveContainer.Position := mbpRelative; ActiveContainer.Clip := True; ActiveContainer.FixedWidth := True; if not FActiveShape.FitToText then ActiveContainer.FixedHeight := True; if FActiveShape.HorzPosCode = 2 then ActiveContainer.LeftOffset := FActiveShape.ContentPosition.Left; if FActiveShape.VertPosCode = 2 then ActiveContainer.TopOffset := FActiveShape.ContentPosition.Top; ActiveContainer.RequiredWidth := FActiveShape.ContentPosition.Right - FActiveShape.ContentPosition.Left; ActiveContainer.RequiredHeight := FActiveShape.ContentPosition.Bottom - FActiveShape.ContentPosition.Top; ActiveContainer.BlockStyle.Assign(FActiveShape.Style); FlushContainer; end; end; sctText: begin // unformatted text was inside shape FlushText; end; end; FreeAndNil(FActiveShape); end; end; procedure TKMemoRTFReader.FlushTable; begin if FActiveTable <> nil then begin FActiveTable.FixupCellSpanFromRTF; FActiveTable.FixupBorders; FActiveBlocks := FActiveTable.ParentBlocks; FActiveTable.Parent := nil; FActiveTable.UnlockUpdate; FAtIndex := FIndexStack.PopValue; if not FActiveBlocks.InsideOfTable then // no support for nested tables yet begin FActiveBlocks.AddAt(FActiveTable, FAtIndex); Inc(FAtIndex); end else FActiveTable.Free; FActiveTable := nil; FActiveTableRow := nil; FActiveTableCell := nil; end; end; procedure TKMemoRTFReader.FlushText; var Block: TKMemoHyperlink; begin if FActiveText <> nil then begin if FActiveString <> '' then begin FActiveText.InsertString(FActiveString); FActiveString := ''; end; if FActiveText.TextStyle.Font.Name = 'Symbol' then begin FActiveText.TextStyle.Font.Name := 'Arial'; FActiveText.TextStyle.Font.Charset := 0; end; if FActiveURL <> '' then begin TrimWhiteSpaces(FActiveURL, cWordBreaks); Block := TKMemoHyperlink.Create; Block.Assign(FActiveText); Block.URL := FActiveURL; FreeAndNil(FActiveText); FActiveText := Block; end; FActiveBlocks.AddAt(FActiveText, FAtIndex); Inc(FAtIndex); FActiveText := nil; end; end; function TKMemoRTFReader.GetActiveColor: TKMemoRTFColor; begin if FActiveColor = nil then FActiveColor := TKMemoRTFColor.Create; Result := FActiveColor; end; function TKMemoRTFReader.GetActiveContainer: TKMemoContainer; begin if FActiveContainer = nil then FActiveContainer := TKMemoContainer.Create; Result := FActiveContainer; end; function TKMemoRTFReader.GetActiveFont: TKMemoRTFFont; begin if FActiveFont = nil then FActiveFont := TKMemoRTFFont.Create; Result := FActiveFont; end; function TKMemoRTFReader.GetActiveImage: TKMemoImageBlock; begin if FActiveImage = nil then FActiveImage := TKMemoImageBlock.Create; Result := FActiveImage; end; function TKMemoRTFReader.GetActiveList: TKMemoRTFList; begin if FActiveList = nil then FActiveList := TKMemoRTFList.Create(nil); Result := FActiveList; end; function TKMemoRTFReader.GetActiveListLevel: TKMemoRTFListLevel; begin if FActiveListLevel = nil then FActiveListLevel := TKMemoRTFListLevel.Create; Result := FActiveListLevel; end; function TKMemoRTFReader.GetActiveListOverride: TKMemoDictionaryItem; begin if FActiveListOverride = nil then FActiveListOverride := TKMemoDictionaryItem.Create; Result := FActiveListOverride; end; function TKMemoRTFReader.GetActiveShape: TKMemoRTFShape; begin if FActiveShape = nil then FActiveShape := TKMemoRTFShape.Create; Result := FActiveShape; end; function TKMemoRTFReader.GetActiveTable: TKMemoTable; begin if FActiveTable = nil then FActiveTable := TKMemoTable.Create; Result := FActiveTable; end; function TKMemoRTFReader.HighlightCodeToColor(AValue: Integer): TColor; begin // it seems that highlight color is taken from color table, is it correct? case AValue of 1: Result := clBlack; 2: Result := clBlue; 3: Result := clAqua; // cyan 4: Result := clLime; // green 5: Result := clFuchsia; // magenta 6: Result := clRed; 7: Result := clYellow; 9: Result := clNavy; 10: Result := clTeal; // dark cyan 11: Result := clGreen; // dark green 12: Result := clPurple; // dark magenta 13: Result := clMaroon; // dark red 14: Result := clOlive; // dark yellow 15: Result := clGray; // dark gray 16: Result := clSilver; // light gray else Result := clNone; end; end; procedure TKMemoRTFReader.LoadFromFile(const AFileName: TKString; AActiveBlocks: TKMemoBlocks; AtIndex: TKMemoSelectionIndex); var Stream: TMemoryStream; begin if FileExists(AFileName) then begin Stream := TMemoryStream.Create; try Stream.LoadFromFile(AFileName); LoadFromStream(Stream, AActiveBlocks, AtIndex); finally Stream.Free; end; end; end; procedure TKMemoRTFReader.LoadFromStream(AStream: TStream; AActiveBlocks: TKMemoBlocks; AtIndex: TKMemoSelectionIndex); begin try if AActiveBlocks <> nil then begin FActiveBlocks := AActiveBlocks.SplitForInsert(AtIndex, FAtIndex); FActiveBlocks.LockUpdate; try FActiveColor := nil; FActiveContainer := nil; FActiveFont := nil; FActiveImage := nil; FActiveImageClass := nil; FActiveList := nil; FActiveListLevel := nil; FActiveListOverride := nil; FActiveParaBorder := alNone; FActiveShape := nil; FActiveState := TKMemoRTFState.Create; FActiveState.Group := rgUnknown; // we wait for file header if FMemo <> nil then begin FActiveState.ParaStyle.Assign(FMemo.ParaStyle); FActiveState.TextStyle.Assign(FMemo.TextStyle); end; FActiveString := ''; FActiveTable := nil; FActiveTableBorder := alNone; FActiveTableCell := nil; FActiveTableCol := -1; FActiveTableColCount := 0; FActiveTableRow := nil; FActiveText := nil; FColorTable.Clear; FDefaultFontIndex := 0; FIgnoreChars := 0; FStream := AStream; try ReadStream; finally FlushText; FlushShape; FlushImage; FlushTable; FActiveState.Free; if FMemo <> nil then FListTable.AssignToListTable(FMemo.ListTable, FFontTable); FActiveBlocks.ConcatEqualBlocks; FActiveBlocks.FixEmptyBlocks; end; finally FActiveBlocks.UnlockUpdate; end; end; except KFunctions.Error(sErrMemoLoadFromRTF); end; end; function TKMemoRTFReader.ParamToBool(const AValue: AnsiString): Boolean; begin Result := Boolean(StrToIntDef(string(AValue), 0)); end; function TKMemoRTFReader.ParamToColor(const AValue: AnsiString): TColor; begin Result := ColorRecToColor(MakeColorRec(StrToIntDef(string(AValue), 0))); end; function TKMemoRTFReader.ParamToEMU(const AValue: AnsiString): Integer; begin Result := EMUToPoints(StrToIntDef(string(AValue), 0)); end; function TKMemoRTFReader.ParamToInt(const AValue: AnsiString): Integer; begin Result := StrToIntDef(string(AValue), 0); end; procedure TKMemoRTFReader.PopFromStack(ACtrl: Integer; var AText: AnsiString; AParam: Integer); var State: TKMemoRTFState; begin State := FStack.Peek; if State <> nil then begin // flush shapes, images and other embedded objects to memo if FActiveState.Group = rgShape then begin // standard shape group FlushShape end else if FActiveState.Group = rgShapePict then begin // image inside of shppict group (Word 97 and newer images) FlushText; if FActiveImage <> nil then begin if FActiveShape <> nil then FActiveImage.ImageStyle.Assign(FActiveShape.Style); FlushImage; end; end else if (FActiveState.Group = rgPicture) and (State.Group in [rgNone, rgTextBox]) then begin // standalone image outside of shppict and shape group (e.g. results of embedded objects) FlushText; FlushImage; end else if (FActiveState.Group = rgTextBox) and (State.Group = rgShapeInst) then begin // text shape inside of shpinst group FlushText; end else if FActiveState.Group = rgField then begin // we only support hyperlinks now FlushHyperlink; end else if (FActiveState.Group = rgListLevel) and (State.Group = rgList) then begin FlushListLevel; end else if (FActiveState.Group = rgList) and (State.Group = rgListTable) then begin FlushList; end else if (FActiveState.Group = rgListOverride) and (State.Group = rgListOverrideTable) then begin FlushListOverride; end; FActiveState.Free; FActiveState := FStack.Pop; end; end; procedure TKMemoRTFReader.PushToStack(ACtrl: Integer; var AText: AnsiString; AParam: Integer); var State: TKMemoRTFState; begin FStack.Push(FActiveState); State := TKMemoRTFState.Create; State.Assign(FActiveState); FActiveState := State; end; function TKMemoRTFReader.ReadNext(out ACtrl, AText: AnsiString; out AParam: Int64): Boolean; procedure ReadText(var AText: AnsiString; AChar: AnsiChar); begin repeat if (AChar <> cCR) and (AChar <> cLF) then AText := AText + AChar; Result := FStream.Read(AChar, 1) > 0; until CharInSetEx(AChar, ['{', '}', '\']) or not Result; if Result then FStream.Seek(-1, soFromCurrent); end; var C: AnsiChar; ParamStr: AnsiString; Code: Integer; begin AParam := MaxInt; ACtrl := ''; AText := ''; Result := FStream.Read(C, 1) > 0; if C = '\' then begin FStream.Read(C, 1); if CharInSetEx(C, cLetters) then begin // control word repeat ACtrl := ACtrl + C; Result := FStream.Read(C, 1) > 0; until not (Result and CharInSetEx(C, cLetters)); if (C = '-') or CharInSetEx(C, cNumbers) then begin // control word parameter ParamStr := ''; repeat ParamStr := ParamStr + C; Result := FStream.Read(C, 1) > 0; until not (Result and CharInSetEx(C, cNumbers)); AParam := StrToIntDef(TKString(ParamStr), 0); if Result and (C <> ' ') then FStream.Seek(-1, soFromCurrent); end else if Result and (C <> ' ') then FStream.Seek(-1, soFromCurrent); end else begin ACtrl := C; //control symbol if C = '''' then begin //hexadecimal value - special symbol SetLength(ParamStr, 2); Result := FStream.Read(ParamStr[1], 2) = 2; if Result then AParam := HexStrToInt(string(ParamStr), Length(ParamStr), False, Code); end else if CharInSetEx(C, ['{', '}', '\']) then begin AText := C; // control symbol is printable character ACtrl := ''; end; end; if FStream.Read(C, 1) > 0 then begin if CharInSetEx(C, ['{', '}', '\']) then FStream.Seek(-1, soFromCurrent) else ReadText(AText, C); end; end else if CharInSetEx(C, ['{', '}', ';']) then ACtrl := C // group else ReadText(AText, C); end; procedure TKMemoRTFReader.ReadColorGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); begin if FActiveState.Group = rgColorTable then begin case TKMemoRTFColorProp(ACtrl) of rpcRed: ActiveColor.Red := Byte(AParam); rpcGreen: ActiveColor.Green := Byte(AParam); rpcBlue: ActiveColor.Blue := Byte(AParam); end; if AText = ';' then begin FlushColor; AText := ''; // we used the text as end of the color record end; end; end; procedure TKMemoRTFReader.ReadDocumentGroups(ACtrl: Integer; var AText: AnsiString; AParam: Integer); begin if FActiveState.Group = rgNone then case TKMemoRTFDocumentProp(ACtrl) of rpdFooter, rpdFooterLeft, rpdFooterRight: FActiveState.Group := rgFooter; rpdHeader, rpdHeaderLeft, rpdHeaderRight: FActiveState.Group := rgHeader; rpdInfo: FActiveState.Group := rgInfo; end; end; procedure TKMemoRTFReader.ReadFieldGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); begin case TKMemoRTFFieldProp(ACtrl) of rpfiField: begin FlushText; FActiveState.Group := rgField; end; rpfiResult: begin FlushText; FActiveState.Group := rgFieldResult; end else case FActiveState.Group of rgFieldInst: begin if AText <> '' then begin if Pos(cRTFHyperlink, string(AText)) = 1 then begin Delete(AText, 1, Length(cRTFHyperlink)); FActiveURL := TKString(AText); end else begin if FActiveURL <> '' then FActiveURL := FActiveURL + TKString(AText); end; AText := ''; end; end; end; end; end; procedure TKMemoRTFReader.ReadFontGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); var I: Integer; S: TKString; begin case FActiveState.Group of rgFontTable: begin case TKMemoRTFFontProp(ACtrl) of rpfIndex: ActiveFont.FFontIndex := AParam; rpfCharSet: ActiveFont.Font.Charset := AParam; rpfPitch: begin case AParam of 1: ActiveFont.Font.Pitch := fpFixed; 2: ActiveFont.Font.Pitch := fpVariable; else ActiveFont.Font.Pitch := fpDefault; end; end; end; if AText <> '' then begin S := TKString(AText); I := Pos(';', S); if I > 0 then Delete(S, I, 1); ActiveFont.Font.Name := S; FlushFont; AText := ''; // we used the text as font name end end; rgNone, rgTextBox, rgFieldResult: begin case TKMemoRTFFontProp(ACtrl) of rpfIndex: ReadTextFormatting(Integer(rptFontIndex), AText, AParam); end; end; rgListLevel: begin case TKMemoRTFFontProp(ACtrl) of rpfIndex: ReadListGroup(Integer(rplLevelFontIndex), AText, AParam); end; end; end; end; procedure TKMemoRTFReader.ReadHeaderGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); begin if FActiveState.Group = rgUnknown then begin case TKMemoRTFheaderProp(ACtrl) of rphRtf: FActiveState.Group := rgNone; end; end else if FActiveState.Group = rgNone then case TKMemoRTFheaderProp(ACtrl) of rphCodePage: FDefaultCodePage := AParam; rphDefaultFont: FDefaultFontIndex := AParam; rphIgnoreCharsAfterUnicode: FIgnoreCharsAfterUnicode := AParam; rphFontTable: FActiveState.Group := rgFontTable; rphColorTable: FActiveState.Group := rgColorTable; rphStyleSheet: FActiveState.Group := rgStyleSheet; end; end; procedure TKMemoRTFReader.ReadListGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); begin case FActiveState.Group of rgListTable: case TKMemoRTFListProp(ACtrl) of rplList: FActiveState.Group := rgList; end; rgList: case TKMemoRTFListProp(ACtrl) of rplListLevel: FActiveState.Group := rgListLevel; rplListId: ActiveList.ID := AParam; end; rgListLevel: case TKMemoRTFListProp(ACtrl) of rplLevelText: FActiveState.Group := rgListLevelText; rplLevelStartAt: ActiveListLevel.StartAt := AParam; rplLevelNumberType: ActiveListLevel.NumberType := AParam; rplLevelJustify: ActiveListLevel.Justify := AParam; rplLevelFontIndex: ActiveListLevel.FontIndex := AParam; rplLevelFirstIndent: ActiveListLevel.FirstIndent := TwipsToPixelsX(AParam); rplLevelLeftIndent: ActiveListLevel.LeftIndent := TwipsToPixelsX(AParam); end; rgListOverrideTable: case TKMemoRTFListProp(ACtrl) of rplListOverride: FActiveState.Group := rgListOverride; end; rgListOverride: case TKMemoRTFListProp(ACtrl) of rplListId: ActiveListOverride.Value := AParam; rplListIndex: ActiveListOverride.Index := AParam; end; rgListLevelText: AddTextToNumberingFormat(string(AText)); else case TKMemoRTFListProp(ACtrl) of rplListText, rplPnText: FActiveState.Group := rgUnknown; // ignore text // Note: ignore old Word 95 'pntext' tag as well. We do not support // old Word 95 numbering style (so IMO it should not be ignored) // but some documents mix '\pntext' with '\lsN' control words. // This has the effect that the numbering is displayed twice if '\pntext' // is not ignored. end; end; end; procedure TKMemoRTFReader.ReadParaFormatting(ACtrl: Integer; var AText: AnsiString; AParam: Integer); begin case FActiveState.Group of rgNone, rgTextBox, rgFieldResult: case TKMemoRTFParaProp(ACtrl) of rppParD: if FMemo <> nil then FActiveState.ParaStyle.Assign(FMemo.ParaStyle); rppIndentFirst: FActiveState.ParaStyle.FirstIndent := TwipsToPixelsX(AParam); rppIndentBottom: FActiveState.ParaStyle.BottomPadding := TwipsToPixelsY(AParam); rppIndentLeft: FActiveState.ParaStyle.LeftPadding := TwipsToPixelsX(AParam); rppIndentRight: FActiveState.ParaStyle.RightPadding := TwipsToPixelsX(AParam); rppIndentTop: FActiveState.ParaStyle.TopPadding := TwipsToPixelsY(AParam); rppAlignLeft: FActiveState.ParaStyle.HAlign := halLeft; rppAlignCenter: FActiveState.ParaStyle.HAlign := halCenter; rppAlignRight: FActiveState.ParaStyle.HAlign := halRight; rppAlignJustify: FActiveState.ParaStyle.HAlign := halJustify; rppBackColor: FActiveState.ParaStyle.Brush.Color := FColorTable.GetColor(AParam); rppNoWordWrap: FActiveState.ParaStyle.WordWrap := False; rppBorderBottom: FActiveParaBorder := alBottom; rppBorderLeft: FActiveParaBorder := alLeft; rppBorderRight: FActiveParaBorder := alRight; rppBorderTop: FActiveParaBorder := alTop; rppBorderAll: FActiveParaBorder := alClient; rppBorderWidth: case FActiveParaBorder of alBottom: FActiveState.ParaStyle.BorderWidths.Bottom := TwipsToPixelsY(AParam); alLeft: FActiveState.ParaStyle.BorderWidths.Left := TwipsToPixelsX(AParam); alRight: FActiveState.ParaStyle.BorderWidths.Right := TwipsToPixelsX(AParam); alTop: FActiveState.ParaStyle.BorderWidths.Top := TwipsToPixelsY(AParam); alClient: FActiveState.ParaStyle.BorderWidth := TwipsToPixelsX(AParam); else if FActiveTableBorder <> alNone then ReadTableFormatting(Integer(rptbBorderWidth), AText, AParam) end; rppBorderNone: case FActiveParaBorder of alBottom: FActiveState.ParaStyle.BorderWidths.Bottom := 0; alLeft: FActiveState.ParaStyle.BorderWidths.Left := 0; alRight: FActiveState.ParaStyle.BorderWidths.Right := 0; alTop: FActiveState.ParaStyle.BorderWidths.Top := 0; alClient: FActiveState.ParaStyle.BorderWidth := 0; else if FActiveTableBorder <> alNone then ReadTableFormatting(Integer(rptbBorderNone), AText, AParam) end; rppBorderRadius: FActiveState.ParaStyle.BorderRadius := TwipsToPixelsX(AParam); rppBorderColor: begin if FActiveParaBorder <> alNone then FActiveState.ParaStyle.BorderColor := FColorTable.GetColor(AParam) else if FActiveTableBorder <> alNone then ReadTableFormatting(Integer(rptbBorderColor), AText, AParam) end; rppLineSpacing: begin FActiveState.ParaStyle.LineSpacingValue := TwipsToPixelsY(AParam); FActiveState.ParaStyle.LineSpacingFactor := AParam / 240; end; rppLineSpacingMode: begin if AParam = 0 then FActiveState.ParaStyle.LineSpacingMode := lsmValue else FActiveState.ParaStyle.LineSpacingMode := lsmFactor end; rppPar: begin FlushText; FlushParagraph; end; rppListIndex: FActiveState.ParaStyle.NumberingList := FListTable.IDByIndex(AParam); rppListLevel: FActiveState.ParaStyle.NumberingListLevel := AParam; rppListStartAt: FActiveState.ParaStyle.NumberStartAt := AParam; end; rgListLevel: case TKMemoRTFParaProp(ACtrl) of rppIndentFirst: ReadListgroup(Integer(rplLevelFirstIndent), AText, AParam); rppIndentLeft: ReadListgroup(Integer(rplLevelLeftIndent), AText, AParam); end; rgListOverride: case TKMemoRTFParaProp(ACtrl) of rppListIndex: ReadListgroup(Integer(rplListIndex), AText, AParam); end; end; end; procedure TKMemoRTFReader.ReadPictureGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); var S: AnsiString; MS: TMemoryStream; Image: TGraphic; Tmp: Integer; begin if FActiveState.Group in [rgShapeInst, rgShapePict, rgNone, rgTextBox] then begin case TKMemoRTFImageProp(ACtrl) of rpiPict: begin FActiveState.Group := rgPicture; end; end; end else if FActiveState.Group in [rgPicture] then begin case TKMemoRTFImageProp(ACtrl) of rpiJPeg: FActiveImageClass := TJpegImage; {$IFDEF USE_PNG_SUPPORT} rpiPng: FActiveImageClass := TKPngImage; {$ENDIF} {$IFDEF MSWINDOWS} rpiEmf: begin FActiveImageClass := TKMetafile; FActiveImageIsEMF := True; end; rpiWmf: begin FActiveImageClass := TKMetafile; FActiveImageIsEMF := False; end; {$ENDIF} rpiWidth: ActiveImage.ExplicitWidth := TwipsToPixelsX(AParam); rpiHeight: ActiveImage.ExplicitHeight := TwipsToPixelsY(AParam); rpiCropBottom: ActiveImage.Crop.Bottom := TwipsToPixelsY(AParam); rpiCropLeft: ActiveImage.Crop.Left := TwipsToPixelsX(AParam); rpiCropRight: ActiveImage.Crop.Right := TwipsToPixelsX(AParam); rpiCropTop: ActiveImage.Crop.Top := TwipsToPixelsY(AParam); rpiScaleX: begin if AParam > 0 then ActiveImage.ScaleX := AParam; end; rpiScaleY: begin if AParam > 0 then ActiveImage.ScaleY := AParam; end; rpiReqWidth: if ActiveImage.ExplicitWidth > 0 then begin Tmp := MulDiv(TwipsToPixelsX(AParam), 100, ActiveImage.ExplicitWidth); if Tmp < ActiveImage.ScaleX then ActiveImage.ScaleX := Tmp; end; rpiReqHeight: if ActiveImage.ExplicitHeight > 0 then begin Tmp := MulDiv(TwipsToPixelsY(AParam), 100, ActiveImage.ExplicitHeight); if Tmp < ActiveImage.ScaleY then ActiveImage.ScaleY := Tmp; end; end; if AText <> '' then begin if FActiveImageClass <> nil then begin S := AText; if DigitsToBinStr(S) then begin S := BinStrToBinary(S); try MS := TMemoryStream.Create; try MS.Write(S[1], Length(S)); MS.Seek(0, soFromBeginning); Image := FActiveImageClass.Create; try {$IFDEF MSWINDOWS} if Image is TKMetafile then begin //if not FActiveImageIsEMF then MS.SaveToFile('test.wmf'); TKMetafile(Image).CopyOnAssign := False; // we will destroy this instance anyway... TKMetafile(Image).Enhanced := FActiveImageIsEMF; TKmetafile(Image).LoadFromStream(MS); if not FActiveImageIsEMF then begin // WMF extent could be incorrect here, so use RTF info TKMetafile(Image).Width := PixelsToTwipsX(ActiveImage.ExplicitWidth); TKMetafile(Image).Height := PixelsToTwipsY(ActiveImage.ExplicitHeight); end; end else {$ENDIF} Image.LoadFromStream(MS); ActiveImage.Image := Image; finally Image.Free; end; finally MS.Free; end; except KFunctions.Error(sErrMemoLoadImageFromRTF); end; end; FActiveImageClass := nil; end; AText := ''; // we used the text as image data end; end; end; procedure TKMemoRTFReader.ReadShapeGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); begin case TKMemoRTFShapeProp(ACtrl) of rpsShape: FActiveState.Group := rgShape; end; if FActiveState.Group in [rgShapeInst, rgShapePict, rgPicProp] then case TKMemoRTFShapeProp(ACtrl) of rpsBottom: ActiveShape.ContentPosition.Bottom := TwipsToPixelsY(AParam); rpsLeft: ActiveShape.ContentPosition.Left := TwipsToPixelsX(AParam); rpsRight: ActiveShape.ContentPosition.Right := TwipsToPixelsX(AParam); rpsTop: ActiveShape.ContentPosition.Top := TwipsToPixelsY(AParam); rpsXColumn: ActiveShape.HorzPosCode := 2; // we silently assume posrelh always comes later rpsYPara: ActiveShape.VertPosCode := 2; // we silently assume posrelv always comes later rpsWrap: ActiveShape.Wrap := AParam; rpsWrapSide: ActiveShape.WrapSide := AParam; rpsSn: ActiveShape.CtrlName := AText; rpsSv: begin ActiveShape.CtrlValue := AText; // do different things according to CtrlName property if ActiveShape.CtrlName = 'posrelh' then begin ActiveShape.HorzPosCode := ParamToInt(AText); end else if ActiveShape.CtrlName = 'posrelv' then begin ActiveShape.VertPosCode := ParamToInt(AText); end else if ActiveShape.CtrlName = 'fFitShapeToText' then ActiveShape.FitToText := True else if ActiveShape.CtrlName = 'fFitTextToShape' then ActiveShape.FitToShape := True else if ActiveShape.CtrlName = 'fFilled' then begin if not ParamToBool(AText) then ActiveShape.Style.Brush.Style := bsClear; end else if ActiveShape.CtrlName = 'fillColor' then ActiveShape.Style.Brush.Color := ParamToColor(AText) else if ActiveShape.CtrlName = 'fillBlip' then ActiveShape.FillBlip := True else if ActiveShape.CtrlName = 'fLine' then begin if not ParamToBool(AText) then ActiveShape.Style.BorderWidth := 0; end else if ActiveShape.CtrlName = 'lineColor' then ActiveShape.Style.BorderColor := ParamToColor(AText) else if ActiveShape.CtrlName = 'lineWidth' then ActiveShape.Style.BorderWidth := ParamToEMU(AText) else if ActiveShape.CtrlName = 'shapeType' then begin // supported shape types case StrToIntDef(string(ActiveShape.CtrlValue), 0) of 1: ActiveShape.ContentType := sctRectangle; 75: ActiveShape.ContentType := sctImage; 202: begin ActiveShape.ContentType := sctTextBox; ActiveShape.Style.ContentPadding.AssignFromValues(5, 5, 5, 5); //default padding for text box end; end; end; end; rpsShapeText: begin // this keyword starts the actual text box contents FlushText; ActiveContainer.Parent := FActiveBlocks; FActiveBlocks := ActiveContainer.Blocks; FIndexStack.PushValue(FAtIndex); FAtIndex := 0; FActiveState.Group := rgTextBox; end; end; end; procedure TKMemoRTFReader.ReadSpecialCharacter(ACtrl: Integer; var AText: AnsiString; AParam: Integer); var S: TKString; CodePage: Integer; SetIgnoreChars: Boolean; begin SetIgnoreChars := False; S := ''; // we must suppose here selected font supports these Unicode characters case TKMemoRTFSpecialCharProp(ACtrl) of rpscTab: S := #9; // tab is rendered with an arrow symbol rpscLquote: S := UnicodeToNativeUTF(#$2018); rpscRQuote: S := UnicodeToNativeUTF(#$2019); rpscLDblQuote: S := UnicodeToNativeUTF(#$201C); rpscRDblQuote: S := UnicodeToNativeUTF(#$201D); rpscEnDash: S := UnicodeToNativeUTF(#$2013); rpscEmDash: S := UnicodeToNativeUTF(#$2014); rpscBullet: S := UnicodeToNativeUTF(#$2022); rpscNBSP: S := ' '; // nonbreaking spaces not supported rpscEmSpace: S := ' '; rpscEnSpace: S := ' '; rpscAnsiChar: begin if AParam < $20 then S := Chr(AParam) else begin if FActiveState.TextStyle.Font.Name = 'Symbol' then S := UnicodeToNativeUTF(WideChar(AdobeSymbolToUTF16(AParam))) else begin if FActiveState.TextStyle.Font.Charset = 0 then CodePage := FDefaultCodePage else CodePage := CharSetToCP(FActiveState.TextStyle.Font.Charset); S := AnsiStringToString(AnsiChar(AParam), CodePage); end; end; end; rpscUnicodeChar: begin S := UnicodeToNativeUTF(WideChar(AParam)); SetIgnoreChars := True; end; end; case FActiveState.Group of rgNone, rgTextBox, rgFieldResult: AddText(S); rgListLevelText: AddTextToNumberingFormat(S); end; if SetIgnoreChars and (FActiveState.Group <> rgUnknown) then FIgnoreChars := FIgnoreCharsAfterUnicode; end; procedure TKMemoRTFReader.ReadStream; var Ctrl: AnsiString; Text: AnsiString; Param: Int64; CtrlItem: TKMemoRTFCtrl; begin while FStream.Position < FStream.Size do begin ReadNext(Ctrl, Text, Param); if (Ctrl <> '') or (Text <> '') then begin if Ctrl <> '' then begin CtrlItem := FCtrlTable.FindByCtrl(Ctrl); if CtrlItem <> nil then CtrlItem.Method(CtrlItem.Code, Text, Param); end; if Text <> '' then begin // if Method did not use Text use it according to active group case FActiveState.Group of rgColorTable: ReadColorGroup(Integer(rpcNone), Text, 0); rgFieldInst: ReadFieldGroup(Integer(rpfiNone), Text, 0); rgFontTable: ReadFontGroup(Integer(rpfNone), Text, 0); rgPicture: ReadPictureGroup(Integer(rpiNone), Text, 0); rgListLevelText: ReadListGroup(Integer(rplNone), Text, 0); rgNone, rgTextBox, rgFieldResult: AddText(TKString(Text)); end; end; end; end; end; procedure TKMemoRTFReader.ReadTableFormatting(ACtrl: Integer; var AText: AnsiString; AParam: Integer); var I, Value: Integer; Cell: TKMemoTableCell; begin if FActiveState.Group in [rgNone, rgTextBox] then case TKMemoRTFTableProp(ACtrl) of rptbRowBegin: begin if FActiveTableColCount = 0 then begin FlushText; if FActiveTable = nil then begin ActiveTable.LockUpdate; ActiveTable.Parent := FActiveBlocks; // needs a parent to correctly update ActiveTable.RowCount := 1; ActiveTable.ColCount := 1; FActiveTableColCount := 1; FActiveTableRow := ActiveTable.Rows[ActiveTable.RowCount - 1]; FActiveBlocks := FActiveTableRow.Cells[FActiveTableColCount - 1].Blocks; // starting new cell FIndexStack.PushValue(FAtIndex); FAtIndex := 0; FActiveTableCellXPos := 0; FActiveTableLastRow := False; end; end else if (FActiveTableRow <> nil) and (FActiveTableRow.CellCount > 1) then begin // this block comes again after definition of the row and is used to read row/cell properties (at least Word saves this) // we don't support reading cell properties before entire row is defined with /cell control words FActiveTableCol := 0; FActiveTableCell := FActiveTableRow.Cells[FActiveTableCol]; end end; rptbCellEnd: if FActiveTableRow <> nil then begin FlushText; Cell := FActiveTableRow.Cells[FActiveTableColCount - 1]; Cell.ParaStyle.Assign(FActiveState.ParaStyle); Inc(FActiveTableColCount); FActiveTableRow.CellCount := FActiveTableColCount; FActiveBlocks := FActiveTableRow.Cells[FActiveTableColCount - 1].Blocks; // starting new cell FAtIndex := 0; end; rptbRowEnd: if FActiveTableRow <> nil then begin // delete previously started cell if empty if FActiveTableRow.Cells[FActiveTableColCount - 1].Blocks.Count = 0 then FActiveTableRow.CellCount := FActiveTableRow.CellCount - 1; if FActiveTableLastRow then begin FlushTable; FActiveTableLastRow := False; FActiveTableColCount := 0; end else begin ActiveTable.RowCount := ActiveTable.RowCount + 1; ActiveTable.ColCount := Max(ActiveTable.ColCount, FActiveTableRow.CellCount); FActiveTableRow := ActiveTable.Rows[ActiveTable.RowCount - 1]; FActiveTableColCount := 1; FActiveTableRow.CellCount := FActiveTableColCount; FActiveBlocks := FActiveTableRow.Cells[FActiveTableColCount - 1].Blocks; // starting new cell FAtIndex := 0; FActiveTableCellXPos := 0; end; FActiveTableCol := -1; FActiveTableCell := nil; FActiveTableBorder := alNone; end; rptbLastRow: FActiveTableLastRow := True; end; // read row/cell formatting (if any) if (FActiveTableRow <> nil) and (FActiveTableCell <> nil) then case TKMemoRTFTableProp(ACtrl) of rptbPaddAll: begin // we silently assume this will come before other rptbRowPaddxx ctrls Value := TwipsToPixelsX(AParam); for I := 0 to FActiveTableRow.CellCount - 1 do FActiveTableRow.Cells[I].BlockStyle.ContentPadding.AssignFromValues(Value, Value, Value, Value); end; rptbRowPaddBottom: begin FActiveTableRowPadd.Bottom := TwipsToPixelsY(AParam); for I := 0 to FActiveTableRow.CellCount - 1 do FActiveTableRow.Cells[I].BlockStyle.BottomPadding := FActiveTableRowPadd.Bottom; end; rptbRowPaddLeft: begin FActiveTableRowPadd.Left := TwipsToPixelsX(AParam); for I := 0 to FActiveTableRow.CellCount - 1 do FActiveTableRow.Cells[I].BlockStyle.LeftPadding := FActiveTableRowPadd.Left; end; rptbRowPaddRight: begin FActiveTableRowPadd.Right := TwipsToPixelsX(AParam); for I := 0 to FActiveTableRow.CellCount - 1 do FActiveTableRow.Cells[I].BlockStyle.RightPadding := FActiveTableRowPadd.Right; end; rptbRowPaddTop: begin FActiveTableRowPadd.Top := TwipsToPixelsY(AParam); for I := 0 to FActiveTableRow.CellCount - 1 do FActiveTableRow.Cells[I].BlockStyle.TopPadding := FActiveTableRowPadd.Top; end; rptbBorderBottom: FActiveTableBorder := alBottom; rptbBorderLeft: FActiveTableBorder := alLeft; rptbBorderRight: FActiveTableBorder := alRight; rptbBorderTop: FActiveTableBorder := alTop; rptbBorderWidth: begin case FActiveTableBorder of alBottom: FActiveTableCell.RequiredBorderWidths.Bottom := TwipsToPixelsY(AParam); alLeft: FActiveTableCell.RequiredBorderWidths.Left := TwipsToPixelsX(AParam); alRight: FActiveTableCell.RequiredBorderWidths.Right := TwipsToPixelsX(AParam); alTop: FActiveTableCell.RequiredBorderWidths.Top := TwipsToPixelsY(AParam); end; end; rptbBorderNone: begin case FActiveTableBorder of alBottom: FActiveTableCell.RequiredBorderWidths.Bottom := 0; alLeft: FActiveTableCell.RequiredBorderWidths.Left := 0; alRight: FActiveTableCell.RequiredBorderWidths.Right := 0; alTop: FActiveTableCell.RequiredBorderWidths.Top := 0; end; end; rptbBorderColor: FActiveTableCell.BlockStyle.BorderColor := FColorTable.GetColor(AParam); // no support for different colors for different borders rptbBackColor: FActiveTableCell.BlockStyle.Brush.Color := FColorTable.GetColor(AParam); rptbHorzMerge: FActiveTableCell.ColSpan := 0; // indicate for later fixup rptbVertMerge: FActiveTableCell.RowSpan := 0; // indicate for later fixup rptbCellPaddBottom: FActiveTableCell.BlockStyle.BottomPadding := TwipsToPixelsY(AParam); rptbCellPaddLeft: FActiveTableCell.BlockStyle.LeftPadding := TwipsToPixelsX(AParam); rptbCellPaddRight: FActiveTableCell.BlockStyle.RightPadding := TwipsToPixelsX(AParam); rptbCellPaddTop: FActiveTableCell.BlockStyle.TopPadding := TwipsToPixelsY(AParam); rptbCellWidth: begin FActiveTableCell.FixedWidth := True; FActiveTableCell.RequiredWidth := TwipsToPixelsX(AParam); end; rptbCellX: begin // this command comes as the last for current cell Value := FActiveTableCellXPos; FActiveTableCellXPos := TwipsToPixelsX(AParam); FActiveTableCell.RequiredWidth := FActiveTableCellXPos - Value; Inc(FActiveTableCol); if FActiveTableCol < FActiveTableRow.CellCount then FActiveTableCell := FActiveTableRow.Cells[FActiveTableCol] else FActiveTableCell := nil; // error in RTF, ignore next properties end; end; end; procedure TKMemoRTFReader.ReadTextFormatting(ACtrl: Integer; var AText: AnsiString; AParam: Integer); begin if FActiveState.Group in [rgNone, rgTextBox, rgFieldResult] then case TKMemoRTFTextProp(ACtrl) of rptPlain: begin if FMemo <> nil then FActiveState.TextStyle.Assign(FMemo.TextStyle); end; rptFontIndex: ApplyFont(FActiveState.TextStyle, AParam); rptBold: begin if AParam = 0 then FActiveState.TextStyle.Font.Style := FActiveState.TextStyle.Font.Style - [fsBold] else FActiveState.TextStyle.Font.Style := FActiveState.TextStyle.Font.Style + [fsBold]; end; rptItalic: begin if AParam = 0 then FActiveState.TextStyle.Font.Style := FActiveState.TextStyle.Font.Style - [fsItalic] else FActiveState.TextStyle.Font.Style := FActiveState.TextStyle.Font.Style + [fsItalic]; end; rptUnderline: begin if AParam = 0 then FActiveState.TextStyle.Font.Style := FActiveState.TextStyle.Font.Style - [fsUnderline] else FActiveState.TextStyle.Font.Style := FActiveState.TextStyle.Font.Style + [fsUnderline]; end; rptStrikeout: begin if AParam = 0 then FActiveState.TextStyle.Font.Style := FActiveState.TextStyle.Font.Style - [fsStrikeout] else FActiveState.TextStyle.Font.Style := FActiveState.TextStyle.Font.Style + [fsStrikeout]; end; rptCaps: FActiveState.TextStyle.Capitals := tcaNormal; rptSmallCaps: FActiveState.TextStyle.Capitals := tcaSmall; rptFontSize: FActiveState.TextStyle.Font.Size := DivUp(AParam, 2); rptForeColor: FActiveState.TextStyle.Font.Color := FColorTable.GetColor(AParam); rptBackColor: FActiveState.TextStyle.Brush.Color := FColorTable.GetColor(AParam); rptSubscript: FActiveState.TextStyle.ScriptPosition := tpoSubscript; rptSuperscript: FActiveState.TextStyle.ScriptPosition := tpoSuperscript; end; end; procedure TKMemoRTFReader.ReadUnknownGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); begin if not (FActiveState.Group in [rgInfo, rgHeader, rgFooter]) then case TKMemoRTFUnknownProp(ACtrl) of rpuUnknownSym: FActiveState.Group := rgUnknown; rpuNonShapePict: FActiveState.Group := rgUnknown; // we ignore this picture end; if FActiveState.Group = rgUnknown then case TKMemoRTFUnknownProp(ACtrl) of rpuFieldInst: FActiveState.Group := rgFieldInst; // field inside text rpuShapeInst: FActiveState.Group := rgShapeInst; // picture inside text rpuShapePict: FActiveState.Group := rgShapePict; // picture inside text rpuPageBackground: FActiveState.Group := rgPageBackground; // this is the page background, read it rpuPicProp: FActiveState.Group := rgPicProp; // non shape picture has some shape properties, read them rpuListTable: FActiveState.Group := rgListTable; rpuListOverrideTable: FActiveState.Group := rgListOverrideTable; end; end; { TKMemoRTFWriter } constructor TKMemoRTFWriter.Create(AMemo: TKCustomMemo); begin inherited; FGroupLevel := 0; FReadableOutput := False; FColorTable := TKMemoRTFColorTable.Create; FFontTable := TKMemoRTFFontTable.Create; FListTable := TKMemoRTFListTable.Create; FSelectedOnly := False; FStream := nil; end; destructor TKMemoRTFWriter.Destroy; begin FColorTable.Free; FFontTable.Free; FListTable.Free; inherited; end; function TKMemoRTFWriter.BoolToParam(AValue: Boolean): AnsiString; begin Result := AnsiString(IntToStr(Integer(AValue))); end; function TKMemoRTFWriter.CanSave(ABlock: TKMemoBlock): Boolean; begin Result := not FSelectedOnly or (ABlock <> nil) and (ABlock.SelLength > 0); end; function TKMemoRTFWriter.ColorToHighlightCode(AValue: TColor): Integer; begin // we save highlight color as reference to color table, is it correct? case AValue of clBlack: Result := 1; clBlue: Result := 2; clAqua: Result := 3; // cyan clLime: Result := 4; // green clFuchsia: Result := 5; // magenta clRed: Result := 6; clYellow: Result := 7; clNavy: Result := 9; clTeal: Result := 10; // dark cyan clGreen: Result := 11; // dark green clPurple: Result := 12; // dark magenta clMaroon: Result := 13; // dark red clOlive: Result := 14; // dark yellow clGray: Result := 15; // dark gray clSilver: Result := 16; // light gray else Result := 0; end; end; function TKMemoRTFWriter.ColorToParam(AValue: TColor): AnsiString; begin Result := AnsiString(IntToStr(ColorToColorRec(Avalue).Value)); end; function TKMemoRTFWriter.EMUToParam(AValue: Integer): AnsiString; begin Result := AnsiString(IntToStr(PointsToEMU(AValue))); end; procedure TKMemoRTFWriter.FillColorTable(ABlocks: TKMemoBlocks); var I: Integer; Block: TKmemoBlock; begin if ABlocks <> nil then begin for I := 0 to ABlocks.Count - 1 do begin Block := Ablocks[I]; if CanSave(Block) then begin if Block is TKMemoTextBlock then begin FColorTable.AddColor(TKmemoTextBlock(Block).TextStyle.Brush.Color); FColorTable.AddColor(TKmemoTextBlock(Block).TextStyle.Font.Color); if Block is TKMemoParagraph then begin FColorTable.AddColor(TKMemoParagraph(Block).ParaStyle.Brush.Color); FColorTable.AddColor(TKMemoParagraph(Block).ParaStyle.BorderColor); end; end else if Block is TKMemoContainer then begin FColorTable.AddColor(TKmemoContainer(Block).BlockStyle.Brush.Color); FColorTable.AddColor(TKmemoContainer(Block).BlockStyle.BorderColor); if Block is TKMemoTable then begin FColorTable.AddColor(TKmemoTable(Block).CellStyle.Brush.Color); FColorTable.AddColor(TKmemoTable(Block).CellStyle.BorderColor); end; FillColorTable(TKmemoContainer(Block).Blocks); end; end; end; end; end; procedure TKMemoRTFWriter.FillFontTable(ABlocks: TKMemoBlocks); var I: Integer; Block: TKmemoBlock; begin if ABlocks <> nil then begin for I := 0 to ABlocks.Count - 1 do begin Block := Ablocks[I]; if CanSave(Block) then begin if Block is TKMemoTextBlock then FFontTable.AddFont(TKmemoTextBlock(Block).TextStyle.Font) else if Block is TKmemoContainer then FillFontTable(TKmemoContainer(Block).Blocks); end; end; end; end; procedure TKMemoRTFWriter.SaveToFile(const AFileName: TKString; ASelectedOnly: Boolean); var Stream: TMemoryStream; begin Stream := TMemoryStream.Create; try SaveToStream(Stream, ASelectedOnly); Stream.SaveToFile(AFileName); finally Stream.Free; end; end; procedure TKMemoRTFWriter.SaveToStream(AStream: TStream; ASelectedOnly: Boolean; AActiveBlocks: TKMemoBlocks); var ActiveBlocks, Blocks1, Blocks2, SavedBlocks1: TKMemoBlocks; LocalIndex: TKMemoSelectionIndex; begin try FStream := AStream; FSelectedOnly := ASelectedOnly; if AActiveBlocks <> nil then ActiveBlocks := AActiveBlocks else ActiveBlocks := FMemo.ActiveBlocks; if ActiveBlocks <> nil then begin if FSelectedOnly then begin // find common parent blocks for the selection and use this instead of main blocks Blocks1 := ActiveBlocks.IndexToBlocks(ActiveBlocks.SelStart, LocalIndex); Blocks2 := ActiveBlocks.IndexToBlocks(ActiveBlocks.SelEnd, LocalIndex); SavedBlocks1 := Blocks1; while Blocks1 <> Blocks2 do begin Blocks1 := Blocks1.ParentBlocks; if Blocks1 = nil then begin Blocks2 := Blocks2.ParentBlocks; if Blocks2 <> nil then Blocks1 := SavedBlocks1; end; end; // If the parent blocks are maintained by a container (eg. a table) which // is placed in the text then take the outermost non-container blocks placed in the text // or a container with relative or absolute position. while (Blocks1.Parent is TKMemoContainer) and (Blocks1.Parent.Position = mbpText) do Blocks1 := Blocks1.ParentBlocks; ActiveBlocks := Blocks1; end; ActiveBlocks.ConcatEqualBlocks; FCodePage := SystemCodepage; WriteGroupBegin; try WriteHeader(ActiveBlocks); WriteBackground; WriteBody(ActiveBlocks, False); finally WriteGroupEnd; end; end; except KFunctions.Error(sErrMemoSaveToRTF); end; end; procedure TKMemoRTFWriter.WriteBackground; var Shape: TKMemoRTFShape; begin if not FSelectedOnly and (FMemo <> nil) and ((FMemo.Colors.BkGnd <> clWindow) or (FMemo.Background.Image.Graphic <> nil)) then begin WriteCtrlParam('viewbksp', 1); WriteGroupBegin; try WriteUnknownGroup; WriteCtrl('background'); WriteSpace; Shape := TKmemoRTFShape.Create; try Shape.ContentType := sctRectangle; Shape.FitToShape := False; Shape.FitToText := False; Shape.Style.WrapMode := wrUnknown; Shape.Style.Brush.Color := FMemo.Colors.BkGnd; Shape.Style.FillBlip := FMemo.Background.Image.Graphic; Shape.Background := True; Shape.HorzPosCode := 0; Shape.VertPosCode := 0; WriteShape(Shape, False); finally Shape.Free; end; finally WriteGroupEnd; end; end; end; procedure TKMemoRTFWriter.WriteBody(ABlocks: TKMemoBlocks; AInsideOfTable: Boolean); var I: Integer; Block: TKMemoBlock; PA: TKMemoParagraph; IsParagraph: Boolean; URL: TKString; begin if ABlocks <> nil then begin URL := ''; IsParagraph := False; for I := 0 to ABlocks.Count - 1 do begin Block := ABlocks[I]; if CanSave(Block) then begin if Block is TKMemoHyperlink then begin if URL <> TKMemoHyperlink(Block).URL then begin if URL <> '' then WriteHyperlinkEnd; WriteHyperlinkBegin(TKMemoHyperlink(Block)); URL := TKMemoHyperlink(Block).URL; end; WriteTextBlock(TKMemoTextBlock(Block), FSelectedOnly) end else begin if URL <> '' then begin WriteHyperlinkEnd; URL := ''; end; if IsParagraph then begin PA := ABlocks.GetNearestParagraphBlock(I); if PA <> nil then WriteListText(PA.NumberBlock); IsParagraph := False; end; if Block is TKMemoParagraph then begin if not AInsideOfTable or (I < ABlocks.Count - 1) then WriteParagraph(TKMemoParagraph(Block), AInsideOfTable); IsParagraph := True; end else if Block is TKMemoTextBlock then WriteTextBlock(TKMemoTextBlock(Block), FSelectedOnly) else if Block is TKMemoImageBlock then WriteImageBlock(TKMemoImageBlock(Block), AInsideOfTable) else if Block is TKMemoContainer then begin if Block is TKMemoTable then WriteTable(TKMemoTable(Block)) else if Block.Position <> mbpText then WriteContainer(TKMemoContainer(Block), AInsideOfTable) else WriteBody(TKMemoContainer(Block).Blocks, AInsideOfTable) // just save the contents end; end; end; end; if URL <> '' then WriteHyperlinkEnd; end; end; procedure TKMemoRTFWriter.WriteColorTable; var I: Integer; ColorRec: TKColorRec; begin WriteGroupBegin; try WriteCtrl('colortbl'); // WriteSemicolon; // no default color, write all colors explictly for I := 0 to FColorTable.Count - 1 do begin ColorRec := FColorTable[I].ColorRec; WriteCtrlParam('red', ColorRec.R); WriteCtrlParam('green', ColorRec.G); WriteCtrlParam('blue', ColorRec.B); WriteSemiColon; end; finally WriteGroupEnd; end; end; procedure TKMemoRTFWriter.WriteContainer(ABlock: TKMemoContainer; AInsideTable: Boolean); var Shape: TKMemoRTFShape; begin // write generic container - write as RTF text box Shape := TKMemoRTFShape.Create; try Shape.ContentType := sctTextBox; Shape.Block := ABlock; Shape.ContentPosition.Left := ABlock.LeftOffset; Shape.ContentPosition.Top := ABlock.TopOffset; Shape.ContentPosition.Right := ABlock.LeftOffset + ABlock.RequiredWidth; Shape.ContentPosition.Bottom := ABlock.TopOffset + ABlock.RequiredHeight; Shape.FitToText := not ABlock.FixedHeight; Shape.HorzPosCode := 2; // position by column, we don't support any other Shape.VertPosCode := 2; // position by paragraph, we don't support any other Shape.Style.Assign(ABlock.BlockStyle); WriteShape(Shape, AInsideTable); finally Shape.Free; end; end; procedure TKMemoRTFWriter.WriteCtrl(const ACtrl: AnsiString); begin WriteString('\' + ACtrl); end; procedure TKMemoRTFWriter.WriteCtrlParam(const ACtrl: AnsiString; AParam: Integer); begin WriteString(AnsiString(Format('\%s%d', [ACtrl, AParam]))); end; procedure TKMemoRTFWriter.WriteFontTable; var I, Pitch, Charset: Integer; begin WriteGroupBegin; try WriteCtrl('fonttbl'); for I := 0 to FFontTable.Count - 1 do begin WriteGroupBegin; try WriteCtrlParam('f', I); Charset := FFontTable[I].Font.Charset; {if Charset = 0 then Charset := CPToCharset(FCodePage); // don't override charset, it is still important for certain fonts!} WriteCtrlParam('fcharset', Charset); case FFontTable[I].Font.Pitch of fpFixed: Pitch := 1; fpVariable: Pitch := 2; else Pitch := 0; end; WriteCtrlParam('fprq', Pitch); WriteSpace; WriteString(AnsiString(FFontTable[I].Font.Name)); WriteSemiColon; finally WriteGroupEnd; end; end; finally WriteGroupEnd; end; end; procedure TKMemoRTFWriter.WriteGroupBegin; begin if FReadableOutput and (FStream.Size > 0) then WriteString(cCR+cLF); WriteString('{'); Inc(FGroupLevel); end; procedure TKMemoRTFWriter.WriteGroupEnd; begin Dec(FGroupLevel); WriteString('}'); end; procedure TKMemoRTFWriter.WriteHeader(ABlocks: TKMemoBlocks); begin if FMemo <> nil then begin FFontTable.AddFont(FMemo.TextStyle.Font); FListTable.AssignFromListTable(FMemo.ListTable, FFontTable); end; FillFontTable(ABlocks); FillColorTable(ABlocks); WriteCtrl('rtf1'); WriteCtrl('ansi'); WriteCtrlParam('ansicpg', FCodePage); if FFontTable.Count > 0 then WriteCtrlParam('deff', 0); WriteCtrlParam('uc', 1); WriteFontTable; WriteColorTable; WriteListTable; end; procedure TKMemoRTFWriter.WriteHyperlinkBegin(ABlock: TKMemoHyperlink); begin WriteGroupBegin; WriteCtrl('field'); WriteGroupBegin; try WriteUnknownGroup; WriteCtrl('fldinst'); WriteSpace; WriteString(cRTFHyperlink); WriteSpace; WriteUnicodeString(TKMemoHyperLink(ABlock).URL); finally WriteGroupEnd; end; WriteGroupBegin; WriteCtrl('fldrslt'); end; procedure TKMemoRTFWriter.WriteHyperlinkEnd; begin WriteGroupEnd; WriteGroupEnd; end; procedure TKMemoRTFWriter.WriteImage(ABlock: TKmemoImageBlock); begin WriteCtrlParam('picw', PixelsToTwipsX(ABlock.NativeOrExplicitWidth)); WriteCtrlParam('pich', PixelsToTwipsY(ABlock.NativeOrExplicitHeight)); WriteCtrlParam('picscalex', MulDiv(ABlock.ScaleWidth, 100, ABlock.NativeOrExplicitWidth)); WriteCtrlParam('picscaley', MulDiv(ABlock.ScaleHeight, 100, ABlock.NativeOrExplicitHeight)); WriteCtrlParam('picwgoal', PixelsToTwipsX(ABlock.ScaleWidth)); WriteCtrlParam('pichgoal', PixelsToTwipsY(ABlock.ScaleHeight)); WriteCtrlParam('piccropb', PixelsToTwipsY(ABlock.Crop.Bottom)); WriteCtrlParam('piccropl', PixelsToTwipsX(ABlock.Crop.Left)); WriteCtrlParam('piccropr', PixelsToTwipsX(ABlock.Crop.Right)); WriteCtrlParam('piccropt', PixelsToTwipsY(ABlock.Crop.Top)); WritePicture(ABlock.Image); end; procedure TKMemoRTFWriter.WriteImageBlock(ABlock: TKmemoImageBlock; AInsideTable: Boolean); var Shape: TKMemoRTFShape; begin // write generic container - write as RTF text box Shape := TKMemoRTFShape.Create; try Shape.ContentType := sctImage; Shape.FitToShape := False; Shape.FitToText := False; Shape.Style.Assign(ABlock.ImageStyle); if ABlock.Position = mbpText then begin WriteGroupBegin; try WriteUnknownGroup; WriteCtrl('shppict'); WriteGroupBegin; try WriteCtrl('pict'); WriteGroupBegin; try WriteUnknownGroup; WriteCtrl('picprop'); WriteShapeProperties(Shape); finally WriteGroupEnd; end; WriteImage(ABlock); finally WriteGroupEnd; end; finally WriteGroupEnd; end; end else begin Shape.Block := ABlock; Shape.ContentPosition.Left := ABlock.LeftOffset; Shape.ContentPosition.Top := ABlock.TopOffset; Shape.ContentPosition.Right := ABlock.LeftOffset + ABlock.ScaleWidth + ABlock.ImageStyle.LeftPadding + ABlock.ImageStyle.RightPadding; Shape.ContentPosition.Bottom := ABlock.TopOffset + ABlock.ScaleHeight + ABlock.ImageStyle.TopPadding + ABlock.ImageStyle.BottomPadding; Shape.HorzPosCode := 2; // we don't support any other Shape.VertPosCode := 2; // we don't support any other WriteShape(Shape, AInsideTable); end; finally Shape.Free; end; end; procedure TKMemoRTFWriter.WriteListTable; var I, J, K, Len: Integer; Item: TKMemoRTFList; Level: TKMemoRTFListLevel; NFItem: TKMemoNumberingFormatItem; OverrideItem: TKMemoDictionaryItem; begin // first write list table WriteGroupBegin; try WriteUnknownGroup; WriteCtrl('listtable'); for I := 0 to FListTable.Count - 1 do begin Item := FListTable[I]; WriteGroupBegin; try WriteCtrl('list'); for J := 0 to Item.Levels.Count - 1 do begin Level := Item.Levels[J]; WriteGroupBegin; try WriteCtrl('listlevel'); WriteCtrlParam('levelnfc', Level.NumberType); WriteCtrlParam('levelstartat', Level.StartAt); WriteGroupBegin; try WriteCtrl('leveltext'); for K := 0 to Level.NumberingFormat.Count - 1 do begin NFItem := Level.NumberingFormat[K]; if (NFItem.Level >= 0) and (NFItem.Text = '') then WriteString(AnsiString(Format('\''%.2x', [NFItem.Level]))) else WriteUnicodeString(NFItem.Text) end; WriteSemiColon; finally WriteGroupEnd; end; WriteGroupBegin; try WriteCtrl('levelnumbers'); Len := 1; for K := 1 to Level.NumberingFormat.Count - 1 do begin NFItem := Level.NumberingFormat[K]; if (NFItem.Level >= 0) and (NFItem.Text = '') then begin WriteString(AnsiString(Format('\''%.2x', [Len]))); Inc(Len); end else Inc(Len, StringLength(NFItem.Text)); end; WriteSemiColon; finally WriteGroupEnd; end; if Level.FontIndex >= 0 then WriteCtrlParam('f', Level.FontIndex); WriteCtrlParam('fi', PixelsToTwipsX(Level.FirstIndent)); WriteCtrlParam('li', PixelsToTwipsX(Level.LeftIndent)); finally WriteGroupEnd; end; end; WriteCtrlParam('listid', Item.ID); finally WriteGroupEnd; end; end; finally WriteGroupEnd; end; // next write list override table WriteGroupBegin; try WriteUnknownGroup; WriteCtrl('listoverridetable'); for I := 0 to FListTable.Overrides.Count - 1 do begin OverrideItem := FListTable.Overrides[I]; WriteGroupBegin; try WriteCtrl('listoverride'); WriteCtrlParam('listid', OverrideItem.Value); WriteCtrlParam('ls', OverrideItem.Index); finally WriteGroupEnd; end; end; finally WriteGroupEnd; end; end; procedure TKMemoRTFWriter.WriteListText(ANumberBlock: TKMemoTextBlock); begin if ANumberBlock <> nil then begin WriteGroupBegin; try WriteCtrl('listtext'); WriteTextBlock(ANumberBlock, False); finally WriteGroupEnd; end; end; end; procedure TKMemoRTFWriter.WriteParagraph(ABlock: TKMemoParagraph; AInsideTable: Boolean); begin WriteGroupBegin; try WriteParaStyle(ABlock.ParaStyle); WriteTextStyle(ABlock.TextStyle); if AinsideTable then WriteCtrl('intbl'); WriteCtrl('par'); finally WriteGroupEnd; end; end; procedure TKMemoRTFWriter.WriteParaStyle(AParaStyle: TKMemoParaStyle); begin WriteCtrl('pard'); // always store complete paragraph properties if AParaStyle.FirstIndent <> 0 then WriteCtrlParam('fi', PixelsToTwipsX(AParaStyle.FirstIndent)); if AParaStyle.LeftPadding <> 0 then WriteCtrlParam('li', PixelsToTwipsX(AParaStyle.LeftPadding)); if AParaStyle.RightPadding <> 0 then WriteCtrlParam('ri', PixelsToTwipsX(AParaStyle.RightPadding)); if AParaStyle.TopPadding <> 0 then WriteCtrlParam('sb', PixelsToTwipsY(AParaStyle.TopPadding)); if AParaStyle.BottomPadding <> 0 then WriteCtrlParam('sa', PixelsToTwipsY(AParaStyle.BottomPadding)); case AParaStyle.HAlign of halLeft: WriteCtrl('ql'); halCenter: WriteCtrl('qc'); halRight: WriteCtrl('qr'); halJustify: WriteCtrl('qj'); end; if AParaStyle.Brush.Style <> bsClear then WriteCtrlParam('cbpat', FColorTable.GetIndex(AParaStyle.Brush.Color)); if not AParaStyle.WordWrap then WriteCtrl('nowwrap'); if AParaStyle.BorderWidths.NonZero then begin if AParaStyle.BorderWidths.Bottom > 0 then begin WriteCtrl('brdrb'); WriteCtrlParam('brdrw', PixelsToTwipsY(AParaStyle.BorderWidths.Bottom)) end; if AParaStyle.BorderWidths.Left > 0 then begin WriteCtrl('brdrl'); WriteCtrlParam('brdrw', PixelsToTwipsX(AParaStyle.BorderWidths.Left)) end; if AParaStyle.BorderWidths.Right > 0 then begin WriteCtrl('brdrr'); WriteCtrlParam('brdrw', PixelsToTwipsX(AParaStyle.BorderWidths.Right)) end; if AParaStyle.BorderWidths.Top > 0 then begin WriteCtrl('brdrt'); WriteCtrlParam('brdrw', PixelsToTwipsY(AParaStyle.BorderWidths.Top)) end; end else begin if AParaStyle.BorderWidth > 0 then begin WriteCtrl('box'); WriteCtrlParam('brdrw', PixelsToTwipsX(AParaStyle.BorderWidth)) end; if AParaStyle.BorderRadius > 0 then WriteCtrlParam('brdrradius', PixelsToTwipsX(AParaStyle.BorderRadius)) end; if AParaStyle.BorderColor <> clNone then WriteCtrlParam('brdrcf', FColorTable.GetIndex(AParaStyle.BorderColor)); if AParaStyle.LineSpacingValue <> 0 then begin if AParaStyle.LineSpacingMode = lsmValue then begin WriteCtrlParam('sl', PixelsToTwipsY(AParaStyle.LineSpacingValue)); WriteCtrlParam('slmult', 0) end else begin WriteCtrlParam('sl', Round(AParaStyle.LineSpacingFactor * 240)); WriteCtrlParam('slmult', 1) end; end; if AParaStyle.NumberingList <> cInvalidListID then WriteCtrlParam('ls', FListTable.FindByID(AParaStyle.NumberingList)); if AParaStyle.NumberingListLevel >= 0 then WriteCtrlParam('ilvl', AParaStyle.NumberingListLevel); if AParaStyle.NumberStartAt > 0 then WriteCtrlParam('lsstartat', AParaStyle.NumberStartAt); end; procedure TKMemoRTFWriter.WritePicture(AImage: TGraphic); var MS: TMemoryStream; S, ImgData: AnsiString; begin if AImage <> nil then begin if AImage is TJPegImage then WriteCtrl('jpegblip') {$IFDEF USE_PNG_SUPPORT} else if AImage is TKPngImage then WriteCtrl('pngblip') {$ENDIF} {$IFDEF MSWINDOWS} else if AImage is TKMetafile then begin if TKMetafile(AImage).Enhanced then WriteCtrl('emfblip') else WriteCtrlParam('wmetafile', 8); end {$ENDIF} ; MS := TMemoryStream.Create; try AImage.SaveToStream(MS); MS.Seek(0, soFromBeginning); SetLength(S, MS.Size); MS.Read(S[1], MS.Size); finally MS.Free; end; WriteSpace; ImgData := BinaryToDigits(S); WriteString(ImgData); end; end; procedure TKMemoRTFWriter.WriteSemiColon; begin WriteString(';'); end; procedure TKMemoRTFWriter.WriteShape(AShape: TKMemoRTFShape; AInsideTable: Boolean); begin WriteGroupBegin; try WriteCtrl('shp'); WriteGroupBegin; try WriteUnknownGroup; WriteCtrl('shpinst'); WriteCtrlParam('shpbottom', PixelsToTwipsY(Ashape.ContentPosition.Bottom)); WriteCtrlParam('shpleft', PixelsToTwipsX(Ashape.ContentPosition.Left)); WriteCtrlParam('shpright', PixelsToTwipsX(Ashape.ContentPosition.Right)); WriteCtrlParam('shptop', PixelsToTwipsY(Ashape.ContentPosition.Top)); case AShape.HorzPosCode of 1: WriteCtrl('shpbxpage'); 2: WriteCtrl('shpbxcolumn'); else WriteCtrl('shpbxmargin'); end; case AShape.VertPosCode of 1: WriteCtrl('shpbypage'); 2: WriteCtrl('shpbypara'); else WriteCtrl('shpbymargin'); end; WriteCtrlParam('shpfhdr', 0); WriteCtrlParam('shpwr', AShape.Wrap); WriteCtrlParam('shpwrk', AShape.WrapSide); WriteShapeProperties(AShape); case AShape.ContentType of sctImage: if AShape.Block <> nil then begin WriteGroupBegin; try WriteCtrl('sp'); WriteShapePropName('pib'); WriteGroupBegin; try WriteCtrl('sv'); WriteSpace; WriteGroupBegin; try WriteCtrl('pict'); WriteImage(AShape.Block as TKMemoImageBlock); finally WriteGroupEnd; end; finally WriteGroupEnd; end; finally WriteGroupEnd; end; end; sctRectangle: if AShape.Style.FillBlip <> nil then begin WriteShapeProp('fillType', '3'); WriteGroupBegin; try WriteCtrl('sp'); WriteShapePropName('fillBlip'); WriteGroupBegin; try WriteCtrl('sv'); WriteSpace; WriteGroupBegin; try WriteCtrl('pict'); WritePicture(AShape.Style.FillBlip); finally WriteGroupEnd; end; finally WriteGroupEnd; end; finally WriteGroupEnd; end; end; sctTextbox: if AShape.Block <> nil then begin WriteGroupBegin; try WriteCtrl('shptxt'); WriteBody((AShape.Block as TKMemoContainer).Blocks, AInsideTable); finally WriteGroupEnd; end; end; end; finally WriteGroupEnd; end; finally WriteGroupEnd; end; end; procedure TKMemoRTFWriter.WriteShapeProp(const APropName, APropValue: AnsiString); begin WriteGroupBegin; try WriteCtrl('sp'); WriteShapePropName(APropName); WriteShapePropValue(APropValue); finally WriteGroupEnd; end; end; procedure TKMemoRTFWriter.WriteShapeProperties(AShape: TKMemoRTFShape); var B: Boolean; begin B := AShape.Style.Brush.Style <> bsClear; case AShape.ContentType of sctImage: WriteShapeProp('shapeType', '75'); sctRectangle: WriteShapeProp('shapeType', '1'); sctTextbox: WriteShapeProp('shapeType', '202'); end; if AShape.FitToShape then WriteShapeProp('fFitTextToShape', BoolToParam(True)); if AShape.FitToText then WriteShapeProp('fFitShapeToText', BoolToParam(True)); WriteShapeProp('fFilled', BoolToParam(B)); if B then WriteShapeProp('fillColor', ColorToParam(AShape.Style.Brush.Color)); B := AShape.Style.BorderWidth > 0; WriteShapeProp('fLine', BoolToParam(B)); if B then begin WriteShapeProp('lineColor', ColorToParam(AShape.Style.BorderColor)); WriteShapeProp('lineWidth', EMUToParam(AShape.Style.BorderWidth)); end; if AShape.Background then WriteShapeProp('fBackground', BoolToParam(True)); end; procedure TKMemoRTFWriter.WriteShapePropName(const APropName: AnsiString); begin WriteGroupBegin; try WriteCtrl('sn'); WriteSpace; WriteString(APropName); finally WriteGroupEnd; end; end; procedure TKMemoRTFWriter.WriteShapePropValue(const APropValue: AnsiString); begin WriteGroupBegin; try WriteCtrl('sv'); WriteSpace; WriteString(APropValue); finally WriteGroupEnd; end; end; procedure TKMemoRTFWriter.WriteSpace; begin WriteString(' '); end; procedure TKMemoRTFWriter.WriteString(const AText: AnsiString); begin FStream.Write(AText[1], Length(AText)); end; procedure TKMemoRTFWriter.WriteTable(ABlock: TKMemoTable); var I, J, SavedRow, SavedRowCount: Integer; Row: TKMemoTableRow; Cell: TKMemoTableCell; begin SavedRowCount := 0; for I := 0 to ABlock.RowCount - 1 do begin Row := ABlock.Rows[I]; if CanSave(Row) then Inc(SavedRowCount); end; SavedRow := 0; for I := 0 to ABlock.RowCount - 1 do begin Row := ABlock.Rows[I]; if CanSave(Row) then begin WriteCtrl('trowd'); WriteTableRowProperties(ABlock, I, SavedRow); for J := 0 to Row.CellCount - 1 do begin Cell := Row.Cells[J]; if Cell.ColSpan >= 0 then begin WriteParaStyle(Cell.ParaStyle); if (Cell.Blocks.Count > 0) and ((Cell.Blocks.Count > 1) or not(Cell.Blocks[0] is TKmemoParagraph)) then begin WriteGroupBegin; try WriteBody(Cell.Blocks, True); finally WriteGroupEnd; end; end; WriteCtrl('cell'); end; end; WriteGroupBegin; try WriteCtrl('trowd'); WriteTableRowProperties(ABlock, I, SavedRow); if SavedRow = SavedRowCount - 1 then WriteCtrl('lastrow'); WriteCtrl('row'); finally WriteGroupEnd; end; Inc(SavedRow); end; end; end; procedure TKMemoRTFWriter.WriteTableRowProperties(ATable: TKMemoTable; ARowIndex, ASavedRowIndex: Integer); procedure WriteBorderWidth(AWidth: Integer); begin if AWidth <> 0 then begin WriteCtrl('brdrs'); WriteCtrlParam('brdrw', PixelsToTwipsX(AWidth)) end else WriteCtrl('brdrnone'); end; var Cell: TKMemoTableCell; Row: TKMemoTableRow; I, W, XPos: Integer; RowPadd: TRect; begin WriteCtrlParam('irow', ASavedRowIndex); Xpos := 0; Row := ATable.Rows[ARowIndex]; RowPadd := CreateEmptyRect; for I := 0 to Row.CellCount - 1 do begin Cell := Row.Cells[I]; RowPadd.Bottom := Max(RowPadd.Bottom, Cell.BlockStyle.BottomPadding); RowPadd.Left := Max(RowPadd.Left, Cell.BlockStyle.LeftPadding); RowPadd.Right := Max(RowPadd.Right, Cell.BlockStyle.RightPadding); RowPadd.Top := Max(RowPadd.Top, Cell.BlockStyle.TopPadding); end; WriteCtrlParam('trpaddb', PixelsToTwipsY(RowPadd.Bottom)); WriteCtrlParam('trpaddl', PixelsToTwipsX(RowPadd.Left)); WriteCtrlParam('trpaddr', PixelsToTwipsX(RowPadd.Right)); WriteCtrlParam('trpaddt', PixelsToTwipsY(RowPadd.Top)); for I := 0 to Row.CellCount - 1 do begin Cell := Row.Cells[I]; if Cell.ColSpan >= 0 then begin if Cell.BlockStyle.BottomPadding <> RowPadd.Bottom then WriteCtrlParam('clpadb', PixelsToTwipsY(RowPadd.Bottom)); if Cell.BlockStyle.LeftPadding <> RowPadd.Left then WriteCtrlParam('clpadl', PixelsToTwipsX(RowPadd.Left)); if Cell.BlockStyle.RightPadding <> RowPadd.Right then WriteCtrlParam('clpadr', PixelsToTwipsX(RowPadd.Right)); if Cell.BlockStyle.TopPadding <> RowPadd.Top then WriteCtrlParam('clpadt', PixelsToTwipsY(RowPadd.Top)); if Cell.RowSpan > 1 then WriteCtrl('clvmgf') else if Cell.RowSpan <= 0 then WriteCtrl('clvmrg'); WriteCtrl('clbrdrb'); WriteBorderWidth(Cell.RequiredBorderWidths.Bottom); WriteCtrlParam('brdrcf', FColorTable.GetIndex(Cell.BlockStyle.BorderColor)); WriteCtrl('clbrdrl'); WriteBorderWidth(Cell.RequiredBorderWidths.Left); WriteCtrlParam('brdrcf', FColorTable.GetIndex(Cell.BlockStyle.BorderColor)); WriteCtrl('clbrdrr'); WriteBorderWidth(Cell.RequiredBorderWidths.Right); WriteCtrlParam('brdrcf', FColorTable.GetIndex(Cell.BlockStyle.BorderColor)); WriteCtrl('clbrdrt'); WriteBorderWidth(Cell.RequiredBorderWidths.Top); WriteCtrlParam('brdrcf', FColorTable.GetIndex(Cell.BlockStyle.BorderColor)); if Cell.BlockStyle.Brush.Style <> bsClear then WriteCtrlParam('clcbpat', FColorTable.GetIndex(Cell.BlockStyle.Brush.Color)); W := Max(ATable.CalcTotalCellWidth(I, ARowIndex), 5); WriteCtrlParam('clwWidth', PixelsToTwipsX(W)); Inc(Xpos, W); WriteCtrlParam('cellx', PixelsToTwipsX(XPos)); end; end; end; procedure TKMemoRTFWriter.WriteTextBlock(ABlock: TKMemoTextBlock; ASelectedOnly: Boolean); var S: TKString; begin WriteGroupBegin; try if ASelectedOnly then S := ABlock.SelText else S := ABlock.Text; WriteTextStyle(ABlock.TextStyle); WriteSpace; WriteUnicodeString(S); finally WriteGroupEnd; end; end; procedure TKMemoRTFWriter.WriteTextStyle(ATextStyle: TKMemoTextStyle); begin WriteCtrlParam('f', FFontTable.GetIndex(ATextStyle.Font)); if fsBold in ATextStyle.Font.Style then WriteCtrl('b'); if fsItalic in ATextStyle.Font.Style then WriteCtrl('i'); if fsUnderline in ATextStyle.Font.Style then WriteCtrl('ul'); if fsStrikeout in ATextStyle.Font.Style then WriteCtrl('strike'); case ATextStyle.Capitals of tcaNormal: WriteCtrl('caps'); tcaSmall: WriteCtrl('scaps'); end; WriteCtrlParam('fs', ATextStyle.Font.Size * 2); if ATextStyle.Font.Color <> clNone then WriteCtrlParam('cf', FColorTable.GetIndex(ATextStyle.Font.Color)); if ATextStyle.Brush.Style <> bsClear then WriteCtrlParam('highlight', FColorTable.GetIndex(ATextStyle.Brush.Color)); case ATextStyle.ScriptPosition of tpoSuperscript: WriteCtrl('super'); tpoSubscript: WriteCtrl('sub'); end; end; procedure TKMemoRTFWriter.WriteUnicodeString(const AText: TKString); var I: Integer; UnicodeValue: SmallInt; WasAnsi: Boolean; S, Ansi: AnsiString; C: TKChar; begin S := ''; for I := 1 to StringLength(AText) do begin {$IFDEF FPC} C := LazUTF8.UTF8Copy(AText, I, 1); if Length(C) = 1 then {$ELSE} C := AText[I]; if Ord(C) < $80 then {$ENDIF} begin if C = #9 then S := AnsiString(Format('%s\tab ', [S])) else if (C = '\') or (C = '{') or (C = '}') then S := AnsiString(Format('%s\%s', [S, TKString(C)])) else S := S + AnsiString(C) end else begin WasAnsi := False; if FCodePage <> 0 then begin // first try Ansi codepage conversion for better backward compatibility Ansi := StringToAnsiString(C, FCodePage); if (Length(Ansi) = 1) and (Ansi <> #0) then begin S := AnsiString(Format('%s\''%.2x', [S, Ord(Ansi[1])])); WasAnsi := True; end; end; if not WasAnsi then begin // next store as Unicode character UnicodeValue := Ord(NativeUTFToUnicode(C)); S := AnsiString(Format('%s\u%d\''3F', [S, UnicodeValue])); end; end; end; if S <> '' then WriteString(S); end; procedure TKMemoRTFWriter.WriteUnknownGroup; begin WriteCtrl('*'); end; end. tomboy-ng_0.34-1/kcontrols/source/kdialogs.pas0000644000175000017500000003516514125207534021250 0ustar dbannondbannon{ @abstract(This file is part of the KControls component suite for Delphi and Lazarus.) @author(Tomas Krysl) Copyright (c) 2020 Tomas Krysl

License:
This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } unit kdialogs; // lowercase name because of Lazarus/Linux {$include kcontrols.inc} {$WEAKPACKAGEUNIT ON} interface uses Classes, Controls, Forms, SysUtils, KFunctions, KControls, KPrintPreview, KPrintSetup; type { Specifies the root folder for TKBrowseFolderDialog dialog - RootFolder property. } TKRootFolder = (brAdminTools, brAltStartUp, brAppData, brBitBucket, brCommonAdminTools, brCommonAltStartUp, brCommonAppData, brCommonDesktopDirectory, brCommonDocuments, brCommonFavorites, brCommonPrograms, brCommonStartMenu, brCommonStartUp, brCommonTemplates, brControls, brCookies, brDesktop, brDesktopDirectory, brDrives, brFavorites, brFonts, brHistory, brInternet, brInternetCache, brLocalAppData, brMyMusic, brMyPictures, brNetHood, brNetWork, brPersonal, brPrinters, brPrintHood, brProfile, brProgramFiles, brProgramFilesCommon, brPrograms, brRecent, brSendTo, brStartMenu, brStartUp, brSystem, brTemplates, brWindows, brCustom); TFolder = type string; { Specifies the folder options for TKBrowseFolderDialog dialog - Options property. } TKBrowseFolderOption = (bfSetFolder, bfBrowseForComputer, bfBrowseForPrinter, bfBrowseIncludeFiles, bfBrowseIncludeURLs, bfDontGoBelowDomain, bfEditBox, bfNewDialogStyle, bfReturnFSAncestors, bfReturnOnlyFSDirs, bfShareAble, bfStatusText, bfUseNewUI, bfValidate); TKBrowseFolderOptions = set of TKBrowseFolderOption; { Specifies the initial position for TKBrowseFolderDialog dialog - Position property. } TKBrowseFolderPosition = (poDefault, poScreenCenter, poCustom); { @abstract(Encapsulates the print preview dialog) } TKPrintPreviewDialog = class(TComponent) private FControl: TKCustomControl; FPrintPreviewForm: TKPrintPreviewForm; function GetPrintPreviewForm: TKPrintPreviewForm; public { Creates the instance. Assigns default values to properties. } constructor Create(AOwner: TComponent); override; { Shows the dialog. } procedure Show; { Shows the dialog as modal dialog. } function Execute: Boolean; { Specifies the associated preview form. } property PrintPreviewForm: TKPrintPreviewForm read GetPrintPreviewForm; published { Specifies the associated control. } property Control: TKCustomControl read FControl write FControl; end; { @abstract(Encapsulates the print preview dialog) } TKPrintSetupDialog = class(TComponent) private FControl: TKCustomControl; FPreviewDialog: TKPrintPreviewDialog; FSelAvail: Boolean; protected FPrintSetupForm: TKPrintSetupForm; procedure SetupForm(AfterCreation: Boolean); virtual; public { Creates the instance. Assigns default values to properties. } constructor Create(AOwner: TComponent); override; { Shows the dialog as modal dialog. } function Execute: Boolean; published { Specifies the associated control. } property Control: TKCustomControl read FControl write FControl; { Specifies the preview dialog for the Preview... button. If not specified, the print setup dialog creates a new one. } property PreviewDialog: TKPrintPreviewDialog read FPreviewDialog write FPreviewDialog; { If True, the Selection Only option will be checked (if selection is available for the control). } property SelAvail: Boolean read FSelAvail write FSelAvail default True; end; { @abstract(Encapsulates the browse for folder dialog - Windows only) } TKBrowseFolderDialog = class(TComponent) private FParentWindow: TWinControl; FFolder: TFolder; FLabelText: string; FPosition: TKBrowseFolderPosition; FCustomRootFolder: TFolder; FOptions: TKBrowseFolderOptions; FRootFolder: TKRootFolder; FCustomLeft, FCustomTop: Integer; procedure SetFolder(const Value: TFolder); public { Creates the instance. Assigns default values to properties. } constructor Create(AOwner: TComponent); override; { Shows the dialog as modal dialog. } function Execute: Boolean; property LabelText: string read FLabelText write FLabelText; published property CustomRootFolder: TFolder read FCustomRootFolder write FCustomRootFolder; property Folder: TFolder read FFolder write SetFolder; property Options: TKBrowseFolderOptions read FOptions write FOptions; property ParentWindow: TWinControl read FParentWindow write FParentWindow; property Position: TKBrowseFolderPosition read FPosition write FPosition default poScreenCenter; property RootFolder: TKRootFolder read FRootFolder write FRootFolder; property CustomLeft: Integer index 1 read FCustomLeft write FCustomLeft default 100; property CustomTop: Integer index 2 read FCustomTop write FCustomTop default 100; end; implementation uses KRes {$IFDEF MSWINDOWS} , ActiveX, ShlObj, Windows, Messages {$ENDIF} ; {$IFDEF MSWINDOWS} const {Common Controls version 5.O extensions} BIF_BROWSEINCLUDEURLS = $0080; BIF_NEWDIALOGSTYLE = $0040; BIF_SHAREABLE = $8000; BIF_USENEWUI = BIF_NEWDIALOGSTYLE + BIF_EDITBOX; CSIDL_FLAG_CREATE = $8000; CSIDL_ADMINTOOLS = $0030; CSIDL_COMMON_ADMINTOOLS = $002F; CSIDL_COMMON_APPDATA = $0023; CSIDL_COMMON_DOCUMENTS = $002E; CSIDL_LOCAL_APPDATA = $001C; CSIDL_MYMUSIC = $0028; CSIDL_MYPICTURES = $0027; CSIDL_PROGRAM_FILES = $0026; CSIDL_PROGRAM_FILES_COMMON = $002B; CSIDL_SYSTEM = $0025; CSIDL_WINDOWS = $0024; {$IFDEF FPC} // message from browser BFFM_INITIALIZED = 1; BFFM_SELCHANGED = 2; BFFM_VALIDATEFAILEDA = 3; // lParam:szPath ret:1(cont),0(EndDialog) BFFM_VALIDATEFAILEDW = 4; // lParam:wzPath ret:1(cont),0(EndDialog) BFFM_IUNKNOWN = 5; // provides IUnknown to client. lParam: IUnknown* // messages to browser BFFM_SETSTATUSTEXTA = WM_USER + 100; BFFM_ENABLEOK = WM_USER + 101; BFFM_SETSELECTIONA = WM_USER + 102; BFFM_SETSELECTIONW = WM_USER + 103; BFFM_SETSTATUSTEXTW = WM_USER + 104; BFFM_SETOKTEXT = WM_USER + 105; // Unicode only BFFM_SETEXPANDED = WM_USER + 106; // Unicode only {$IFDEF UNICODE} BFFM_VALIDATEFAILED = BFFM_VALIDATEFAILEDW; BFFM_SETSTATUSTEXT = BFFM_SETSTATUSTEXTW; BFFM_SETSELECTION = BFFM_SETSELECTIONW; {$ELSE} BFFM_VALIDATEFAILED = BFFM_VALIDATEFAILEDA; BFFM_SETSTATUSTEXT = BFFM_SETSTATUSTEXTA; BFFM_SETSELECTION = BFFM_SETSELECTIONA; {$ENDIF} {$ENDIF} {$ENDIF} { TKPrintPreviewDialog } constructor TKPrintPreviewDialog.Create(AOwner: TComponent); begin inherited; FPrintPreviewForm := nil; FControl := nil; end; function TKPrintPreviewDialog.Execute; begin PrintPreviewForm.Preview.Control := FControl; PrintPreviewForm.ShowModal; Result := True; end; function TKPrintPreviewDialog.GetPrintPreviewForm: TKPrintPreviewForm; begin if not Assigned(FPrintPreviewForm) then FPrintPreviewForm := TKPrintPreviewForm.Create(Self); Result := FPrintPreviewForm; end; procedure TKPrintPreviewDialog.Show; begin PrintPreviewForm.Preview.Control := FControl; PrintPreviewForm.Show; end; { TKPrintSetupDialog } constructor TKPrintSetupDialog.Create(AOwner: TComponent); begin inherited; FControl := nil; FPrintSetupForm := nil; FPreviewDialog := nil; FSelAvail := True; end; function TKPrintSetupDialog.Execute: Boolean; begin if Assigned(FControl) then begin if not Assigned(FPrintSetupForm) then begin FPrintSetupForm := TKPrintSetupForm.Create(Self); SetupForm(True); end; FPrintSetupForm.PageSetup := FControl.PageSetup; if Assigned(FPreviewDialog) then FPrintSetupForm.PreviewForm := FPreviewDialog.PrintPreviewForm; SetupForm(False); Result := FPrintSetupForm.ShowModal = mrOk; end else Result := False; end; procedure TKPrintSetupDialog.SetupForm(AfterCreation: Boolean); begin if not AfterCreation then FPrintSetupForm.SelAvail := FSelAvail; end; { TKBrowseFolderDialog } {$IFDEF MSWINDOWS} function BFCallBack(Wnd: HWND; uMsg: UINT; lPar, lpData: LPARAM): Integer stdcall; var Allocator: IMalloc; Location: PItemIDList; begin with TKBrowseFolderDialog(lpData) do try if uMsg = BFFM_INITIALIZED then begin if (bfSetFolder in Options) and (Folder <> '') then SendMessage(Wnd, BFFM_SETSELECTION, Integer(TRUE), LPARAM(PChar(Folder))) else begin SHGetMAlloc(Allocator); try SHGetSpecialFolderLocation(Application.MainForm.Handle, CSIDL_DRIVES, Location); SendMessage(Wnd, BFFM_SETSELECTION, Integer(FALSE), LPARAM(Location)); finally Allocator.Free(Location); end; end; case Position of poScreenCenter: CenterWindowOnScreen(Wnd); poCustom: SetWindowPos(Wnd, 0, CustomLeft, CustomTop, 0, 0, SWP_NOSIZE or SWP_NOZORDER); end; end; except end; Result := 0; end; {$ENDIF} constructor TKBrowseFolderDialog.Create(AOwner: TComponent); begin inherited; FParentWindow := nil; FFolder := ''; FLabelText := sBrowseDirectory; FOptions := [bfSetFolder, bfReturnOnlyFSDirs, bfDontGoBelowDomain, bfUseNewUI]; FRootFolder := brDesktop; FPosition := poScreenCenter; FCustomLeft := 100; FCustomTop := 100; end; function TKBrowseFolderDialog.Execute: Boolean; {$IFDEF MSWINDOWS} var BI: TBrowseInfo; Buf: PChar; List, Root: PItemIDList; Allocator: IMalloc; DesktopFolder: IShellFolder; I: Integer; Eaten, Flags: LongWord; {$IFDEF FPC} DisabledList: TList; {$ELSE} P: Pointer; {$ENDIF} begin Result := False; SHGetMAlloc(Allocator); if Allocator <> nil then begin GetMem(Buf, MAX_PATH); {$IFDEF FPC} DisabledList := Screen.DisableForms(nil, nil); {$ELSE} P := DisableTaskWindows(0); {$ENDIF} try if FParentWindow <> nil then BI.hwndOwner := FParentWindow.Handle else BI.hwndOwner := Application.MainForm.Handle; case FRootFolder of brAdminTools: I := CSIDL_ADMINTOOLS; brAltStartUp: I := CSIDL_ALTSTARTUP; brAppData: I := CSIDL_APPDATA; brBitBucket: I := CSIDL_BITBUCKET; brCommonAdminTools: I := CSIDL_COMMON_ADMINTOOLS; brCommonAltStartUp: I := CSIDL_COMMON_ALTSTARTUP; brCommonAppData: I := CSIDL_COMMON_APPDATA; brCommonDesktopDirectory: I := CSIDL_COMMON_DESKTOPDIRECTORY; brCommonDocuments: I := CSIDL_COMMON_DOCUMENTS; brCommonFavorites: I := CSIDL_COMMON_FAVORITES; brCommonPrograms: I := CSIDL_COMMON_PROGRAMS; brCommonStartMenu: I := CSIDL_COMMON_STARTMENU; brCommonStartUp: I := CSIDL_COMMON_STARTUP; brControls: I := CSIDL_CONTROLS; brCookies: I := CSIDL_COOKIES; brDesktop: I := CSIDL_DESKTOP; brDesktopDirectory: I := CSIDL_DESKTOPDIRECTORY; brDrives: I := CSIDL_DRIVES; brFavorites: I := CSIDL_FAVORITES; brFonts: I := CSIDL_FONTS; brHistory: I := CSIDL_HISTORY; brInternet: I := CSIDL_INTERNET; brInternetCache: I := CSIDL_INTERNET_CACHE; brLocalAppData: I := CSIDL_LOCAL_APPDATA; brMyMusic: I := CSIDL_MYMUSIC; brMyPictures: I := CSIDL_MYPICTURES; brNetHood: I := CSIDL_NETHOOD; brNetwork: I := CSIDL_NETWORK; brPersonal: I := CSIDL_PERSONAL; brPrinters: I := CSIDL_PRINTERS; brPrintHood: I := CSIDL_PRINTHOOD; brProgramFiles: I := CSIDL_PROGRAM_FILES; brProgramFilesCommon: I := CSIDL_PROGRAM_FILES_COMMON; brPrograms: I := CSIDL_PROGRAMS; brRecent: I := CSIDL_RECENT; brSendTo: I := CSIDL_SENDTO; brStartMenu: I := CSIDL_STARTMENU; brStartUp: I := CSIDL_STARTUP; brSystem: I := CSIDL_SYSTEM; brTemplates: I := CSIDL_TEMPLATES; brWindows: I := CSIDL_WINDOWS; else I := CSIDL_DESKTOP; end; if FRootFolder <> brCustom then SHGetSpecialFolderLocation(Application.MainForm.Handle, I, Root) else begin SHGetDesktopFolder(DesktopFolder); try Eaten := 0; Flags := 0; DesktopFolder.ParseDisplayName(Application.MainForm.Handle, nil, PWideChar(WideString(FCustomRootFolder)), Eaten, Root, Flags); except Root := nil; end; end; BI.pidlRoot := Root; BI.pszDisplayName := Buf; BI.lpszTitle := PChar(FLabelText); BI.ulFlags := 0; if bfBrowseForComputer in FOptions then BI.ulFlags := BIF_BROWSEFORCOMPUTER; if bfBrowseForPrinter in FOptions then BI.ulFlags := BI.ulFlags or BIF_BROWSEFORPRINTER; if bfBrowseIncludeFiles in FOptions then BI.ulFlags := BI.ulFlags or BIF_BROWSEINCLUDEFILES; if bfBrowseIncludeURLs in FOptions then BI.ulFlags := BI.ulFlags or BIF_BROWSEINCLUDEURLS or BIF_USENEWUI or BIF_BROWSEINCLUDEFILES; if bfEditBox in FOptions then BI.ulFlags := BI.ulFlags or BIF_EDITBOX; if bfNewDialogStyle in FOptions then BI.ulFlags := BI.ulFlags or BIF_NEWDIALOGSTYLE; if bfReturnFSAncestors in FOptions then BI.ulFlags := BI.ulFlags or BIF_RETURNFSANCESTORS; if bfReturnOnlyFSDirs in FOptions then BI.ulFlags := BIF_RETURNONLYFSDIRS; if bfShareAble in FOptions then BI.ulFlags := BIF_SHAREABLE or BIF_USENEWUI; if bfStatusText in FOptions then BI.ulFlags := BI.ulFlags or BIF_STATUSTEXT; if bfUseNewUI in FOptions then BI.ulFlags := BI.ulFlags or BIF_USENEWUI; if bfValidate in FOptions then BI.ulFlags := BI.ulFlags or BIF_VALIDATE; BI.lpfn := BFCallBack; BI.lParam := Integer(Self); List := SHBrowseForFolder({$IFDEF FPC}@BI{$ELSE}BI{$ENDIF}); if List <> nil then begin SHGetPathFromIDList(List, Buf); Allocator.Free(List); FFolder := Buf; Result := True; end; finally {$IFDEF FPC} Screen.EnableForms(DisabledList); {$ELSE} EnableTaskWindows(P); {$ENDIF} Allocator.Free(Root); FreeMem(Buf); end; end; end; {$ELSE} begin Result := False; end; {$ENDIF} procedure TKBrowseFolderDialog.SetFolder(const Value: TFolder); begin FFolder := Value; end; end. tomboy-ng_0.34-1/kcontrols/source/kprintsetup.pas0000644000175000017500000003213714125207534022037 0ustar dbannondbannon{ @abstract(This file is part of the KControls component suite for Delphi and Lazarus.) @author(Tomas Krysl) Copyright (c) 2020 Tomas Krysl

License:
This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } unit kprintsetup; // lowercase name because of Lazarus/Linux {$include kcontrols.inc} interface uses {$IFDEF FPC} LCLType, LCLIntf, LResources, {$IFnDEF LCLWinCE}PrintersDlgs, {$ENDIF} {$ELSE} Windows, Messages, Dialogs, {$ENDIF} SysUtils, Variants, Classes, Graphics, Controls, Forms, StdCtrls, ExtCtrls, KControls, KPrintPreview; type TPrintEvent = procedure(PageSetup: TKPrintPageSetup) of object; TExtPrintOption = ( xpoRange, xpoScale ); TExtPrintOptions = set of TExtPrintOption; { TKPrintSetupForm } TKPrintSetupForm = class(TForm) BUConfigure: TButton; CoBPrinterName: TComboBox; EDTitle: TEdit; GBFileToPrint: TGroupBox; GBPrinter: TGroupBox; GBPrintOptions: TGroupBox; LBPrinterName: TLabel; BUPrint: TButton; BUCancel: TButton; CBFitToPage: TCheckBox; CBPageNumbers: TCheckBox; CBUseColor: TCheckBox; GBMargins: TGroupBox; CoBMarginUnits: TComboBox; LBMarginUnits: TLabel; CBMirrorMargins: TCheckBox; GBPageSelection: TGroupBox; RBAll: TRadioButton; RBRange: TRadioButton; RBSelectedOnly: TRadioButton; LBRangeTo: TLabel; LBCopies: TLabel; EDLeft: TEdit; LBLeft: TLabel; LBRight: TLabel; EDRight: TEdit; EDTop: TEdit; LBTop: TLabel; EDBottom: TEdit; LBBottom: TLabel; EDRangeFrom: TEdit; EDRangeTo: TEdit; EDCopies: TEdit; Label1: TLabel; EDPrintScale: TEdit; LBUnitsLeft: TLabel; LBUnitsTop: TLabel; LBUnitsRight: TLabel; LBUnitsBottom: TLabel; BUPreview: TButton; CBPaintSelection: TCheckBox; BUOk: TButton; CBPrintTitle: TCheckBox; CBCollate: TCheckBox; CBLineNumbers: TCheckBox; CBWrapLines: TCheckBox; procedure BUConfigureClick(Sender: TObject); procedure CoBMarginUnitsChange(Sender: TObject); procedure RBAllClick(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure BUPreviewClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure EDTopExit(Sender: TObject); procedure CBPageNumbersClick(Sender: TObject); procedure BUPrintClick(Sender: TObject); procedure FormShow(Sender: TObject); private { Private declarations } FPrevSetup: TKPrintPageSetup; FPageSetup: TKPrintPageSetup; FPreviewForm: TKCustomPrintPreviewForm; FPreviewCreated: Boolean; FSelAvail: Boolean; FUpdateLock: Boolean; FOnPrintClick: TPrintEvent; FOptionsVisible: TKPrintOptions; FOptionsEnabled: TKPrintOptions; FExtOptionsEnabled: TExtPrintOptions; {$IFnDEF LCLWinCE} FPSD: TPrinterSetupDialog; {$ENDIF} procedure SetPageSetup(const Value: TKPrintPageSetup); procedure SetPreviewForm(const Value: TKCustomPrintPreviewForm); protected procedure PageSetupToForm; virtual; procedure FormToPageSetup; virtual; procedure ValidateForm; public { Public declarations } property PageSetup: TKPrintPageSetup read FPageSetup write SetPageSetup; property PreviewForm: TKCustomPrintPreviewForm read FPreviewForm write SetPreviewForm; property SelAvail: Boolean read FSelAvail write FSelAvail; property OnPrintClick: TPrintEvent read FOnPrintClick write FOnPrintClick; property OptionsVisible: TKPrintOptions read FOptionsVisible write FOptionsVisible; property OptionsEnabled: TKPrintOptions read FOptionsEnabled write FOptionsEnabled; property ExtOptionsEnabled: TExtPrintOptions read FExtOptionsEnabled write FExtOptionsEnabled; end; implementation {$IFDEF FPC} {$R *.lfm} {$ELSE} {$R *.dfm} {$ENDIF} uses Printers, KFunctions, KRes, KMessageBox; procedure TKPrintSetupForm.FormCreate(Sender: TObject); begin FPageSetup := nil; FPrevSetup := TKPrintPageSetup.Create(nil); FPreviewForm := nil; FPreviewCreated := False; FOptionsVisible := [poCollate..poUseColor]; FOptionsEnabled := FOptionsVisible; FExtOptionsEnabled := [Low(TExtPrintOption)..High(TExtPrintOption)]; {$IfnDEF LCLWinCE} FPSD := TPrinterSetupDialog.Create(Self); {$IFDEF FPC} FPSD.Title := sPSPrinterSetup; {$ENDIF} {$ENDIF} end; procedure TKPrintSetupForm.FormDestroy(Sender: TObject); begin if FPreviewCreated then begin FPreviewForm.Free; FPreviewCreated := False; end; FPrevSetup.Free; end; procedure TKPrintSetupForm.FormShow(Sender: TObject); begin PageSetupToForm; end; procedure TKPrintSetupForm.PageSetupToForm; function FmtMargin(Value: Double): string; const Fmt = '%.*f'; var Precision: Integer; begin case FPageSetup.Units of puCM: Precision := 1; puMM: Precision := 0; puInch: Precision := 2; else Precision := 0; end; Result := Format(Fmt, [Precision, Value]); end; function FmtUnit: string; begin case FPageSetup.Units of puMM: Result := 'mm'; puInch: Result := '"'; puHundredthInch: Result := '".100'; else Result := 'cm'; end; end; procedure SetupCheckBox(CB: TCheckBox; Option: TKPrintOption); begin CB.Checked := Option in FPageSetup.Options; CB.Enabled := Option in FOptionsEnabled; CB.Visible := Option in FOptionsVisible; end; var S: string; begin if Assigned(FPageSetup) then begin FUpdateLock := True; try SetupCheckBox(CBCollate, poCollate); SetupCheckBox(CBFitToPage, poFitToPage); SetupCheckBox(CBPageNumbers, poPageNumbers); SetupCheckBox(CBUseColor, poUseColor); SetupCheckBox(CBPaintSelection, poPaintSelection); SetupCheckBox(CBPrintTitle, poTitle); SetupCheckBox(CBLineNumbers, poLineNumbers); SetupCheckBox(CBWrapLines, poWrapLines); SetupCheckBox(CBMirrorMargins, poMirrorMargins); try CoBPrinterName.Text := ''; CoBPrinterName.Items.Assign(Printer.Printers); CoBPrinterName.ItemIndex := CoBPrinterName.Items.IndexOf(FPageSetup.PrinterName); if FPageSetup.IsDefaultPrinter then begin if CoBPrinterName.ItemIndex < 0 then CoBPrinterName.ItemIndex := Printer.PrinterIndex; end else begin // no default printer selected! if CoBPrinterName.Items.Count > 0 then CoBPrinterName.ItemIndex := 0; end; except // silent, keep default or successfully obtained data end; RBSelectedOnly.Enabled := FPageSetup.SelAvail and FSelAvail; case FPageSetup.Range of prRange: RBRange.Checked := True; prAll: RBAll.Checked := True; prSelectedOnly: RBSelectedOnly.Checked := True; end; RBAll.Caption := Format(sPSAllPages, [FPageSetup.PageCount]); RBRange.Enabled := xpoRange in FExtOptionsEnabled; EDRangeFrom.Enabled := RBRange.Checked and RBRange.Enabled; EDRangeFrom.Text := IntToStr(FPageSetup.StartPage); EDRangeTo.Enabled := RBRange.Checked and RBRange.Enabled; EDRangeTo.Text := IntToStr(FPageSetup.EndPage); EDCopies.Text := IntToStr(FPageSetup.Copies); EDPrintScale.Enabled := not CBFitTopage.Checked and (xpoScale in FExtOptionsEnabled); EDPrintScale.Text := IntToStr(FPageSetup.Scale); EDTitle.Text := FPageSetup.Title; CoBMarginUnits.ItemIndex := Integer(FPageSetup.Units); S := FmtUnit; EDBottom.Text := FmtMargin(FPageSetup.UnitMarginBottom); LBUnitsBottom.Caption := S; EDLeft.Text := FmtMargin(FPageSetup.UnitMarginLeft); LBUnitsLeft.Caption := S; EDRight.Text := FmtMargin(FPageSetup.UnitMarginRight); LBUnitsRight.Caption := S; EDTop.Text := FmtMargin(FPageSetup.UnitMarginTop); LBUnitsTop.Caption := S; finally FUpdateLock := False; end; end; end; procedure TKPrintSetupForm.FormToPageSetup; var Options: TKPrintOptions; begin if Assigned(FPageSetup) and not FUpdateLock then begin FPageSetup.LockUpdate; try Options := []; if CBCollate.Checked then Include(Options, poCollate); if CBFitToPage.Checked then Include(Options, poFitToPage); if CBPageNumbers.Checked then Include(Options, poPageNumbers); if CBUseColor.Checked then Include(Options, poUseColor); if CBPaintSelection.Checked then Include(Options, poPaintSelection); if CBPrintTitle.Checked then Include(Options, poTitle); if CBMirrorMargins.Checked then Include(Options, poMirrorMargins); if CBLineNumbers.Checked then Include(Options, poLineNumbers); if CBWrapLines.Checked then Include(Options, poWrapLines); FPageSetup.PrinterName := CoBPrinterName.Text; FPageSetup.Options := Options; if RBSelectedOnly.Checked then FPageSetup.Range := prSelectedOnly else if RBRange.Checked then FPageSetup.Range := prRange else FPageSetup.Range := prAll; FPageSetup.StartPage := StrToIntDef(EDRangeFrom.Text, FPageSetup.StartPage); FPageSetup.EndPage := StrToIntDef(EDRangeTo.Text, FPageSetup.EndPage); FPageSetup.Copies := StrToIntDef(EDCopies.Text, FPageSetup.Copies); FPageSetup.Scale := StrToIntDef(EDPrintScale.Text, FPageSetup.Scale); FPageSetup.Title := EDTitle.Text; FPageSetup.Units := TKPrintUnits(CoBMarginUnits.ItemIndex); FPageSetup.UnitMarginBottom := StrToFloatDef(AdjustDecimalSeparator(EDBottom.Text), FPageSetup.UnitMarginBottom); FPageSetup.UnitMarginLeft := StrToFloatDef(AdjustDecimalSeparator(EDLeft.Text), FPageSetup.UnitMarginLeft); FPageSetup.UnitMarginRight := StrToFloatDef(AdjustDecimalSeparator(EDRight.Text), FPageSetup.UnitMarginRight); FPageSetup.UnitMarginTop := StrToFloatDef(AdjustDecimalSeparator(EDTop.Text), FPageSetup.UnitMarginTop); finally FPageSetup.UnlockUpdate; end; end; end; procedure TKPrintSetupForm.BUPrintClick(Sender: TObject); begin FormToPageSetup; if Assigned(FOnPrintClick) then FOnPrintClick(FPageSetup) else FPageSetup.PrintOut; end; procedure TKPrintSetupForm.BUConfigureClick(Sender: TObject); var PrinterCount: Integer; begin {$IFDEF LCLWinCE} KMsgBox(sPSErrPrintSetup, sPSErrPrinterConfiguration, [mbOk], miStop) {$ELSE} FormToPageSetup; if FPageSetup.IsDefaultPrinter then begin PrinterCount := 0; try PrinterCount := Printer.Printers.Count; Printer.Orientation := FPageSetup.Orientation; Printer.Copies := FPageSetup.Copies; if FPSD.Execute then begin FPageSetup.LockUpdate; try FPageSetup.Orientation := Printer.Orientation; FPageSetup.Copies := Printer.Copies; finally FPageSetup.UnlockUpdate; end; PageSetupToForm; end; except if PrinterCount = 0 then KMsgBox(sPSErrPrintSetup, sPSErrNoPrinterInstalled, [mbOk], miStop) else KMsgBox(sPSErrPrintSetup, sPSErrPrinterUnknown, [mbOk], miStop); end end else KMsgBox(sPSErrPrintSetup, sPSErrNoDefaultPrinter, [mbOk], miStop) {$ENDIF} end; procedure TKPrintSetupForm.EDTopExit(Sender: TObject); begin if not FUpdateLock then ValidateForm; end; procedure TKPrintSetupForm.CoBMarginUnitsChange(Sender: TObject); begin if Assigned(FPageSetup) then begin FPageSetup.Units := TKPrintUnits(CoBMarginUnits.ItemIndex); PageSetupToForm; end; end; procedure TKPrintSetupForm.CBPageNumbersClick(Sender: TObject); begin FormToPageSetup; end; procedure TKPrintSetupForm.RBAllClick(Sender: TObject); begin if not FUpdateLock then ValidateForm; end; procedure TKPrintSetupForm.SetPageSetup(const Value: TKPrintPageSetup); begin if Value <> FPageSetup then begin FPrevSetup.Assign(Value); FPageSetup := Value; PageSetupToForm; end; end; procedure TKPrintSetupForm.SetPreviewForm(const Value: TKCustomPrintPreviewForm); begin if Value <> FPreviewForm then begin if FPreviewCreated then begin FPreviewForm.Free; FPreviewCreated := False; end; FPreviewForm := Value; end; end; procedure TKPrintSetupForm.ValidateForm; begin FormToPageSetup; PageSetupToForm; end; procedure TKPrintSetupForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin if FPreviewCreated then FPreviewForm.Hide; if ModalResult = mrOk then FormToPageSetup else if Assigned(FPageSetup) then FPageSetup.Assign(FPrevSetup); end; procedure TKPrintSetupForm.BUPreviewClick(Sender: TObject); begin ValidateForm; if FPreviewForm = nil then begin FPreviewForm := TKPrintPreviewForm.Create(nil); FPreviewCreated := True; end; if FPreviewForm is TKPrintPreviewForm then TKPrintPreviewForm(FPreviewForm).Preview.Control := FPageSetup.Control; FPreviewForm.Show; end; end. tomboy-ng_0.34-1/kcontrols/source/kcontrols.lrs0000644000175000017500000000410514125207534021474 0ustar dbannondbannonLazarusResources.Add('kpreview_cursor_hand_free','CUR',[ #0#0#2#0#1#0' '#0#0#15#0#15#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#128#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#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#3#240#0 +#0#3#240#0#0#7#240#0#0#15#248#0#0#31#248#0#0#31#252#0#0'?'#252#0#0'w'#252#0#0 +'g'#254#0#0#7#246#0#0#13#182#0#0#13#178#0#0#25#176#0#0#25#176#0#0#1#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#255#255 +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 +#255#255#255#255#255#255#255#255#255#255#255#255#248#7#255#255#248#7#255#255 +#240#7#255#255#224#3#255#255#192#3#255#255#192#1#255#255#128#1#255#255#0#1 +#255#255#0#0#255#255#144#0#255#255#224#0#255#255#224#0#255#255#192#5#255#255 +#192#7#255#255#228#15#255#255#254#127#255#255#255#255#255#255#255#255#255#255 +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 +#255#255#255#255 ]); LazarusResources.Add('kpreview_cursor_hand_grip','CUR',[ #0#0#2#0#1#0' '#0#0#15#0#15#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#128#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#0#0#0#0#0#0#0#0#0#0#0#0#0#0#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#224#0#0#7#224#0#0#15#224#0#0#31#240#0#0'?'#240#0#0'?'#248 +#0#0#15#248#0#0#15#248#0#0#31#232#0#0#27'`'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 +#0#0#0#0#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#240#15#255#255#240#15#255#255#224#15#255#255#192#7#255#255#128#7#255 +#255#128#3#255#255#192#3#255#255#224#3#255#255#192#3#255#255#192#7#255#255 +#228#159#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 +#255#255#255#255#255 ]); tomboy-ng_0.34-1/kcontrols/source/kmessagebox.res0000644000175000017500000003612414125207534021765 0ustar dbannondbannon @ KMESSAGEBOX_STOP0PNG  IHDR00WkIDATh}?9{}a‚"J)Ԥ6iim-mim*hZ4Z[iS"M5%(^^Teua}sv{gws.\;ɓ9/3s>~G%͵BB! RJLf̘A84MLDJYy&d2y<m{GK3hnnUU4440cƌܹ-۷ooJ3xW7!?~dܹyX7?{񔗣(~?ȱ7iteW^U(H)9<]]]W._{% '_]vTTT_d H4D|t׋OYc$쳔١!L]ߧbzR$ Ν;nڴi#ʏ]v\,Yɧ?'-HU^lQ^Ju2}} *x}!Du:;;9?z"qUv1sK.0 2(]K҆=k9ADi$;;Qgbs!B!>S:;;hjjx-<؈a <ɉ\YB\//!%spݻ,Z `Fef߿mRxW7TVV>|r <kOee41P9޳RZmn5ϴ@UU:ڭBy9PL&S___?z詉HK?VXdFóz5% j_II)`?~ĩ6}[hЄkn?tŻwSr cy!ldKX,=vڟlߏOHaʔ)'2@0;w3?|rLӤ`ӧ_3_4Mj =<.a:,hE(1ءCcr@CQg I&5'O>sɳ@v\[͛:y̙f a:\Pg_?3gR3 H$r.f=xߔ);at]oqOAk˖-4M>پxa+A]{0 rDV`УQ 7s&ӷo'JN f-//';((B L\&lh2::ZJtuu9QPEy6uR9uqu]ϓȪ*SmW['dHs\޲,t*׮D"aA(n;V:YoD&8~L-0'୩aOKIRd24DD"o~h4oz4L*eeeB[R 677,Xa|!-޴ L;R7pǻ % ڞu4QǃQZZʬjھMRgX@'0 TUE4B(B?OY)IttԄL&wNfN*"JxH~TK@Qh.*%%%TE1# "$YMZtX fryMJi^/@ ȶ^49S&`&#G}[:dz{ M̽2(4 MPU5o0Mx5ґ}VZZP.`0Xmz @O\9}to/4Bim?gvHy:?1ٳc^VqQ(\UEP4lyϤ!}U!R+#LUUfQ@pq xs~Pq.rR׹bw>"o9scq -bΞ=UsaPL#+W"u}Ȃ,~mb,lepʧOQR2 ǃiB)E׷bEZ[[;֍ 3JH))[z !Xg 2x A|&F7oDae-&L&I$ǏL]XWQ#uϴivtzuFS+Wlj2R]]|"|FMTNj/Z2(-e҆ η6mZAsF" #/ˏފ޻o~3i7nD Q.= ~{y%뮻h6+&zo︐_޻@Ue,-yaֻ} y'2RFw]zPn# wm7`vsT< sygť~l,FϷ7 DmS˝VSq Xn;eUʋ/B(D<ȑ#g}Ç.Qn ȧ~˿jkkCuKJ>_w >sỈ(O[['Nxg! /}kqϝ4iedyi͊#fXKf3ClۆRW>裃[lyq-jMD|뭷ZtirNyyEb?F Xmg$an:łO?m>S%,xj$߿:[p8Y 1Z[v5) k/ '"BQza:u} rp&ۿK,JKJJ4 Q_rHMNO # {//z!H$p8pt:B! yWcTW[H1\BoGw45.YzBpZZZSSSXxl*Pr=DEEŊɓ';;(ݨ Zkk,J[5s\x/C.c%s 2FƍmB #H[0at&app!GGyeǎ1R9̗Zt+W]lنP(tK !  RK:fttD"FOݻwѣGaR|Xĥu555&MT_RRr] vFbEQfTjҥKg[[[;;mM0ۤUUV}E|4ܖxE1 c_mH?eIENDB`cH KMESSAGEBOX_QUESTION0PNG  IHDR00W*IDAThyl}?ｙ{I(JdIBZY W@m+Hmu[M A&E5l SH|nR[%[2):(K$E}.qf~w >6ɇj.؉_DBEPZ^pxs<4}~+OYx(O>f?l&ӚRzJ5Jǩ?xr/ 81 V߰nU+p=bե\7}h4`*0 0h-(,Kʥs]S_QC؀߿WHuߦ#o#0/\/xn߮9 mv\( 3NmS+1`|߃h}@;628Lpt.YIA 7,,Ѭ-x;/w9|/n޸=l&'뜾hzA=k0.b@{ 4=}0I&CKs[sgV5`=n۹}:/ؼ5Qb]MqjdʘA8ZA!oZկgUO E#;7dssެO2l ֙(W]~N5RD@HT8 ̉_xj ..o@7Uf}]&_(A5Zg|Gy~e Dx?$vJp/)t۱-yoMyᶛVm=CۀlJƮ([so{. =4n{G~|drh B$#ѿXK'СD!}w\Eytc)pk^a<}FƗkn˺$?H2gݞHe" _xgq)= -۷qff. @ߒٷ(V\ה*_mvz}/YR #L@#$H/b+Gbw{A:f c+94YToQJPyL:2+,R9OȮ-F D5rʥF2 ` hR)틅`k/1,>:LfM^=ZϿ3͛'jA2!l Iz#?YdזTLjmL,il~4S6S3>THf<2R>Y|d#HafdGwV%)z`8=Q+ 7hw}M)<.l:לPs@RE{M0< ]2 lawsiUtR /zA"l=MJ_}ne(w3 0 D~t !wg)ռ+54Z,qs_K. .\!7RuáF +=`@FJVA!8x44lYkuH'?t R$ ٪k Rh !`RȤ_t.~SixmŦU^rULGϻd+E!HFoSh45l|M:`Zƪfh>{}.ug~^?ިN h1#-R!4)̴<"[Q44lB 2hgcxϦU&w|fxIxk7+з*Pk:bCBPR`:2P@>P,T^q._~iZC\"7@Az Z`^5оwTłC A;$m4[XOvH?|ل|t.@Cg@PpCךE G's1ٽ%Zl{&>3}GX PB:_"~|ߩ <>R(0]q\;h@+5L]p1)J+Rbs +r8`^)I:!7B 6jMTqL#jq)b3<[\Y @G蔒_NjMfDY~\u81;[bI;=UJ8ovG !gi e# 4W}SvT%)Xt$HHydJ)̤J)R9tIf.ZDqm: $RzG:JnZFC%ҩ} :Ҡ͈6=CRy&0PF \S;P =G&ѵB-B Q\_tY+ ]߾OVBkF~كrg3y.V/2ZK'8<]Uê<@6)4*^{y +%PF(pHrT.yScN?{CFjpMOV檭4M)A';]k]Tm85H@6UdJ*/tr#7Qxl xkϿ[I~Le29${~j3˅&ԥ$İT%nu~tW^:q;jMv] _~aƷ+?Όl}BQ8= Ne\1#\JaP24??ȡ7N?p Ǧc/y7ATMCK#XIa.c{Ȏ~?81/&Lbcء'&7F/ z@f}~kw sňodP%(p*>0%}i`NK t sKߎf{mfzp\(3MR@k7STڥ♉ެ-q(6U/`CИ$d8(IxZFo/w; =IENDB`D KMESSAGEBOX_WARNING0PNG  IHDR00WgAMA|Q cHRMz%u0`:oSIDATxb?P8=@L }b`gɌ~ 1fdz&T@ ~S@F?{v՟o_7K,=@`_z? O \bgDM SSy c` %]TQȬ(F-@~a/Oz=__3}cP`$&p_@$oN=8y3|P :: CwyӬ ΰ2dt| `$ $"1O/rI`A#O?@G3=*q3؏_2ĸe 0] o1{MK,}&\om'&~CQ^zq0#23i~eP1,uK`y 2|l2ë4/ A@ ZPX21.Ŭ3HXaѭMeOD4sL<g`8 ,lA!f9i_A ≮uoBr3|g0pAVK-;2)~Ơwzh?#},, Gq2ܸ &]O*RB]^jb&-Mԋ=-} &ïp: |bțpo?0qd 03v8$s`|ph+'oL oT,n|UkR@c~ñ8ya)`TC&_f`dͰ8;++#-Xc%!a3\>p hGO SX#j1c l3Q_^9`XKÿ3T13reȞͰn?'Tb`p4ɰXW|dF @~bbس;&=`b$i C\*@8* f`vWʷ=dxAA+- zqobz|,.;9r0!;7J9k 'r{u=^34ճ7jb2 пߘ߫} f0ixĠWb)_0g8Fa'xPg4$nm`x|AE+w.̂@1||I `A+_C=$39cAUW!jBP,||İk#fd06Ġk>#GH,@- `aV.;ssJ?RAiFhFeb)]>0ىqɏv 6! NftVYȭUbo|z=])_~.24d#'oO`K22 , π5UFFHp`k`W.,7&>{ It^ ~p `Ի`h/&F7#j3\֟gdh  %Q_~3|~ edbafWXNeWtN$3s8LLF3@1QSc8wg aAjO,?_  0, ?2H1| FF$>X|&UKQ?zpN /px%L,*xHM1 #0$Bdę?߷{ɽcw=]m@EL7hٚt~ !cR* A}#4:3&b@õ7&pr +!`M}YANhL~Ю'*B'<51>+o~ 1{XWDJ+]lR6>cX؞/׀|1٠x}tjH(ꓬq$}] 誵 43d S@`:4qIdnF* Ca} F2pMm7/jMFTi{F!]`a`Tמ77mśAfqr~r[S;B@27ݭFkhLK;x_.*z,$"a( 3S>~EԤ^vޕ p=W]0~W]Mr{230Lced,\e),K0-8hh8*mkoז9Ϝ[Y|~_t3ŋHo'e ۧޑI1~#Wا +ZUYuvŮݟioN/]:NkxYD,LYe̠H8x^fo୪?`(U?_#=IENDB`tomboy-ng_0.34-1/kcontrols/source/kedits.lrs0000644000175000017500000000632614125207534020750 0ustar dbannondbannonLazarusResources.Add('opendir','BMP',[ 'BM8'#3#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#16#0#0#0#16#0#0#0#1#0#24#0#0#0#0#0#2#3#0 +#0#195#14#0#0#195#14#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'r'#138#143'p'#136#140'n'#133#138'n'#133#138'n'#133#138'n' +#133#138'n'#133#138'n'#133#138'n'#133#138'o'#135#139'}'#152#157#149#180#186 +#255#255#255#255#255#255#255#255#255')'#173#214')'#173#214')'#173#214')'#173 +#214')'#173#214')'#173#214')'#173#214')'#173#214')'#173#214')'#173#214'8'#160 +#193'X'#145#160'~'#153#158#255#255#255#255#255#255#255#255#255')'#173#214')' +#173#214'`'#234#254#142#240#254#149#241#254#154#241#254#156#242#254#154#241 +#254#149#241#254#142#240#254#131#238#254'7'#160#192'o'#134#138#147#178#184 +#255#255#255#255#255#255')'#173#214')'#173#214'`'#234#254#134#239#254#142#240 +#254#146#240#254#148#241#254#146#240#254#142#240#254#134#239#254'|'#238#254 +')'#173#214'W'#143#158'}'#151#156#255#255#255#255#255#255')'#173#214'h'#235 +#254')'#173#214'`'#234#254#129#238#254#134#239#254#135#239#254#134#239#254 +#129#238#254'{'#237#254'r'#236#254'h'#235#254'7'#160#192'o'#134#138#146#176 +#182#255#255#255')'#173#214'['#233#254')'#173#214'`'#234#254'q'#236#254'u' +#237#254'v'#237#254'u'#237#254'q'#236#254'k'#235#254'd'#234#254'['#233#254')' +#173#214'X'#145#160'}'#152#157#255#255#255')'#173#214'K'#231#254'R'#232#254 +')'#173#214'`'#234#254'`'#234#254'a'#234#254'`'#234#254']'#234#254'Y'#233#254 +'R'#232#254'K'#231#254'K'#231#254':'#164#196'u'#141#146#150#181#187')'#173 +#214'`'#233#253'e'#234#253')'#173#214')'#173#214')'#173#214')'#173#214')'#173 +#214')'#173#214')'#173#214')'#173#214')'#173#214')'#173#214')'#173#214'~'#191 +#208#255#255#255')'#173#214#127#237#253#129#238#254#131#238#253#133#238#253 +#133#238#254#134#238#253#133#238#254#133#238#253#131#238#253')'#173#214'u' +#142#147#162#196#202#255#255#255#255#255#255#255#255#255')'#173#214#164#242 +#253#165#242#254#166#242#253#167#243#254#167#243#254')'#173#214')'#173#214')' +#173#214')'#173#214')'#173#214#164#198#205#255#255#255#255#255#255#255#255 +#255#255#255#255#255#255#255')'#173#214#208#248#254#208#248#254#208#248#254 +')'#173#214#161#195#201#255#255#255#255#255#255#255#255#255#255#255#255#255 +#255#255#255#255#255'x'#145#150't'#140#145'o'#135#139#255#255#255#255#255#255 +')'#173#214')'#173#214')'#173#214#164#199#206#255#255#255#255#255#255#255#255 +#255'}'#151#156#255#255#255#255#255#255#0#162#0#0#163#0#0#158#0'n'#133#138 +#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#127#0#255#255#255'{'#149#154'z'#148#153'y'#147#152#0 +#167#0#0#162#0'q'#136#141#255#255#255#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#139#0#0#149#0#0 +#161#0#0#164#0#255#255#255#0#161#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 ]); tomboy-ng_0.34-1/kcontrols/source/kmessagebox.pas0000644000175000017500000003036314125207534021756 0ustar dbannondbannon{ @abstract(This file is part of the KControls component suite for Delphi and Lazarus.) @author(Tomas Krysl) Copyright (c) 2020 Tomas Krysl

License:
This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } unit kmessagebox; // lowercase name because of Lazarus/Linux {$include kcontrols.inc} {$WEAKPACKAGEUNIT ON} interface uses {$IFDEF FPC} LCLType, LCLIntf, LMessages, LCLProc, LResources, {$ELSE} Windows, Messages, {$ENDIF} Classes, Controls, Forms, KFunctions, KEdits {$IFDEF USE_THEMES} , Themes {$IFNDEF FPC} , UxTheme {$ENDIF} {$ENDIF} ; type TKMsgBoxButton = (mbYes, mbNo, mbOK, mbCancel, mbClose, mbAbort, mbRetry, mbIgnore, mbAll, mbNoToAll, mbYesToAll, mbHelp); TKMsgBoxIcon = (miNone, miInformation, miQuestion, miWarning, miStop); function CreateMsgBox(const Caption, Text: string; const Buttons: array of TKMsgBoxButton; Icon: TKMsgBoxIcon = miNone; Def: integer = 0): TCustomForm; function CreateMsgBoxEx(const Caption, Text: string; const Btns: array of string; Icon: TKMsgBoxIcon = miNone; Def: integer = 0): TCustomForm; procedure FreeMsgBox(AMsgBox: TCustomForm); function KMsgBox(const Caption, Text: string; const Buttons: array of TKMsgBoxButton; Icon: TKMsgBoxIcon = miNone; Def: integer = 0): integer; function KMsgBoxEx(const Caption, Text: string; const Buttons: array of string; Icon: TKMsgBoxIcon = miNone; Def: integer = 0): integer; function KInputBox(const Caption, Prompt: string; var Text: string): TModalResult; function KNumberInputBox(const ACaption, APrompt: string; var AValue: double; AMin, AMax: double; AFormats: TKNumberEditAcceptedFormats = [neafDec]): TModalResult; //Win32 API message box type TKMsgBoxButtons = (mbAbortRetryIgnore, mbOkOnly, mbOkCancel, mbRetryCancel, mbYesNo, mbYesNoCancel); function MsgBox(const Caption, Text: string; const Buttons: TKMsgBoxButtons; Icon: TKMsgBoxIcon = miNone): integer; function AppMsgBox(const Caption, Text: string; Flags: integer): integer; implementation uses Math, StdCtrls, ExtCtrls, SysUtils, KGraphics, KControls, KRes; type TMsgBoxForm = class(TCustomForm) private FCloseResult: integer; procedure SetCloseResult(const Value: integer); procedure WMCloseQuery(var M: TLMessage); message LM_CLOSEQUERY; protected public constructor Create(AOwner: TComponent); override; property CloseResult: integer read FCloseResult write SetCloseResult; end; function StdButtons(ButtonType: TKMsgBoxButton): string; begin case ButtonType of mbYes: Result := sMsgBoxYes; mbNo: Result := sMsgBoxNo; mbOK: Result := sMsgBoxOk; mbCancel: Result := sMsgBoxCancel; mbClose: Result := sMsgBoxClose; mbAbort: Result := sMsgBoxAbort; mbRetry: Result := sMsgBoxRetry; mbIgnore: Result := sMsgBoxIgnore; mbAll: Result := sMsgBoxAll; mbNoToAll: Result := sMsgBoxNoToAll; mbYesToAll: Result := sMsgBoxYesToAll; mbHelp: Result := sMsgBoxHelp; end; end; { TMsgBoxForm } constructor TMsgBoxForm.Create(AOwner: TComponent); begin GlobalNameSpace.BeginWrite; try CreateNew(AOwner); finally GlobalNameSpace.EndWrite; end; end; procedure TMsgBoxForm.SetCloseResult(const Value: integer); begin FCloseResult := Value; end; procedure TMsgBoxForm.WMCloseQuery(var M: TLMessage); begin // we need new behavior here ModalResult := FCloseResult; end; function CreateMsgBox(const Caption, Text: string; const Buttons: array of TKMsgBoxButton; Icon: TKMsgBoxIcon = miNone; Def: integer = 0): TCustomForm; var Btns: array of string; I: integer; begin SetLength(Btns, Length(Buttons)); for I := 0 to High(Buttons) do Btns[I] := StdButtons(Buttons[I]); Result := CreateMsgBoxEx(Caption, Text, Btns, Icon, Def); Btns := nil; end; function CreateMsgBoxEx(const Caption, Text: string; const Btns: array of string; Icon: TKMsgBoxIcon = miNone; Def: integer = 0): TCustomForm; function FindBtn(const ACaption: string): integer; var I: integer; begin Result := -1; for I := Low(Btns) to High(Btns) do if Btns[I] = ACaption then begin Result := I; Exit; end; end; var F: TMsgBoxForm; B: TButton; La: TLabel; TB: TKTextBox; I, L, L1, L2, W, H, H1: integer; ICancel, INo: integer; IsCancel, IsFirstBtn: boolean; {$IFDEF USE_PNG_SUPPORT} Png: TKPngImage; Im: TImage; S: string; {$ENDIF} begin F := TMsgBoxForm.Create(Application); try IsFirstBtn := True; IsCancel := False; F.BorderStyle := bsDialog; F.Position := poScreenCenter; F.Caption := Caption; La := TLabel.Create(F); TB := TKTextBox.Create; try TB.Text := Text; TB.Attributes := [taLineBreak]; TB.Measure(F.Canvas, CreateEmptyRect, W, H); finally TB.Free; end; La.Caption := Text; La.AutoSize := False; La.Width := W + 20; La.Height := H + 10; La.Parent := F; L := 20; H1 := 0; {$IFDEF USE_PNG_SUPPORT} if Icon <> miNone then begin Im := TImage.Create(F); Png := TKPngImage.Create; try case Icon of miInformation: S := 'KMESSAGEBOX_INFO'; miQuestion: S := 'KMESSAGEBOX_QUESTION'; miWarning: S := 'KMESSAGEBOX_WARNING'; miStop: S := 'KMESSAGEBOX_STOP'; end; {$IFDEF FPC} Png.LoadFromLazarusResource(S); {$ELSE} Png.LoadFromResourceName(HInstance, S); {$ENDIF} Im.Picture.Assign(Png); Im.Width := Png.Width; Im.Height := Png.Height; finally Png.Free; end; Im.Transparent := True; Im.Parent := F; Im.Left := L; Inc(L, Im.Width + 15); H1 := Im.Height; Im.Top := 15 + Max(0, (La.Height - H1) div 2); end; {$ENDIF} La.Left := L; La.Top := 15 + Max(0, (H1 - La.Height) div 2); L1 := 20; for I := Low(Btns) to High(Btns) do Inc(L1, Max(F.Canvas.TextWidth(Btns[I]) + 30, 90)); Dec(L1, 10); L2 := L + LA.Width; H1 := 30 + Max(La.Height, H1); H := H1; if L2 > L1 then L := (L2 - L1) div 2 else L := 0; Inc(L, 20); ICancel := FindBtn(sMsgBoxCancel); INo := FindBtn(sMsgBoxNo); for I := Low(Btns) to High(Btns) do begin W := Max(F.Canvas.TextWidth(Btns[I]) + 20, 80); B := TButton.Create(F); B.Parent := F; B.Caption := Btns[I]; B.Left := L; B.Top := H; B.Width := W; if IsFirstBtn then begin Inc(H1, B.Height); IsFirstBtn := False; end; if Def = I then F.ActiveControl := B; if not IsCancel and ((Length(Btns) = 1) or (ICancel = I) or (INo = I) and (ICancel < 0)) then begin B.Cancel := True; F.CloseResult := I + 1; IsCancel := True; end; B.ModalResult := TModalResult(I + 1); Inc(L, W + 10); end; F.ClientWidth := Max(L1, L2) + 20; F.ClientHeight := H1 + 15; {$IFNDEF FPC} // this just disables the cancel box in system menu, not absolutely needed if not IsCancel then EnableMenuItem(GetSystemMenu(F.Handle, False), SC_CLOSE, MF_DISABLED); {$ENDIF} except FreeAndNil(F); end; Result := TCustomForm(F); end; procedure FreeMsgBox(AMsgBox: TCustomForm); begin AMsgBox.Free; end; function KMsgBox(const Caption, Text: string; const Buttons: array of TKMsgBoxButton; Icon: TKMsgBoxIcon = miNone; Def: integer = 0): integer; var F: TCustomForm; begin F := CreateMsgBox(Caption, Text, Buttons, Icon, Def); try if F <> nil then begin DPIScaleControl(F); Result := F.ShowModal end else Result := -1; finally F.Free; end; end; function KMsgBoxEx(const Caption, Text: string; const Buttons: array of string; Icon: TKMsgBoxIcon = miNone; Def: integer = 0): integer; var F: TCustomForm; begin F := CreateMsgBoxEx(Caption, Text, Buttons, Icon, Def); try if F <> nil then Result := F.ShowModal else Result := -1; finally F.Free; end; end; function KInputBox(const Caption, Prompt: string; var Text: string): TModalResult; var F: TForm; L: TLabel; E: TEdit; BUOk, BUCancel: TButton; W, I: integer; begin F := TForm.Create(Application); if F <> nil then begin F.Caption := Caption; F.BorderStyle := bsDialog; F.Position := poScreenCenter; L := TLabel.Create(F); L.Parent := F; E := TEdit.Create(F); E.Parent := F; BUOk := TButton.Create(F); BUOk.Parent := F; BUCancel := TButton.Create(F); BUCancel.Parent := F; try L.Caption := Prompt; W := Max(160, L.Canvas.TextWidth(Prompt)); F.Width := W + 60; F.Height := 140; I := (F.Width - F.ClientWidth) div 2; L.Left := 30 - I; L.Top := 15; L.FocusControl := E; E.Left := L.Left; E.Top := L.Top + 18; E.Width := Min(160, W); E.Text := Text; BUOk.Left := (F.Width - BUOk.Width - BUCancel.Width - 10) div 2 - I; BUOk.Top := E.Top + 35; BUOk.Caption := sMsgBoxOK; BUOk.Default := True; BUOk.ModalResult := mrOk; BUCancel.Left := BUOk.Left + BUOk.Width + 10; BUCancel.Top := BUOk.Top; BUCancel.Caption := sMsgBoxCancel; BUCancel.Cancel := True; BUCancel.ModalResult := mrCancel; CenterWindowOnScreen(F.Handle); Result := F.ShowModal; if Result = mrOk then Text := E.Text; finally F.Free; end; end else Result := mrCancel; end; function KNumberInputBox(const ACaption, APrompt: string; var AValue: double; AMin, AMax: double; AFormats: TKNumberEditAcceptedFormats = [neafDec]): TModalResult; var F: TForm; L: TLabel; E: TKNumberEdit; BUOk, BUCancel: TButton; W, I: integer; begin F := TForm.Create(Application); if F <> nil then begin F.Caption := ACaption; F.BorderStyle := bsDialog; L := TLabel.Create(F); L.Parent := F; E := TKNumberEdit.Create(F); E.Parent := F; BUOk := TButton.Create(F); BUOk.Parent := F; BUCancel := TButton.Create(F); BUCancel.Parent := F; try L.Caption := APrompt; W := Max(160, L.Canvas.TextWidth(APrompt)); F.Width := W + 60; F.Height := 140; I := (F.Width - F.ClientWidth) div 2; L.Left := 30 - I; L.Top := 15; L.FocusControl := E; E.Left := L.Left; E.Top := L.Top + 18; E.Width := Min(160, W); E.Options := E.Options - [neoUseUpDown, neoUseLabel]; E.AcceptedFormats := AFormats; E.Value := AValue; E.Min := AMin; E.Max := AMax; BUOk.Left := (F.Width - BUOk.Width - BUCancel.Width - 10) div 2 - I; BUOk.Top := E.Top + 35; BUOk.Caption := sMsgBoxOK; BUOk.Default := True; BUOk.ModalResult := mrOk; BUCancel.Left := BUOk.Left + BUOk.Width + 10; BUCancel.Top := BUOk.Top; BUCancel.Caption := sMsgBoxCancel; BUCancel.Cancel := True; BUCancel.ModalResult := mrCancel; CenterWindowOnScreen(F.Handle); Result := F.ShowModal; if Result = mrOk then AValue := E.Value; finally F.Free; end; end else Result := mrCancel; end; function MsgBox(const Caption, Text: string; const Buttons: TKMsgBoxButtons; Icon: TKMsgBoxIcon): integer; const WinButtons: array[TKMsgBoxButtons] of integer = (MB_ABORTRETRYIGNORE, MB_OK, MB_OKCANCEL, MB_RETRYCANCEL, MB_YESNO, MB_YESNOCANCEL); WinIcon: array[TKMsgBoxIcon] of integer = (0, MB_ICONINFORMATION, MB_ICONQUESTION, MB_ICONEXCLAMATION, MB_ICONSTOP); begin Result := MessageBox(Application.MainForm.Handle, PChar(Text), PChar(Caption), WinButtons[Buttons] or WinIcon[Icon]); end; function AppMsgBox(const Caption, Text: string; Flags: integer): integer; begin Result := Application.MessageBox(PChar(Text), PChar(Caption), Flags); end; {$IFDEF FPC} initialization {$i kmessagebox.lrs} {$ELSE} {$R kmessagebox.res} {$ENDIF} end. tomboy-ng_0.34-1/kcontrols/source/kprintpreview.lfm0000644000175000017500000021064314125207534022353 0ustar dbannondbannonobject KPrintPreviewForm: TKPrintPreviewForm Left = 491 Height = 660 Top = 190 Width = 800 Caption = 'Print Preview' ClientHeight = 660 ClientWidth = 800 Font.Height = -11 Font.Name = 'Tahoma' Icon.Data = { 7E04000000000100010010100000010020006804000016000000280000001000 0000200000000100200000000000000400006400000064000000000000000000 000000000025161310C60F0C0AB80C0C0C8F1514149815141498151414981514 1498151414981514149815141498151414980C0C0C8F00000029000000000000 000015120FC295887BFF8F8378FFB9B0A8FFF1F0EEFFF1F0EEFFF1F0EEFFF1F0 EEFFF1F0EEFFF1F0EEFFF1F0EEFFF1F0EEFFEAE8E6FF51504FEA0000000C0000 00000C0A08AE867B70FFD2CCC6FFB7ADA3FFC1BCB6FFE3E3E3FFE0E0E0FFDFDF DFFFFEFEFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFA5A3A1FF000000350000 00000000000913110FBBA59C93FFE1DDD9FFB6ACA2FFBAB4AFFFA69E97FFA297 8CFFA1968BFFA9A29BFFD1D0CEFFF1F1F1FFFEFEFEFFA8A7A5FF000000360000 000000000000000000368B8580FFBAB0A6FFD4CEC7FF9A8D7EFFAA9E89FFC8C0 B0FFCCC3B3FFBCAE95FF978B7CFFE2DEDBFFFDFDFDFFA9A8A7FF000000360000 00000000000000000036AAA9A8FFE0DCD8FFA29586FFA9986CFFC6BA91FFD0C7 A9FFD1C9AAFFC5B990FFAA986CFFA4998CFFF7F6F5FFAAA9A8FF000000360000 00000000000000000036ABAAA9FFD6D1CCFFA0906EFFAD9C60FFB9AC78FFBFB4 85FFBBB082FFBAAE79FFAB9A5EFFA99874FFD9D4D0FFABAAA9FF000000360000 00000000000000000036ACABA9FFD1CBC4FFA18D5AFFB7A45CFFB8A866FFB8A8 69FFB9A969FFBBA963FFB6A154FFA7925DFFD4CEC8FFABA9A8FF000000360000 00000000000000000036ACABAAFFDAD5D0FFAB9A6EFFC7B778FFCABB80FFCBBD 85FFC9BA7FFFC4B371FFB4A157FFA89462FFDBD5D1FFA7A5A3FF000000360000 00000000000000000036ADACABFFEBE9E6FFB4A892FFC5B990FFD7CDA8FFD9D0 AAFFD8CFAAFFD8CEA8FFC2B58CFFBAAF9AFFE4E0DCFF9C9894FF000000360000 00000000000000000036ADACABFFF1EFEDFFCFCBC8FFB9AC91FFD3C8A7FFF2EE E1FFF2EEE0FFD2C6A4FFBAAD93FFC9C4BFFFD5CEC7FF817971FF000000360000 00000000000000000036ADADACFFEDEBE9FFB9B7B5FFC3C1BEFFB8B1A8FFA59B 86FFA89D87FFCCC5BBFFDFD9D4FFE5E1DDFFE4E0DCFF514E4BEC0000001B0000 00000000000000000036AEADACFFEAE7E4FF979694FFB6B4B1FFACAAA7FFA8A6 A4FFA2A09EFFDAD5CFFFE8E5E2FFE6E3E0FF656564EC00000031000000000000 00000000000000000035ADACABFFE6E3DFFFE6E3DFFFE6E3DFFFE6E3DFFFE4E1 DDFFDED9D4FFD3CCC4FFEBE9E7FF646464EB0000002E00000000000000000000 0000000000000000000C5B5B5BEAEFEEECFFF0EEECFFF0EEEBFFEEEBE9FFE7E3 DFFFD4CDC6FFBDB3A8FF646464EB0000002F0000000000000000000000000000 00000000000000000000000000290E0E0E8F1717179817171798171717981615 1598131211980C0B0A980000002E000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000 } KeyPreview = True OnCreate = FormCreate OnKeyDown = FormKeyDown OnShow = FormShow Position = poScreenCenter LCLVersion = '1.4.4.0' object ToBMain: TToolBar Left = 0 Top = 0 Width = 800 AutoSize = True ButtonHeight = 30 ButtonWidth = 31 Caption = 'TBMain' DisabledImages = ILMainDis Images = ILMain TabOrder = 0 Wrapable = False object TBPageFirst: TToolButton Left = 1 Top = 2 Action = ACPageFirst Grouped = True ParentShowHint = False ShowHint = True end object TBPagePrevious: TToolButton Left = 32 Top = 2 Action = ACPagePrevious Grouped = True ParentShowHint = False ShowHint = True end object TBPageNext: TToolButton Left = 63 Top = 2 Action = ACPageNext Grouped = True ParentShowHint = False ShowHint = True end object TBPageLast: TToolButton Left = 94 Top = 2 Action = ACPageLast Grouped = True ParentShowHint = False ShowHint = True end object ToolButton3: TToolButton Left = 125 Height = 30 Top = 2 Width = 10 Caption = 'ToolButton3' ImageIndex = 2 Style = tbsSeparator end object ToolButton6: TToolButton Left = 200 Height = 30 Top = 2 Width = 10 Caption = 'ToolButton6' ImageIndex = 3 Style = tbsSeparator end object TBPrint: TToolButton Left = 340 Top = 2 Action = ACPrint ParentShowHint = False ShowHint = True end object ToolButton4: TToolButton Left = 371 Height = 30 Top = 2 Width = 10 Caption = 'ToolButton4' ImageIndex = 5 Style = tbsSeparator end object TBClose: TToolButton Left = 381 Top = 2 Action = ACClose ParentShowHint = False ShowHint = True end object PNPage: TPanel Left = 135 Height = 30 Top = 2 Width = 65 BevelOuter = bvNone ClientHeight = 30 ClientWidth = 65 TabOrder = 0 object EDPage: TEdit Left = 4 Height = 21 Top = 4 Width = 42 OnExit = EDPageExit TabOrder = 0 Text = '1' end object UDPage: TUpDown Left = 46 Height = 21 Top = 4 Width = 15 Associate = EDPage Min = 1 OnClick = UDPageClick Position = 1 TabOrder = 1 Wrap = False end end object PNScale: TPanel Left = 210 Height = 30 Top = 2 Width = 120 BevelOuter = bvNone ClientHeight = 30 ClientWidth = 120 TabOrder = 1 object CoBScale: TComboBox Left = 2 Height = 21 Top = 4 Width = 115 DropDownCount = 16 ItemHeight = 13 Items.Strings = ( '25 %' '50 %' '75 %' '100 %' '125 %' '150 %' '200 %' '500 %' 'Whole Page' 'Page Width' ) OnExit = CoBScaleExit OnSelect = CoBScaleExit TabOrder = 0 end end object ToolButton1: TToolButton Left = 330 Height = 30 Top = 2 Width = 10 Caption = 'ToolButton1' Style = tbsSeparator end end object ILMain: TImageList Height = 24 Width = 24 left = 16 top = 54 Bitmap = { 4C69060000001800000018000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF6BAE94FF6BAE94FF6BAE94FFADB7B800ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B8006BAE94FF6BAE94FFADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFFCFEFEFFFCFEFEFF6BAE94FFADB7B800ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B8006BAE94FF6BAE94FFA7CFC0FFA7CFC0FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFF7FCFBFFF7FCFBFF6BAE94FFADB7B800ADB7B800ADB7B800ADB7B800ADB7 B8006BAE94FF6BAE94FFA4CEBEFFF5FBFAFFF5FBFAFFF7FCFBFF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFF1F9F7FFF1F9F7FF6BAE94FFADB7B800ADB7B800ADB7B8006BAE94FF6BAE 94FFA2CDBDFFEEF8F6FFECF7F5FFEAF7F4FFECF7F5FFEFF9F7FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFEAF7F4FFEAF7F4FF6BAE94FFADB7B8006BAE94FF6BAE94FF9FCCBCFFE6F5 F2FFE3F4F0FFE1F3EFFFE0F3EEFFDFF2EDFFE1F3EFFFE7F6F2FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFE3F5F0FFE3F5F0FF6BAE94FF6BAE94FF9CCBBAFFDEF3EDFFDAF2EBFFD7F1 E9FFD5F0E8FFD4EFE7FFD3EFE7FFD3EFE7FFD7F1E9FFDFF3EEFF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFDCF2EDFFDCF2EDFF6BAE94FFD8F1EAFFD1EEE7FFCDEDE5FFCBECE3FFC9EB E2FFC8EBE2FFC8EBE2FFC8EBE2FFC8EBE2FFCDEDE5FFD7F1EAFF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFD6F1EAFFD6F1EAFF6BAE94FFC6EBE2FFC0E9DFFFBEE8DEFFBDE8DDFFBDE8 DDFFBDE8DDFFBDE8DDFFBDE8DDFFBDE8DDFFC3EAE0FFCFEEE6FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFA0ECD9FFA0ECD9FF6BAE94FF7CE5CBFF6FE3C5FF69E1C3FF68E1C2FF67E1 C2FF67E1C2FF67E1C2FF67E1C2FF67E1C2FF75E4C8FF91E9D3FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFA0ECD9FFA0ECD9FF6BAE94FF93EAD3FF80E6CCFF75E4C8FF6EE2C5FF69E1 C3FF68E1C2FF67E1C2FF67E1C2FF67E1C2FF75E4C8FF91E9D3FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFA0ECD9FFA0ECD9FF6BAE94FF6BAE94FF81C8B0FF8EE9D2FF80E6CCFF75E4 C8FF6EE2C5FF69E1C3FF68E1C2FF67E1C2FF75E4C8FF91E9D3FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFA0ECD9FFA0ECD9FF6BAE94FFADB7B8806BAE94FF6BAE94FF81C8B0FF8EE9 D2FF80E6CCFF75E4C8FF6EE2C5FF69E1C3FF76E4C8FF91E9D3FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFA0ECD9FFA0ECD9FF6BAE94FFADB7B800ADB7B880ADB7B8806BAE94FF6BAE 94FF81C8B0FF8EE9D2FF80E6CCFF76E4C8FF7EE6CBFF97EAD5FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFAAEEDDFFAAEEDDFF6BAE94FFADB7B800ADB7B800ADB7B800ADB7B880ADB7 B8806BAE94FF6BAE94FF81C8B0FF91E9D3FF93EAD4FFA8EEDCFF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFBFF2E5FFBFF2E5FF6BAE94FFADB7B800ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B880ADB7B8806BAE94FF6BAE94FF8ACAB4FF90CAB6FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF6BAE94FF6BAE94FF6BAE94FFADB7B800ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B880ADB7B8806BAE94FF6BAE94FFADB7B880FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B880ADB7B880ADB7B880ADB7B880ADB7B800ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B880ADB7B880ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B8006BAE94FF6BAE94FF6BAE94FFADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B8006BAE94FF6BAE94FFA7CFBFFFFCFEFDFFA7CFC0FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B8006BAE 94FF6BAE94FFA4CEBEFFF5FBFAFFF4FBF9FFF4FBFAFFF7FCFBFF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B8006BAE94FF6BAE94FFA2CD BDFFEEF8F6FFECF7F5FFEAF7F4FFE9F6F4FFEBF7F4FFEFF9F7FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B800ADB7B8006BAE94FF6BAE94FF9FCCBCFFE6F5F2FFE3F4 F0FFE1F3EFFFE0F3EEFFDFF2EDFFDEF2EDFFE1F3EFFFE7F6F2FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B8006BAE94FF6BAE94FF9CCBBAFFDEF3EDFFDAF2EBFFD7F1E9FFD5F0 E8FFD4EFE7FFD3EFE7FFD3EFE7FFD3EFE7FFD7F1E9FFDFF3EEFF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B8006BAE94FF9CCBBAFFD8F1EAFFD1EEE7FFCDEDE5FFCBECE3FFC9EBE2FFC8EB E2FFC8EBE2FFC8EBE2FFC8EBE2FFC8EBE2FFCDEDE5FFD7F1EAFF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF9CCBBAFFD1EFE8FFC6EBE2FFC0E9DFFFBEE8DEFFBDE8DDFFBDE8DDFFBDE8 DDFFBDE8DDFFBDE8DDFFBDE8DDFFBDE8DDFFC3EAE0FFCFEEE6FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF8CCAB5FF96EAD5FF7CE5CBFF6FE3C5FF69E1C3FF68E1C2FF67E1C2FF67E1 C2FF67E1C2FF67E1C2FF67E1C2FF67E1C2FF75E4C8FF91E9D3FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B8806BAE94FF87C9B2FF93EAD3FF80E6CCFF75E4C8FF6EE2C5FF69E1C3FF68E1 C2FF67E1C2FF67E1C2FF67E1C2FF67E1C2FF75E4C8FF91E9D3FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B8806BAE94FF6BAE94FF81C8B0FF8EE9D2FF80E6CCFF75E4C8FF6EE2 C5FF69E1C3FF68E1C2FF67E1C2FF67E1C2FF75E4C8FF91E9D3FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B880ADB7B8806BAE94FF6BAE94FF81C8B0FF8EE9D2FF80E6 CCFF75E4C8FF6EE2C5FF69E1C3FF68E1C2FF75E4C8FF91E9D3FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B880ADB7B8806BAE94FF6BAE94FF81C8 B0FF8EE9D2FF80E6CCFF75E4C8FF6FE3C5FF79E5C9FF95EAD4FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B880ADB7B8806BAE 94FF6BAE94FF81C8B0FF8FE9D2FF84E7CEFF8BE8D1FFA4EDDBFF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7 B880ADB7B8806BAE94FF6BAE94FF84C8B2FFAAEEDDFF8ECAB5FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B880ADB7B8806BAE94FF6BAE94FF6BAE94FFADB7B880FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B880ADB7B880ADB7B880ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B8006BAE94FF6BAE94FF6BAE94FFADB7B800ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFA7CFC0FFFCFEFDFFA7CFBFFF6BAE94FF6BAE94FFADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFF7FCFBFFF4FBFAFFF4FBF9FFF5FBFAFFA4CEBEFF6BAE94FF6BAE94FFADB7 B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFEFF9F7FFEBF7F4FFE9F6F4FFEAF7F4FFECF7F5FFEEF8F6FFA2CDBDFF6BAE 94FF6BAE94FFADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFE7F6F2FFE1F3EFFFDEF2EDFFDFF2EDFFE0F3EEFFE1F3EFFFE3F4F0FFE6F5 F2FF9FCCBCFF6BAE94FF6BAE94FFADB7B800ADB7B800ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFDFF3EEFFD7F1E9FFD3EFE7FFD3EFE7FFD3EFE7FFD4EFE7FFD5F0E8FFD7F1 E9FFDAF2EBFFDEF3EDFF9CCBBAFF6BAE94FF6BAE94FFADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFD7F1EAFFCDEDE5FFC8EBE2FFC8EBE2FFC8EBE2FFC8EBE2FFC8EBE2FFC9EB E2FFCBECE3FFCDEDE5FFD1EEE7FFD8F1EAFF9CCBBAFF6BAE94FFADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFCFEEE6FFC3EAE0FFBDE8DDFFBDE8DDFFBDE8DDFFBDE8DDFFBDE8DDFFBDE8 DDFFBDE8DDFFBEE8DEFFC0E9DFFFC6EBE2FFD1EFE8FF9CCBBAFF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF91E9D3FF75E4C8FF67E1C2FF67E1C2FF67E1C2FF67E1C2FF67E1C2FF67E1 C2FF68E1C2FF69E1C3FF6FE3C5FF7CE5CBFF96EAD5FF8CCAB5FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF91E9D3FF75E4C8FF67E1C2FF67E1C2FF67E1C2FF67E1C2FF68E1C2FF69E1 C3FF6EE2C5FF75E4C8FF80E6CCFF93EAD3FF87C9B2FF6BAE94FFADB7B880FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF91E9D3FF75E4C8FF67E1C2FF67E1C2FF68E1C2FF69E1C3FF6EE2C5FF75E4 C8FF80E6CCFF8EE9D2FF81C8B0FF6BAE94FF6BAE94FFADB7B880ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF91E9D3FF75E4C8FF68E1C2FF69E1C3FF6EE2C5FF75E4C8FF80E6CCFF8EE9 D2FF81C8B0FF6BAE94FF6BAE94FFADB7B880ADB7B880ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF95EAD4FF79E5C9FF6FE3C5FF75E4C8FF80E6CCFF8EE9D2FF81C8B0FF6BAE 94FF6BAE94FFADB7B880ADB7B880ADB7B800ADB7B800ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFA4EDDBFF8BE8D1FF84E7CEFF8FE9D2FF81C8B0FF6BAE94FF6BAE94FFADB7 B880ADB7B880ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF8ECAB5FFAAEEDDFF84C8B2FF6BAE94FF6BAE94FFADB7B880ADB7B880ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B8806BAE94FF6BAE94FF6BAE94FFADB7B880ADB7B880ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B880ADB7B880ADB7B880ADB7B800ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B8006BAE94FF6BAE94FFADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B8006BAE94FF6BAE94FF6BAE94FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFA7CFC0FFA7CFC0FF6BAE94FF6BAE94FFADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B8006BAE94FFFCFEFEFFFCFEFEFF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFF7FCFBFFF5FBFAFFF5FBFAFFA4CEBEFF6BAE94FF6BAE94FFADB7B800ADB7 B800ADB7B800ADB7B800ADB7B8006BAE94FFF7FCFBFFF7FCFBFF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFEFF9F7FFECF7F5FFEAF7F4FFECF7F5FFEEF8F6FFA2CDBDFF6BAE94FF6BAE 94FFADB7B800ADB7B800ADB7B8006BAE94FFF1F9F7FFF1F9F7FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFE7F6F2FFE1F3EFFFDFF2EDFFE0F3EEFFE1F3EFFFE3F4F0FFE6F5F2FF9FCC BCFF6BAE94FF6BAE94FFADB7B8006BAE94FFEAF7F4FFEAF7F4FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFDFF3EEFFD7F1E9FFD3EFE7FFD3EFE7FFD4EFE7FFD5F0E8FFD7F1E9FFDAF2 EBFFDEF3EDFF9CCBBAFF6BAE94FF6BAE94FFE3F5F0FFE3F5F0FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFD7F1EAFFCDEDE5FFC8EBE2FFC8EBE2FFC8EBE2FFC8EBE2FFC9EBE2FFCBEC E3FFCDEDE5FFD1EEE7FFD8F1EAFF6BAE94FFDCF2EDFFDCF2EDFF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFCFEEE6FFC3EAE0FFBDE8DDFFBDE8DDFFBDE8DDFFBDE8DDFFBDE8DDFFBDE8 DDFFBEE8DEFFC0E9DFFFC6EBE2FF6BAE94FFD6F1EAFFD6F1EAFF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF91E9D3FF75E4C8FF67E1C2FF67E1C2FF67E1C2FF67E1C2FF67E1C2FF68E1 C2FF69E1C3FF6FE3C5FF7CE5CBFF6BAE94FFA0ECD9FFA0ECD9FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF91E9D3FF75E4C8FF67E1C2FF67E1C2FF67E1C2FF68E1C2FF69E1C3FF6EE2 C5FF75E4C8FF80E6CCFF93EAD3FF6BAE94FFA0ECD9FFA0ECD9FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF91E9D3FF75E4C8FF67E1C2FF68E1C2FF69E1C3FF6EE2C5FF75E4C8FF80E6 CCFF8EE9D2FF81C8B0FF6BAE94FF6BAE94FFA0ECD9FFA0ECD9FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF91E9D3FF76E4C8FF69E1C3FF6EE2C5FF75E4C8FF80E6CCFF8EE9D2FF81C8 B0FF6BAE94FF6BAE94FFADB7B8806BAE94FFA0ECD9FFA0ECD9FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF97EAD5FF7EE6CBFF76E4C8FF80E6CCFF8EE9D2FF81C8B0FF6BAE94FF6BAE 94FFADB7B880ADB7B880ADB7B8006BAE94FFA0ECD9FFA0ECD9FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFA8EEDCFF93EAD4FF91E9D3FF81C8B0FF6BAE94FF6BAE94FFADB7B880ADB7 B880ADB7B800ADB7B800ADB7B8006BAE94FFAAEEDDFFAAEEDDFF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF90CAB6FF8ACAB4FF6BAE94FF6BAE94FFADB7B880ADB7B880ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B8006BAE94FFBFF2E5FFBFF2E5FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B8806BAE94FF6BAE94FFADB7B880ADB7B880ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B8006BAE94FF6BAE94FF6BAE94FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B880ADB7B880ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B880ADB7B880ADB7B880ADB7B880FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00EFC7A500EFC7A500EFC7A500EFC7A500EFC7 A500EFC7A510EFC8A6EBF1CCABFBF1CBABFBF1CBAAFBF1CCAAFBF1CBABFBF1CB ABFBF1CBABFBF1CBAAFBF1CBAAFBF1CCABFBEFC8A7EBEFC7A610EFC7A600EFC7 A600EFC7A600EFC7A600EFC7A600F4C9A400F4CAA400F0C8A500EEC7A500EEC7 A500EDC5A310F2CFAEEFFDE5C8FFFBE3C7FFFCE3C6FFFBE3C6FFFBE3C7FFFBE3 C7FFFBE3C7FFFCE3C6FFFCE3C6FFFCE4C8FFF3CFB0EFEFC7A510F0C9A800EFC9 A800F1CAA700F6CBA700F5CBA700C6B9AE00C4B8AF00E8C5A700F5CAA500F0C9 A600EFC7A410F2CEAEEFFBE1C3FFFADFC1FFFADFC1FFFBDFC1FFFBDFC1FFFADF C2FFFBDFC1FFFADFC1FFFADFC1FFFBE0C2FFF4D1B0EFF0CBA910F1CCAA00F7CE A900E9C9AC00C7BCB300C9BDB200AFB1B300AFB1B300BCBCBB00C8BBB000F3CB A600F1CAA610F3D0ADEFFADFBFFFFADEBEFFFADDBDFFFADDBDFFFADEBEFFFADE BEFFFADDBDFFFADEBDFFFADEBEFFFADEBFFFF5D2B1EFF4CEAC10F5CFAC00C8BC B200BEBDBD00B3B5B700B3B5B700B2B2B200B2B2B200BCBCBC00AFB2B500C8BB AE00F2CBA810F5D1ADEFFADDBBFFFADCBAFFFADCBAFFFADDBAFFF9DCBAFFFADD BAFFFADCBBFFF9DBBAFFFADCBAFFFADDBAFFF8D4B1EFF8D2AE10C9BCB100AFB1 B400BEBEBE00B6B6B600B6B6B600B2B2B200B2B2B200BCBCBC00B4B4B400AAAF B200EBC8AE0FFBD4AEEFF9DAB7FFFADAB6FFF9D9B6FFFADAB7FFF9DBB7FFF9DB B7FFF9DAB7FFF9DAB7FFFADAB7FFFBDAB6FFF6D5B1EFC8BDAE0DACAFB200B4B4 B400BEBEBE00B6B6B600B6B6B600B2B2B200B2B2B200BBBCBB00B4B3B41BB5B0 B3108CBAA010EAD2ABEDFCD9B4FFF8D9B4FFF9D9B4FFF8D9B3FFF9D9B4FFF9D9 B4FFF8D9B3FFF9D9B3FFF9D9B4FFFBDAB4FFF1D3B0F0ADB1AE23B4B1B310B4B3 B30DBDBEBD00B6B6B600B6B6B600B3B3B300B2B2B207CCC2C59D9CCDBDF333C0 95F155BA96EFEBC7A0FEFFCDA5FFFACCA4FFFACCA4FFFACCA4FFFACCA4FFFACC A4FFFACCA4FFFACCA4FFFACCA4FFFECDA5FFEFC9A1FE5BB996F22FBA8FF1A3CB BEEBCEC5C8A5B6B6B610B7B7B700BEBEBE00BBBBBB5AF6EDF0FEBBECDCFF31D2 A1FF47D5A6FFA9B58AFFB8B58CFFB5B68CFFB5B68CFFB5B68CFFB5B68CFFB5B6 8CFFB5B68CFFB5B68DFFB5B68CFFB8B58CFFA8B78CFF32CA99FF1AC28DFFC9EF E1FFFBF1F4FFC0C0C065C3C3C300C1C1C100BFBEBE67FBF4F6FFADE7D4FF3BCF A1FF6AEFC8FF50D7ADFF50D5ACFF50D6ACFF50D6ACFF50D5ACFF50D5ACFF50D5 ACFF50D6ACFF50D6ADFF50D6ACFF51D5ACFF4DD7ADFF61ECC3FF3CCB9CFFC4EA DCFFFFF6FAFFC5C5C571C8C8C800C1C1C100BEBEBE6DFBF4F6FFB1E6D4FF3ACB 9DFF74F4CFFF6EF1CCFF6EF2CCFF6EF1CCFF6EF1CCFF6EF2CCFF6EF2CCFF6EF2 CCFF6EF1CCFF6EF1CCFF6EF1CCFF6EF2CCFF6FF1CCFF76F4D0FF3CC899FFC5E7 DAFFFFF6FAFFC4C4C476C7C7C700BCBCBC00B9B9B970F9F2F5FFBCE7D7FF33C2 91FF38CB9CFF24C692FF26C895FF26C895FF26C895FF26C895FF26C895FF26C8 95FF26C895FF26C895FF26C895FF26C895FF23C592FF39CD9FFF38BF90FFC7E7 D9FFFCF4F7FFBDBDBD76C0C0C000B6B6B600B3B3B371EFE8EBFFC0E5D7FF2BB4 83FF2AB281FF1BAB76FF1DAD79FF1DAD79FF1DAD79FF1DAD79FF1DAD79FF1DAD 79FF1DAD79FF1DAD79FF1DAD79FF1DAD79FF1BAB76FF2AB281FF2CAF7FFFC9E6 DAFFEEE7EBFFB5B5B575B8B8B800B3B3B300B0B0B074E5DEE1FFC0E2D3FF2BB2 7FFF47C89CFF40C092FF41C092FF41C092FF41C092FF41C092FF41C093FF41C0 93FF41C093FF41C093FF41C093FF41C093FF40BF92FF47C99CFF2CAE7DFFC5E2 D4FFE2DBDEFFB0B0B076B3B3B300ADADAD00AAAAAA7FD6D2D4FFE7EEEBFF6DBF 9DFF30A475FF3AA97BFF3AA97AFF3AA87AFF3AA87AFF3AA77AFF3AA879FF3AA8 79FF3AA779FF3BA77AFF3BA77AFF3BA77AFF3BA77AFF30A272FF7DC4A6FFEDEF EEFFD1CECFFFAAAAAA7FADADAD00B7B7B700AAAAAA80CDCDCDFFE1E0E0FFEBEA EBFFE3E8E6FFEAF0EEFFE4ECEBFFE4ECEBFFE4ECEBFFE4ECEAFFE4ECEAFFE4EC EAFFE4ECEAFFE4EBEAFFE4EBEAFFE3EBE9FFE4ECEAFFEFF0EFFFCEE0D9FFC8D4 CFFFCBC9CAFFAAAAAA80B7B7B70070707000B8B8B880CBCBCBFFD8D8D8FFD6D6 D6FFCDCDCEFF969190FFB7A9A3FFB6A8A2FFB6A8A2FFB6A8A2FFB5A8A1FFB5A8 A2FFB5A8A2FFB5A7A1FFB5A7A2FFB5A8A2FFAC9F9AFF9E989AFF9CC1B1FFAEC6 BCFFCBC7C9FFB8B8B88070707000000000006E6E6E82D4D4D4FFD4D4D4FFD5D5 D5FFBEC0C2FF554B43FFBA9472FFB69373FFB69375FFB69577FFB6977BFFB698 7CFFB6987EFFB79A80FFB79A85FFBA9F89FFA38B77FF585756FFD8D4D7FFD2D0 D1FFD0D0D0FF6E6E6E8200000000000000073F3F3F46B4B4B4E0D3D3D3FFD7D7 D7FFBBBEC0FF6D6257FFEFBF91FFEABC91FFEABD94FFEABE96FFEAC19AFFEAC3 9FFFEAC5A2FFEAC6A5FFEAC8AAFFEDCEB0FFD5B99FFF6A6866FFD5D6D7FFD2D2 D2FFB8B8B8E9444444520000000500000019000000253E3E3E51777777B37575 75B684878AB99A8E82D1FFD4A4FFFFD0A3FFFFD1A4FFFFD1A7FFFFD4A9FFFFD5 AEFFFFD8B1FFFFD9B3FFFFDAB6FFFFDFBCFFF7D6B8FB787674C2747575B47979 79B4434343570000002400000019000000040000000500000000000000000000 000010121200675D5243FFF0C4FFFFE6BCFFFFE6BCFFFFE6BDFFFFE7BEFFFFE8 BFFFFFEAC3FFFFEAC3FFFFEBC5FFFFEFCAFFFFE3C1FE2725230C000000000000 0000000000000000000500000004000000000000000000000000000000000000 00000000000F0503022C2B2620542B241E5A2B241E592B241E592B241E592B25 1E592B251F592B251F592B251F592B26205A27221D4F00000022000000090000 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B8004646C1FF4646C1FFADB7B800ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B8004646C1FF4646C1FFADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B8004646C1FF9191DBFF9191DBFF4646C1FFADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B8004646C1FF9191DBFF9191DBFF4646C1FFADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004646 C1FF8F8FDBFFF3F3FFFFF2F2FFFF8E8EDBFF4646C1FFADB7B800ADB7B800ADB7 B800ADB7B8004646C1FF8E8EDBFFF2F2FFFFF3F3FFFF8F8FDBFF4646C1FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004646 C1FF8C8CDBFFE9E9FFFFE6E6FFFFE7E7FFFF8A8ADBFF4646C1FFADB7B800ADB7 B8004646C1FF8A8ADBFFE7E7FFFFE6E6FFFFE9E9FFFF8C8CDBFF4646C1FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B8804646C1FF8787DBFFDCDCFFFFD9D9FFFFDBDBFFFF8585DBFF4646C1FF4646 C1FF8585DBFFDBDBFFFFD9D9FFFFDCDCFFFF8787DBFF4646C1FFADB7B880FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B8804646C1FF8383DBFFCFCFFFFFCBCBFFFFCBCBFFFFCCCCFFFFCCCC FFFFCBCBFFFFCBCBFFFFCFCFFFFF8383DBFF4646C1FFADB7B880ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B8804646C1FF7C7CDBFFBFBFFFFFB9B9FFFFB8B8FFFFB8B8 FFFFB9B9FFFFBFBFFFFF7C7CDBFF4646C1FFADB7B880ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B800ADB7B8804646C1FFB5B5FFFFABABFFFFA8A8FFFFA8A8 FFFFABABFFFFB5B5FFFF4646C1FFADB7B880ADB7B800ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B800ADB7B8004646C1FF7272FFFF5F5FFFFF5858FFFF5858 FFFF5F5FFFFF7272FFFF4646C1FFADB7B800ADB7B800ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B8004646C1FF6161DBFF6E6EFFFF6262FFFF5F5FFFFF5F5F FFFF6262FFFF6E6EFFFF6161DBFF4646C1FFADB7B800ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B8004646C1FF6767DBFF7B7BFFFF7070FFFF6E6EFFFF7272FFFF7272 FFFF6E6EFFFF7070FFFF7B7BFFFF6767DBFF4646C1FFADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B8004646C1FF6A6ADBFF8080FFFF7575FFFF7B7BFFFF6161DBFF4646C1FF4646 C1FF6161DBFF7B7BFFFF7575FFFF8080FFFF6A6ADBFF4646C1FFADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004646 C1FF7474DBFF8E8EFFFF7A7AFFFF8080FFFF6767DBFF4646C1FFADB7B880ADB7 B8804646C1FF6767DBFF8080FFFF7A7AFFFF8E8EFFFF7474DBFF4646C1FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004646 C1FF7575DBFF9898FFFF8E8EFFFF6A6ADBFF4646C1FFADB7B880ADB7B800ADB7 B800ADB7B8804646C1FF6A6ADBFF8E8EFFFF9898FFFF7575DBFF4646C1FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B8804646C1FF7575DBFF7474DBFF4646C1FFADB7B880ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B8804646C1FF7474DBFF7575DBFF4646C1FFADB7B880FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B8804646C1FF4646C1FFADB7B880ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B8804646C1FF4646C1FFADB7B880ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B880ADB7B880ADB7B800ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B880ADB7B880ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00 } end object ALMain: TActionList Images = ILMain left = 56 top = 54 object ACPageFirst: TAction Hint = 'First page' ImageIndex = 0 OnExecute = ACPageFirstExecute OnUpdate = ACPageFirstUpdate end object ACPagePrevious: TAction Caption = 'Previous page' Hint = 'Previous page' ImageIndex = 1 OnExecute = ACPagePreviousExecute OnUpdate = ACPageFirstUpdate end object ACPageNext: TAction Caption = 'Next page' Hint = 'Next page' ImageIndex = 2 OnExecute = ACPageNextExecute OnUpdate = ACPageNextUpdate end object ACPageLast: TAction Caption = 'Last page' Hint = 'Last page' ImageIndex = 3 OnExecute = ACPageLastExecute OnUpdate = ACPageNextUpdate end object ACPrint: TAction Caption = 'Print' Hint = 'Print' ImageIndex = 4 OnExecute = ACPrintExecute OnUpdate = ACPrintUpdate end object ACClose: TAction Caption = 'Close' Hint = 'Close preview' ImageIndex = 5 OnExecute = ACCloseExecute OnUpdate = ACCloseUpdate end end object ILMainDis: TImageList Height = 24 Width = 24 left = 96 top = 54 Bitmap = { 4C69060000001800000018000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFF8C8C8CFF8C8C8CFF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B2008C8C8CFF8C8C8CFFB2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFFDFDFDFFFDFDFDFF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B2008C8C8CFF8C8C8CFFBBBBBBFFBBBBBBFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFF9F9F9FFF9F9F9FF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2B200B2B2 B2008C8C8CFF8C8C8CFFB9B9B9FFF8F8F8FFF8F8F8FFF9F9F9FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFF5F5F5FFF5F5F5FF8C8C8CFFB2B2B200B2B2B200B2B2B2008C8C8CFF8C8C 8CFFB7B7B7FFF3F3F3FFF1F1F1FFF0F0F0FFF1F1F1FFF4F4F4FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFF0F0F0FFF0F0F0FF8C8C8CFFB2B2B2008C8C8CFF8C8C8CFFB5B5B5FFEDED EDFFEBEBEBFFEAEAEAFFE9E9E9FFE8E8E8FFEAEAEAFFEEEEEEFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFECECECFFECECECFF8C8C8CFF8C8C8CFFB3B3B3FFE8E8E8FFE6E6E6FFE4E4 E4FFE2E2E2FFE1E1E1FFE1E1E1FFE1E1E1FFE4E4E4FFE9E9E9FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFE7E7E7FFE7E7E7FF8C8C8CFFE4E4E4FFDFDFDFFFDDDDDDFFDBDBDBFFDADA DAFFD9D9D9FFD9D9D9FFD9D9D9FFD9D9D9FFDDDDDDFFE4E4E4FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFE3E3E3FFE3E3E3FF8C8C8CFFD8D8D8FFD4D4D4FFD3D3D3FFD2D2D2FFD2D2 D2FFD2D2D2FFD2D2D2FFD2D2D2FFD2D2D2FFD6D6D6FFDEDEDEFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFC6C6C6FFC6C6C6FF8C8C8CFFB0B0B0FFA9A9A9FFA5A5A5FFA4A4A4FFA4A4 A4FFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFACACACFFBDBDBDFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFC6C6C6FFC6C6C6FF8C8C8CFFBEBEBEFFB3B3B3FFACACACFFA8A8A8FFA5A5 A5FFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFACACACFFBDBDBDFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFC6C6C6FFC6C6C6FF8C8C8CFF8C8C8CFFA4A4A4FFBBBBBBFFB3B3B3FFACAC ACFFA8A8A8FFA5A5A5FFA4A4A4FFA4A4A4FFACACACFFBDBDBDFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFC6C6C6FFC6C6C6FF8C8C8CFFB2B2B2808C8C8CFF8C8C8CFFA4A4A4FFBBBB BBFFB3B3B3FFACACACFFA8A8A8FFA5A5A5FFADADADFFBDBDBDFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFC6C6C6FFC6C6C6FF8C8C8CFFB2B2B200B2B2B280B2B2B2808C8C8CFF8C8C 8CFFA4A4A4FFBBBBBBFFB3B3B3FFADADADFFB2B2B2FFC0C0C0FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFCCCCCCFFCCCCCCFF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2B280B2B2 B2808C8C8CFF8C8C8CFFA4A4A4FFBDBDBDFFBEBEBEFFCBCBCBFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFD8D8D8FFD8D8D8FF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B280B2B2B2808C8C8CFF8C8C8CFFAAAAAAFFADADADFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFF8C8C8CFF8C8C8CFF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B280B2B2B2808C8C8CFF8C8C8CFFB2B2B280FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B280B2B2B280B2B2B280B2B2B280B2B2B200B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B280B2B2B280B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B2008C8C8CFF8C8C8CFF8C8C8CFFB2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B2008C8C8CFF8C8C8CFFBBBBBBFFFDFDFDFFBBBBBBFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B2008C8C 8CFF8C8C8CFFB9B9B9FFF8F8F8FFF7F7F7FFF7F7F7FFF9F9F9FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B2008C8C8CFF8C8C8CFFB7B7 B7FFF3F3F3FFF1F1F1FFF0F0F0FFEFEFEFFFF1F1F1FFF4F4F4FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B200B2B2B2008C8C8CFF8C8C8CFFB5B5B5FFEDEDEDFFEBEB EBFFEAEAEAFFE9E9E9FFE8E8E8FFE8E8E8FFEAEAEAFFEEEEEEFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B2008C8C8CFF8C8C8CFFB3B3B3FFE8E8E8FFE6E6E6FFE4E4E4FFE2E2 E2FFE1E1E1FFE1E1E1FFE1E1E1FFE1E1E1FFE4E4E4FFE9E9E9FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B2008C8C8CFFB3B3B3FFE4E4E4FFDFDFDFFFDDDDDDFFDBDBDBFFDADADAFFD9D9 D9FFD9D9D9FFD9D9D9FFD9D9D9FFD9D9D9FFDDDDDDFFE4E4E4FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFB3B3B3FFE0E0E0FFD8D8D8FFD4D4D4FFD3D3D3FFD2D2D2FFD2D2D2FFD2D2 D2FFD2D2D2FFD2D2D2FFD2D2D2FFD2D2D2FFD6D6D6FFDEDEDEFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFABABABFFC0C0C0FFB0B0B0FFA9A9A9FFA5A5A5FFA4A4A4FFA4A4A4FFA4A4 A4FFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFACACACFFBDBDBDFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B2808C8C8CFFA8A8A8FFBEBEBEFFB3B3B3FFACACACFFA8A8A8FFA5A5A5FFA4A4 A4FFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFACACACFFBDBDBDFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B2808C8C8CFF8C8C8CFFA4A4A4FFBBBBBBFFB3B3B3FFACACACFFA8A8 A8FFA5A5A5FFA4A4A4FFA4A4A4FFA4A4A4FFACACACFFBDBDBDFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B280B2B2B2808C8C8CFF8C8C8CFFA4A4A4FFBBBBBBFFB3B3 B3FFACACACFFA8A8A8FFA5A5A5FFA4A4A4FFACACACFFBDBDBDFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B280B2B2B2808C8C8CFF8C8C8CFFA4A4 A4FFBBBBBBFFB3B3B3FFACACACFFA9A9A9FFAFAFAFFFBFBFBFFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B280B2B2B2808C8C 8CFF8C8C8CFFA4A4A4FFBCBCBCFFB5B5B5FFB9B9B9FFC8C8C8FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2 B280B2B2B2808C8C8CFF8C8C8CFFA6A6A6FFCCCCCCFFACACACFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B280B2B2B2808C8C8CFF8C8C8CFF8C8C8CFFB2B2B280FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B280B2B2B280B2B2B280B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B2008C8C8CFF8C8C8CFF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFBBBBBBFFFDFDFDFFBBBBBBFF8C8C8CFF8C8C8CFFB2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFF9F9F9FFF7F7F7FFF7F7F7FFF8F8F8FFB9B9B9FF8C8C8CFF8C8C8CFFB2B2 B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFF4F4F4FFF1F1F1FFEFEFEFFFF0F0F0FFF1F1F1FFF3F3F3FFB7B7B7FF8C8C 8CFF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFEEEEEEFFEAEAEAFFE8E8E8FFE8E8E8FFE9E9E9FFEAEAEAFFEBEBEBFFEDED EDFFB5B5B5FF8C8C8CFF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFE9E9E9FFE4E4E4FFE1E1E1FFE1E1E1FFE1E1E1FFE1E1E1FFE2E2E2FFE4E4 E4FFE6E6E6FFE8E8E8FFB3B3B3FF8C8C8CFF8C8C8CFFB2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFE4E4E4FFDDDDDDFFD9D9D9FFD9D9D9FFD9D9D9FFD9D9D9FFD9D9D9FFDADA DAFFDBDBDBFFDDDDDDFFDFDFDFFFE4E4E4FFB3B3B3FF8C8C8CFFB2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFDEDEDEFFD6D6D6FFD2D2D2FFD2D2D2FFD2D2D2FFD2D2D2FFD2D2D2FFD2D2 D2FFD2D2D2FFD3D3D3FFD4D4D4FFD8D8D8FFE0E0E0FFB3B3B3FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFBDBDBDFFACACACFFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFA4A4 A4FFA4A4A4FFA5A5A5FFA9A9A9FFB0B0B0FFC0C0C0FFABABABFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFBDBDBDFFACACACFFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFA5A5 A5FFA8A8A8FFACACACFFB3B3B3FFBEBEBEFFA8A8A8FF8C8C8CFFB2B2B280FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFBDBDBDFFACACACFFA4A4A4FFA4A4A4FFA4A4A4FFA5A5A5FFA8A8A8FFACAC ACFFB3B3B3FFBBBBBBFFA4A4A4FF8C8C8CFF8C8C8CFFB2B2B280B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFBDBDBDFFACACACFFA4A4A4FFA5A5A5FFA8A8A8FFACACACFFB3B3B3FFBBBB BBFFA4A4A4FF8C8C8CFF8C8C8CFFB2B2B280B2B2B280B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFBFBFBFFFAFAFAFFFA9A9A9FFACACACFFB3B3B3FFBBBBBBFFA4A4A4FF8C8C 8CFF8C8C8CFFB2B2B280B2B2B280B2B2B200B2B2B200B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFC8C8C8FFB9B9B9FFB5B5B5FFBCBCBCFFA4A4A4FF8C8C8CFF8C8C8CFFB2B2 B280B2B2B280B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFACACACFFCCCCCCFFA6A6A6FF8C8C8CFF8C8C8CFFB2B2B280B2B2B280B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B2808C8C8CFF8C8C8CFF8C8C8CFFB2B2B280B2B2B280B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B280B2B2B280B2B2B280B2B2B200B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B2008C8C8CFF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B2008C8C8CFF8C8C8CFF8C8C8CFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFBBBBBBFFBBBBBBFF8C8C8CFF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B2008C8C8CFFFDFDFDFFFDFDFDFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFF9F9F9FFF8F8F8FFF8F8F8FFB9B9B9FF8C8C8CFF8C8C8CFFB2B2B200B2B2 B200B2B2B200B2B2B200B2B2B2008C8C8CFFF9F9F9FFF9F9F9FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFF4F4F4FFF1F1F1FFF0F0F0FFF1F1F1FFF3F3F3FFB7B7B7FF8C8C8CFF8C8C 8CFFB2B2B200B2B2B200B2B2B2008C8C8CFFF5F5F5FFF5F5F5FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFEEEEEEFFEAEAEAFFE8E8E8FFE9E9E9FFEAEAEAFFEBEBEBFFEDEDEDFFB5B5 B5FF8C8C8CFF8C8C8CFFB2B2B2008C8C8CFFF0F0F0FFF0F0F0FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFE9E9E9FFE4E4E4FFE1E1E1FFE1E1E1FFE1E1E1FFE2E2E2FFE4E4E4FFE6E6 E6FFE8E8E8FFB3B3B3FF8C8C8CFF8C8C8CFFECECECFFECECECFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFE4E4E4FFDDDDDDFFD9D9D9FFD9D9D9FFD9D9D9FFD9D9D9FFDADADAFFDBDB DBFFDDDDDDFFDFDFDFFFE4E4E4FF8C8C8CFFE7E7E7FFE7E7E7FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFDEDEDEFFD6D6D6FFD2D2D2FFD2D2D2FFD2D2D2FFD2D2D2FFD2D2D2FFD2D2 D2FFD3D3D3FFD4D4D4FFD8D8D8FF8C8C8CFFE3E3E3FFE3E3E3FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFBDBDBDFFACACACFFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFA4A4 A4FFA5A5A5FFA9A9A9FFB0B0B0FF8C8C8CFFC6C6C6FFC6C6C6FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFBDBDBDFFACACACFFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFA5A5A5FFA8A8 A8FFACACACFFB3B3B3FFBEBEBEFF8C8C8CFFC6C6C6FFC6C6C6FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFBDBDBDFFACACACFFA4A4A4FFA4A4A4FFA5A5A5FFA8A8A8FFACACACFFB3B3 B3FFBBBBBBFFA4A4A4FF8C8C8CFF8C8C8CFFC6C6C6FFC6C6C6FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFBDBDBDFFADADADFFA5A5A5FFA8A8A8FFACACACFFB3B3B3FFBBBBBBFFA4A4 A4FF8C8C8CFF8C8C8CFFB2B2B2808C8C8CFFC6C6C6FFC6C6C6FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFC0C0C0FFB2B2B2FFADADADFFB3B3B3FFBBBBBBFFA4A4A4FF8C8C8CFF8C8C 8CFFB2B2B280B2B2B280B2B2B2008C8C8CFFC6C6C6FFC6C6C6FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFCBCBCBFFBEBEBEFFBDBDBDFFA4A4A4FF8C8C8CFF8C8C8CFFB2B2B280B2B2 B280B2B2B200B2B2B200B2B2B2008C8C8CFFCCCCCCFFCCCCCCFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFADADADFFAAAAAAFF8C8C8CFF8C8C8CFFB2B2B280B2B2B280B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B2008C8C8CFFD8D8D8FFD8D8D8FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B2808C8C8CFF8C8C8CFFB2B2B280B2B2B280B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B2008C8C8CFF8C8C8CFF8C8C8CFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B280B2B2B280B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B280B2B2B280B2B2B280B2B2B280FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00CACACA00CACACA00CACACA00CACACA00CACA CA00CACACA10CACACAEBCECECEFBCECECEFBCDCDCDFBCDCDCDFBCECECEFBCECE CEFBCECECEFBCDCDCDFBCDCDCDFBCECECEFBCBCBCBEBCACACA10CACACA00CACA CA00CACACA00CACACA00CACACA00CCCCCC00CCCCCC00CACACA00C9C9C900C9C9 C900C8C8C810D0D0D0EFE2E2E2FFE1E1E1FFE1E1E1FFE0E0E0FFE1E1E1FFE1E1 E1FFE1E1E1FFE1E1E1FFE1E1E1FFE2E2E2FFD1D1D1EFCACACA10CCCCCC00CBCB CB00CCCCCC00CECECE00CECECE00BABABA00B9B9B900C7C7C700CDCDCD00CBCB CB00C9C9C910D0D0D0EFDFDFDFFFDDDDDDFFDDDDDDFFDEDEDEFFDEDEDEFFDEDE DEFFDEDEDEFFDDDDDDFFDDDDDDFFDEDEDEFFD2D2D2EFCCCCCC10CDCDCD00D0D0 D000CACACA00BDBDBD00BDBDBD00B1B1B100B1B1B100BBBBBB00BCBCBC00CCCC CC00CBCBCB10D0D0D0EFDCDCDCFFDCDCDCFFDBDBDBFFDBDBDBFFDCDCDCFFDCDC DCFFDBDBDBFFDBDBDBFFDCDCDCFFDCDCDCFFD3D3D3EFD0D0D010D0D0D000BDBD BD00BDBDBD00B5B5B500B5B5B500B2B2B200B2B2B200BCBCBC00B2B2B200BBBB BB00CDCDCD10D1D1D1EFDADADAFFDADADAFFDADADAFFDADADAFFD9D9D9FFDADA DAFFDADADAFFD9D9D9FFDADADAFFDADADAFFD4D4D4EFD3D3D310BDBDBD00B1B1 B100BEBEBE00B6B6B600B6B6B600B2B2B200B2B2B200BCBCBC00B4B4B400AEAE AE00CCCCCC0FD4D4D4EFD8D8D8FFD8D8D8FFD7D7D7FFD8D8D8FFD8D8D8FFD8D8 D8FFD8D8D8FFD8D8D8FFD8D8D8FFD8D8D8FFD3D3D3EFBBBBBB0DAFAFAF00B4B4 B400BEBEBE00B6B6B600B6B6B600B2B2B200B2B2B200BBBBBB00B3B3B31BB2B2 B210A3A3A310CACACAEDD8D8D8FFD6D6D6FFD6D6D6FFD5D5D5FFD6D6D6FFD6D6 D6FFD5D5D5FFD6D6D6FFD6D6D6FFD7D7D7FFD0D0D0F0AFAFAF23B2B2B210B3B3 B30DBDBDBD00B6B6B600B6B6B600B3B3B300B2B2B207C7C7C79DB4B4B4F37979 79F1878787EFC5C5C5FED2D2D2FFCFCFCFFFCFCFCFFFCFCFCFFFCFCFCFFFCFCF CFFFCFCFCFFFCFCFCFFFCFCFCFFFD1D1D1FFC8C8C8FE8A8A8AF2747474F1B7B7 B7EBC9C9C9A5B6B6B610B7B7B700BEBEBE00BBBBBB5AF1F1F1FED3D3D3FF8181 81FF8E8E8EFF9F9F9FFFA2A2A2FFA1A1A1FFA1A1A1FFA1A1A1FFA1A1A1FFA1A1 A1FFA1A1A1FFA1A1A1FFA1A1A1FFA2A2A2FFA1A1A1FF7E7E7EFF6E6E6EFFDCDC DCFFF6F6F6FFC0C0C065C3C3C300C1C1C100BEBEBE67F7F7F7FFCACACAFF8585 85FFACACACFF939393FF929292FF939393FF939393FF929292FF929292FF9292 92FF939393FF939393FF939393FF939393FF929292FFA6A6A6FF838383FFD7D7 D7FFFAFAFAFFC5C5C571C8C8C800C1C1C100BEBEBE6DF7F7F7FFCBCBCBFF8282 82FFB4B4B4FFAFAFAFFFB0B0B0FFAFAFAFFFAFAFAFFFB0B0B0FFB0B0B0FFB0B0 B0FFAFAFAFFFAFAFAFFFAFAFAFFFB0B0B0FFB0B0B0FFB5B5B5FF828282FFD6D6 D6FFFAFAFAFFC4C4C476C7C7C700BCBCBC00B9B9B970F5F5F5FFD1D1D1FF7A7A 7AFF818181FF757575FF777777FF777777FF777777FF777777FF777777FF7777 77FF777777FF777777FF777777FF777777FF747474FF838383FF7B7B7BFFD7D7 D7FFF8F8F8FFBDBDBD76C0C0C000B6B6B600B3B3B371EBEBEBFFD2D2D2FF6F6F 6FFF6E6E6EFF636363FF656565FF656565FF656565FF656565FF656565FF6565 65FF656565FF656565FF656565FF656565FF636363FF6E6E6EFF6D6D6DFFD7D7 D7FFEAEAEAFFB5B5B575B8B8B800B3B3B300B0B0B074E1E1E1FFD1D1D1FF6E6E 6EFF878787FF808080FF808080FF808080FF808080FF808080FF808080FF8080 80FF808080FF808080FF808080FF808080FF7F7F7FFF888888FF6D6D6DFFD3D3 D3FFDEDEDEFFB0B0B076B3B3B300ADADAD00AAAAAA7FD4D4D4FFEAEAEAFF9696 96FF6A6A6AFF717171FF717171FF717171FF717171FF707070FF717171FF7171 71FF707070FF717171FF717171FF717171FF717171FF696969FFA0A0A0FFEEEE EEFFCFCFCFFFAAAAAA7FADADAD00B7B7B700AAAAAA80CDCDCDFFE0E0E0FFEAEA EAFFE5E5E5FFEDEDEDFFE8E8E8FFE8E8E8FFE8E8E8FFE8E8E8FFE8E8E8FFE8E8 E8FFE8E8E8FFE7E7E7FFE7E7E7FFE7E7E7FFE8E8E8FFEFEFEFFFD7D7D7FFCECE CEFFCACACAFFAAAAAA80B7B7B70070707000B8B8B880CBCBCBFFD8D8D8FFD6D6 D6FFCDCDCDFF939393FFADADADFFACACACFFACACACFFACACACFFABABABFFABAB ABFFABABABFFABABABFFABABABFFABABABFFA3A3A3FF9B9B9BFFAEAEAEFFBABA BAFFC9C9C9FFB8B8B88070707000000000006E6E6E82D4D4D4FFD4D4D4FFD5D5 D5FFC0C0C0FF4C4C4CFF969696FF949494FF959595FF969696FF989898FF9999 99FF9A9A9AFF9B9B9BFF9E9E9EFFA1A1A1FF8D8D8DFF575757FFD6D6D6FFD1D1 D1FFD0D0D0FF6E6E6E8200000000000000073F3F3F46B4B4B4E0D3D3D3FFD7D7 D7FFBDBDBDFF626262FFC0C0C0FFBDBDBDFFBFBFBFFFC0C0C0FFC2C2C2FFC4C4 C4FFC6C6C6FFC7C7C7FFCACACAFFCECECEFFBABABAFF686868FFD6D6D6FFD2D2 D2FFB8B8B8E9444444520000000500000019000000253E3E3E51777777B37575 75B6878787B98E8E8ED1D1D1D1FFD1D1D1FFD1D1D1FFD3D3D3FFD4D4D4FFD6D6 D6FFD8D8D8FFD9D9D9FFDADADAFFDDDDDDFFD7D7D7FB767676C2747474B47979 79B4434343570000002400000019000000040000000500000000000000000000 0000111111005C5C5C43E1E1E1FFDDDDDDFFDDDDDDFFDEDEDEFFDEDEDEFFDFDF DFFFE1E1E1FFE1E1E1FFE2E2E2FFE4E4E4FFE0E0E0FE2525250C000000000000 0000000000000000000500000004000000000000000000000000000000000000 00000000000F0303032C252525542424245A2424245924242459242424592424 24592525255925252559252525592525255A2222224F00000022000000090000 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200838383FF838383FFB2B2B200B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B200838383FF838383FFB2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200838383FFB6B6B6FFB6B6B6FF838383FFB2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200838383FFB6B6B6FFB6B6B6FF838383FFB2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008383 83FFB5B5B5FFF9F9F9FFF8F8F8FFB4B4B4FF838383FFB2B2B200B2B2B200B2B2 B200B2B2B200838383FFB4B4B4FFF8F8F8FFF9F9F9FFB5B5B5FF838383FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008383 83FFB3B3B3FFF4F4F4FFF2F2F2FFF3F3F3FFB2B2B2FF838383FFB2B2B200B2B2 B200838383FFB2B2B2FFF3F3F3FFF2F2F2FFF4F4F4FFB3B3B3FF838383FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B280838383FFB1B1B1FFEDEDEDFFECECECFFEDEDEDFFB0B0B0FF838383FF8383 83FFB0B0B0FFEDEDEDFFECECECFFEDEDEDFFB1B1B1FF838383FFB2B2B280FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B280838383FFAFAFAFFFE7E7E7FFE5E5E5FFE5E5E5FFE5E5E5FFE5E5 E5FFE5E5E5FFE5E5E5FFE7E7E7FFAFAFAFFF838383FFB2B2B280B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B280838383FFABABABFFDFDFDFFFDCDCDCFFDBDBDBFFDBDB DBFFDCDCDCFFDFDFDFFFABABABFF838383FFB2B2B280B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B200B2B2B280838383FFDADADAFFD5D5D5FFD3D3D3FFD3D3 D3FFD5D5D5FFDADADAFF838383FFB2B2B280B2B2B200B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B200B2B2B200838383FFB8B8B8FFAFAFAFFFABABABFFABAB ABFFAFAFAFFFB8B8B8FF838383FFB2B2B200B2B2B200B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B200838383FF9E9E9EFFB6B6B6FFB0B0B0FFAFAFAFFFAFAF AFFFB0B0B0FFB6B6B6FF9E9E9EFF838383FFB2B2B200B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200838383FFA1A1A1FFBDBDBDFFB7B7B7FFB6B6B6FFB8B8B8FFB8B8 B8FFB6B6B6FFB7B7B7FFBDBDBDFFA1A1A1FF838383FFB2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200838383FFA2A2A2FFBFBFBFFFBABABAFFBDBDBDFF9E9E9EFF838383FF8383 83FF9E9E9EFFBDBDBDFFBABABAFFBFBFBFFFA2A2A2FF838383FFB2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008383 83FFA7A7A7FFC6C6C6FFBCBCBCFFBFBFBFFFA1A1A1FF838383FFB2B2B280B2B2 B280838383FFA1A1A1FFBFBFBFFFBCBCBCFFC6C6C6FFA7A7A7FF838383FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008383 83FFA8A8A8FFCBCBCBFFC6C6C6FFA2A2A2FF838383FFB2B2B280B2B2B200B2B2 B200B2B2B280838383FFA2A2A2FFC6C6C6FFCBCBCBFFA8A8A8FF838383FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B280838383FFA8A8A8FFA7A7A7FF838383FFB2B2B280B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B280838383FFA7A7A7FFA8A8A8FF838383FFB2B2B280FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B280838383FF838383FFB2B2B280B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B280838383FF838383FFB2B2B280B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B280B2B2B280B2B2B200B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B280B2B2B280B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00 } end end tomboy-ng_0.34-1/kcontrols/source/kprintpreview.pas0000644000175000017500000002436014125207534022357 0ustar dbannondbannon{ @abstract(This file is part of the KControls component suite for Delphi and Lazarus.) @author(Tomas Krysl) Copyright (c) 2020 Tomas Krysl

License:
This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } unit kprintpreview; // lowercase name because of Lazarus/Linux {$include kcontrols.inc} interface uses {$IFDEF FPC} LCLType, LCLIntf, LResources, {$ELSE} Windows, Messages, ToolWin, ImgList, {$ENDIF} SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, ActnList, Buttons, StdCtrls, ExtCtrls, KControls; type IPrintPreviewAdapter = interface function GetControl: TWinControl; function CanPrint: Boolean; procedure OnShow; procedure NextPage; procedure PreviousPage; procedure FirstPage; procedure LastPage; procedure Print; function GetFirstPageNumber: Integer; function GetLastPageNumber: Integer; function GetCurrentPageNumber: Integer; procedure SetCurrentPageNumber(Page: Integer); function GetScaleMode: TKPreviewScaleMode; procedure SetScaleMode(ScaleMode: TKPreviewScaleMode); function GetScale: Integer; procedure SetScale(Value: Integer); procedure SetPreviewChangedEvent(Event: TNotifyEvent); property FirstPageNumber: Integer read GetFirstPageNumber; property LastPageNumber: Integer read GetLastPageNumber; property CurrentPageNumber: Integer read GetCurrentPageNumber write SetCurrentPageNumber; property Scale: Integer read GetScale write SetScale; property ScaleMode: TKPreviewScaleMode read GetScaleMode write SetScaleMode; end; { TKCustomPrintPreviewForm } TKCustomPrintPreviewForm = class(TForm) ILMain: TImageList; ALMain: TActionList; ACPageFirst: TAction; ACPageLast: TAction; ACPageNext: TAction; ACPagePrevious: TAction; ACClose: TAction; ToBMain: TToolBar; TBPageFirst: TToolButton; TBPagePrevious: TToolButton; ToolButton1: TToolButton; ToolButton3: TToolButton; TBPageNext: TToolButton; TBPageLast: TToolButton; PNPage: TPanel; EDPage: TEdit; UDPage: TUpDown; ToolButton6: TToolButton; PNScale: TPanel; CoBScale: TComboBox; TBClose: TToolButton; TBPrint: TToolButton; ToolButton4: TToolButton; ACPrint: TAction; procedure CoBScaleExit(Sender: TObject); procedure FormShow(Sender: TObject); procedure ACPageFirstExecute(Sender: TObject); procedure ACPageFirstUpdate(Sender: TObject); procedure ACPagePreviousExecute(Sender: TObject); procedure ACPageNextExecute(Sender: TObject); procedure ACPageNextUpdate(Sender: TObject); procedure ACPageLastExecute(Sender: TObject); procedure ACCloseExecute(Sender: TObject); procedure ACCloseUpdate(Sender: TObject); procedure EDPageExit(Sender: TObject); procedure UDPageClick(Sender: TObject; Button: TUDBtnType); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure ACPrintExecute(Sender: TObject); procedure ACPrintUpdate(Sender: TObject); procedure FormCreate(Sender: TObject); procedure EDPageKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); private FAdapter: IPrintPreviewAdapter; procedure ScaleChanged; procedure CurrentPageChanged(Sender: TObject = nil); public constructor Create(AOwner: TComponent; AAdapter: IPrintPreviewAdapter); reintroduce; property Adapter: IPrintPreviewAdapter read FAdapter; end; { TKPrintPreviewForm } TKPrintPreviewForm = class(TKCustomPrintPreviewForm, IPrintPreviewAdapter) private FPreview: TKPrintPreview; // IPrintPreviewAdapter function GetControl: TWinControl; function CanPrint: Boolean; procedure OnShow; procedure NextPage; procedure PreviousPage; procedure FirstPage; procedure LastPage; procedure Print; function GetFirstPageNumber: Integer; function GetLastPageNumber: Integer; function GetCurrentPageNumber: Integer; procedure SetCurrentPageNumber(Page: Integer); function GetScaleMode: TKPreviewScaleMode; procedure SetScaleMode(ScaleMode: TKPreviewScaleMode); function GetScale: Integer; procedure SetScale(Value: Integer); procedure SetPreviewChangedEvent(Event: TNotifyEvent); public constructor Create(AOwner: TComponent); reintroduce; property Preview: TKPrintPreview read FPreview; end; implementation {$IFDEF FPC} {$R *.lfm} {$ELSE} {$R *.dfm} {$ENDIF} uses KFunctions; { TKCustomPrintPreviewForm } constructor TKCustomPrintPreviewForm.Create(AOwner: TComponent; AAdapter: IPrintPreviewAdapter); begin inherited CReate(AOwner); FAdapter := AAdapter; end; procedure TKCustomPrintPreviewForm.FormCreate(Sender: TObject); var PreviewControl: TWinControl; begin CoBScale.ItemIndex := 9; // page width PreviewControl := Adapter.GetControl; PreviewControl.Parent := Self; PreviewControl.Align := alClient; PreviewControl.TabStop := True; PreviewControl.TabOrder := 0; end; procedure TKCustomPrintPreviewForm.FormShow(Sender: TObject); begin FAdapter.SetPreviewChangedEvent(CurrentPageChanged); Adapter.OnShow; UDPage.Min := Adapter.FirstPageNumber; UDPage.Max := Adapter.LastPageNumber; end; procedure TKCustomPrintPreviewForm.CoBScaleExit(Sender: TObject); begin ScaleChanged; end; procedure TKCustomPrintPreviewForm.ACPageFirstExecute(Sender: TObject); begin Adapter.FirstPage; end; procedure TKCustomPrintPreviewForm.ACPageFirstUpdate(Sender: TObject); begin TAction(Sender).Enabled := Adapter.CurrentPageNumber > Adapter.FirstPageNumber; end; procedure TKCustomPrintPreviewForm.ACPagePreviousExecute(Sender: TObject); begin Adapter.PreviousPage; end; procedure TKCustomPrintPreviewForm.ACPageNextExecute(Sender: TObject); begin Adapter.NextPage; end; procedure TKCustomPrintPreviewForm.ACPageNextUpdate(Sender: TObject); begin TAction(Sender).Enabled := Adapter.CurrentPageNumber < Adapter.LastPageNumber; end; procedure TKCustomPrintPreviewForm.ACPageLastExecute(Sender: TObject); begin Adapter.LastPage; end; procedure TKCustomPrintPreviewForm.ACPrintExecute(Sender: TObject); begin Adapter.Print; end; procedure TKCustomPrintPreviewForm.ACPrintUpdate(Sender: TObject); begin TAction(Sender).Enabled := Adapter.CanPrint; end; procedure TKCustomPrintPreviewForm.ACCloseExecute(Sender: TObject); begin Close; end; procedure TKCustomPrintPreviewForm.ACCloseUpdate(Sender: TObject); begin TAction(Sender).Enabled := True; end; procedure TKCustomPrintPreviewForm.EDPageExit(Sender: TObject); begin Adapter.CurrentPageNumber := MinMax(StrToIntDef(EDPage.Text, Adapter.CurrentPageNumber), Adapter.FirstPageNumber, Adapter.LastPageNumber); CurrentPageChanged; end; procedure TKCustomPrintPreviewForm.EDPageKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key = VK_RETURN then EDPageExit(nil); end; procedure TKCustomPrintPreviewForm.UDPageClick(Sender: TObject; Button: TUDBtnType); begin EDPageExit(nil); end; procedure TKCustomPrintPreviewForm.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key = VK_ESCAPE then begin Close; Key := 0; end; end; procedure TKCustomPrintPreviewForm.ScaleChanged; var S: string; begin S := CoBScale.Text; if CoBScale.Items.IndexOf(S) < 0 then CoBScale.ItemIndex := -1; case CoBScale.ItemIndex of -1: begin while (S <> '') and not CharInSetEx(S[Length(S)], ['0'..'9']) do Delete(S, Length(S), 1); Adapter.Scale := StrToIntDef(S, 100); end; 0: Adapter.Scale := 25; 1: Adapter.Scale := 50; 2: Adapter.Scale := 75; 3: Adapter.Scale := 100; 4: Adapter.Scale := 125; 5: Adapter.Scale := 150; 6: Adapter.Scale := 200; 7: Adapter.Scale := 500; end; case CoBScale.ItemIndex of -1: begin Adapter.ScaleMode := smScale; CobScale.Text := Format('%d %%', [Adapter.Scale]); end; 0..7: Adapter.ScaleMode := smScale; 8: Adapter.ScaleMode := smWholePage; 9: Adapter.ScaleMode := smPageWidth; end; end; procedure TKCustomPrintPreviewForm.CurrentPageChanged(Sender: TObject); begin EDPage.Text := IntToStr(Adapter.CurrentPageNumber); end; { TKPrintPreviewForm } constructor TKPrintPreviewForm.Create(AOwner: TComponent); begin inherited Create(AOwner, Self); FPreview := TKPrintPreview.Create(Self); FPreview.DoubleBuffered := True; end; procedure TKPrintPreviewForm.FirstPage; begin Preview.FirstPage; end; function TKPrintPreviewForm.GetControl: TWinControl; begin Result := Preview; end; function TKPrintPreviewForm.CanPrint: Boolean; begin Result := Assigned(Preview.Control) and Preview.Control.CanPrint; end; procedure TKPrintPreviewForm.OnShow; begin end; function TKPrintPreviewForm.GetCurrentPageNumber: Integer; begin Result := Preview.Page; end; function TKPrintPreviewForm.GetFirstPageNumber: Integer; begin Result := Preview.StartPage; end; function TKPrintPreviewForm.GetLastPageNumber: Integer; begin Result := Preview.EndPage; end; function TKPrintPreviewForm.GetScale: Integer; begin REsult := Preview.Scale; end; function TKPrintPreviewForm.GetScaleMode: TKPreviewScaleMode; begin Result := Preview.ScaleMode; end; procedure TKPrintPreviewForm.LastPage; begin Preview.LastPage; end; procedure TKPrintPreviewForm.NextPage; begin Preview.NextPage; end; procedure TKPrintPreviewForm.PreviousPage; begin Preview.PreviousPage; end; procedure TKPrintPreviewForm.Print; begin Preview.Control.PrintOut end; procedure TKPrintPreviewForm.SetCurrentPageNumber(Page: Integer); begin Preview.Page := Page; end; procedure TKPrintPreviewForm.SetPreviewChangedEvent(Event: TNotifyEvent); begin FPreview.OnChanged := Event; end; procedure TKPrintPreviewForm.SetScale(Value: Integer); begin Preview.Scale := Value; end; procedure TKPrintPreviewForm.SetScaleMode(ScaleMode: TKPreviewScaleMode); begin Preview.ScaleMode := ScaleMode; end; end. tomboy-ng_0.34-1/kcontrols/source/khexeditor.pas0000644000175000017500000051752114125207534021622 0ustar dbannondbannon{ @abstract(This file is part of the KControls component suite for Delphi and Lazarus.) @author(Tomas Krysl) Copyright (c) 2020 Tomas Krysl

License:
This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } unit khexeditor; // lowercase name because of Lazarus/Linux {$include kcontrols.inc} {$WEAKPACKAGEUNIT ON} interface uses {$IFDEF FPC} LCLType, LCLIntf, LMessages, LCLProc, LResources, {$ELSE} Windows, Messages, {$ENDIF} SysUtils, Classes, Graphics, Controls, ExtCtrls, StdCtrls, Forms, KFunctions, KGraphics, KControls, KEditCommon; type { Declares possible values for the @link(TKCustomHexEditor.AddressMode) property } TKHexEditorAddressMode = ( { Address will be shown in decimal format } eamDec, { Address will be shown in hexadecimal format } eamHex ); { Declares possible values e.g. for the @link(TKCustomHexEditor.EditArea) property } TKHexEditorArea = ( { No area is selected, e.g. when clicked outside of visible text } eaNone, { Address area selected/used } eaAddress, { Digits area selected/used } eaDigits, { Text area selected/used } eaText ); { @abstract(Contains dimensions of all areas in characters)
    Members:
  • Address - address area width
  • AddressOut - address area leadout
  • Digits - digits area width
  • DigitsIn - digits area leadin
  • DigitsOut - digits area leadout
  • Text - text area width
  • TextIn - text area leadin
  • TotalHorz - total width of all defined areas
  • TotalVert - total number of lines
} TKHexEditorAreaDimensions = record Address, AddressOut, Digits, DigitsIn, DigitsOut, Text, TextIn, TotalHorz: Integer; TotalVert: Int64; end; { Declared for backward compatibility only. } TKHexEditorColorIndex = TKColorIndex; { Declared for backward compatibility only. } TKHexEditorColorSpec = TKColorSpec; { Declared for backward compatibility only. } TKHexEditorDisabledDrawStyle = TKEditDisabledDrawStyle; { Declares drawing styles - possible values for the @link(TKCustomHexEditor.DrawStyles) property } TKHexEditorDrawStyle = ( { Show adress area } edAddress, { Show digits area } edDigits, { Show text area } edText, { Show horizontal leading lines } edHorzLines, { Show caret position when editor is inactive (has no input focus) } edInactiveCaret, { Show vertical area separating lines } edSeparators, { Show vertical leading lines (digits area only) } edVertLines, { @link(TKHexEditorColors.BkGnd) is used for all areas if included } edSingleBkGnd ); { Drawing styles can be arbitrary combined } TKHexEditorDrawStyles = set of TKHexEditorDrawStyle; { @abstract(Declares the paint data structure for the @link(TKCustomHexEditor.PaintLines) method)
    Members:
  • Canvas - destination canvas
  • PainRect - bounding rectangle for painted lines (no clipping necessary, this is performed by window/page client area)
  • TopLine - first line painted (vertical scroll offset)
  • BottomLine - last line painted
  • LeftChar - first character painted (horizontal scroll offset)
  • CharWidth - character width in pixels for supplied canvas
  • CharHeight - character height in pixels for supplied canvas
  • CharSpacing - inter-character spacing in pixels for supplied canvas
  • Printing - determines whether normal painting or page printing should be performed
  • PaintAll - when Printing is True, specifies whether all data or selection only should be painted, this applies only to the first and/or last painted line
  • PaintColors - when Printing is True, specifies whether to paint with colors or grayscale
  • PaintSelection - when Printing is True, specifies whether to indicate the selection
} TKHexEditorPaintData = record Canvas: TCanvas; PaintRect: TRect; TopLine, BottomLine: Int64; LeftChar, CharWidth, CharHeight, CharSpacing: Integer; Printing, PaintAll, PaintColors, PaintSelection, CaretShown: Boolean; end; TKHexEditorSelection = TKHexDigitPosition; { @abstract(Declares the structure for the @link(TKCustomHexEditor.SelText) property)
    Members:
  • AsBinaryRaw - selected data as binary characters not mapped
  • AsBinaryMapped - selected data as binary characters mapped
  • AsDigits - selected data as hexadecimal digits
  • AsDigitsByteAligned - selected data as hexadecimal digits without regarding cross-byte selections
} TKHexEditorSelText = record AsBinaryRaw, AsBinaryMapped, AsDigits, AsDigitsByteAligned: AnsiString; end; { Declares hex editor states - possible values for the @link(TKCustomHexEditor.States) property (protected) } TKHexEditorState = ( { Caret is visible } elCaretVisible, { Caret is being updated } elCaretUpdate, { Ignore following WM_CHAR message } elIgnoreNextChar, { Buffer modified } elModified, { Mouse captured } elMouseCapture, { Overwrite mode active } elOverwrite, { Read only editor } elReadOnly ); { Hex editor states can be arbitrary combined } TKHexEditorStates = set of TKHexEditorState; { Declared for backward compatibility only. } TKHexEditorColorData = TKColorData; { Declared for backward compatibility only. } TKHexEditorColorScheme = TKColorScheme; const { Minimum for the @link(TKCustomHexEditor.AddressSize) property } cAddressSizeMin = 2; { Maximum for the @link(TKCustomHexEditor.AddressSize) property } cAddressSizeMax = 10; { Default value for the @link(TKCustomHexEditor.AddressSize) property } cAddressSizeDef = 8; { Minimum for the @link(TKCustomHexEditor.AreaSpacing) property } cAreaSpacingMin = 1; { Maximum for the @link(TKCustomHexEditor.AreaSpacing) property } cAreaSpacingMax = 20; { Default value for the @link(TKCustomHexEditor.AreaSpacing) property } cAreaSpacingDef = 1; { Minimum for the @link(TKCustomHexEditor.CharSpacing) property } cCharSpacingMin = 0; { Maximum for the @link(TKCustomHexEditor.CharSpacing) property } cCharSpacingMax = 100; { Default value for the @link(TKCustomHexEditor.CharSpacing) property } cCharSpacingDef = 0; { Minimum for the @link(TKCustomHexEditor.DigitGrouping) property } cDigitGroupingMin = 1; { Maximum for the @link(TKCustomHexEditor.DigitGrouping) property } cDigitGroupingMax = 8; { Default value for the @link(TKCustomHexEditor.DigitGrouping) property } cDigitGroupingDef = 2; { Minimum for the @link(TKCustomHexEditor.LineHeightPercent) property } cLineHeightPercentMin = 10; { Maximum for the @link(TKCustomHexEditor.LineHeightPercent) property } cLineHeightPercentMax = 1000; { Default value for the @link(TKCustomHexEditor.LineHeightPercent) property } cLineHeightPercentDef = 130; { Minimum for the @link(TKCustomHexEditor.UndoLimit) property } cUndoLimitMin = 100; { Maximum for the @link(TKCustomHexEditor.UndoLimit) property } cUndoLimitMax = 10000; { Default value for the @link(TKCustomHexEditor.UndoLimit) property } cUndoLimitDef = 1000; { Minimum for the @link(TKCustomHexEditor.LineSize) property } cLineSizeMin = 1; { Maximum for the @link(TKCustomHexEditor.LineSize) property } cLineSizeMax = 128; { Default value for the @link(TKCustomHexEditor.LineSize) property } cLineSizeDef = 16; { Minimum for the @link(TKCustomHexEditor.ScrollSpeed) property } cScrollSpeedMin = 50; { Maximum for the @link(TKCustomHexEditor.ScrollSpeed) property } cScrollSpeedMax = 1000; { Default value for the @link(TKCustomHexEditor.ScrollSpeed) property } cScrollSpeedDef = 100; { Minimum for the @link(TKHexEditor.Font).Size property } cFontSizeMin = 8; { Maximum for the @link(TKHexEditor.Font).Size property } cFontSizeMax = 100; { Default value for the @link(TKHexEditor.Font).Size property } cFontSizeDef = 11; { Default value for the @link(TKHexEditorColors.AddressText) color property } cAddressTextDef = clWindowText; { Default value for the @link(TKHexEditorColors.AddressBkGnd) color property } cAddressBkgndDef = clWindow; { Default value for the @link(TKHexEditorColors.BkGnd) color property } cBkGndDef = clWindow; { Default value for the @link(TKHexEditorColors.DigitTextEven) color property } cDigitTextEvenDef = clMaroon; { Default value for the @link(TKHexEditorColors.DigitTextOdd) color property } cDigitTextOddDef = clRed; { Default value for the @link(TKHexEditorColors.DigitBkGnd) color property } cDigitBkGndDef = clWindow; { Default value for the @link(TKHexEditorColors.HorzLines) color property } cHorzLinesDef = clWindowText; { Default value for the @link(TKHexEditorColors.InactiveCaretBkGnd) color property } cInactiveCaretBkGndDef = clBlack; { Default value for the @link(TKHexEditorColors.InactiveCaretSelBkGnd) color property } cInactiveCaretSelBkGndDef = clBlack; { Default value for the @link(TKHexEditorColors.InactiveCaretSelText) color property } cInactiveCaretSelTextDef = clYellow; { Default value for the @link(TKHexEditorColors.InactiveCaretText) color property } cInactiveCaretTextDef = clYellow; { Default value for the @link(TKHexEditorColors.LinesHighLight) color property } cLinesHighLightDef = clHighLightText; { Default value for the @link(TKHexEditorColors.SelBkGnd) color property } cSelBkGndDef = clGrayText; { Default value for the @link(TKHexEditorColors.SelBkGndFocused) color property } cSelBkGndFocusedDef = clHighlight; { Default value for the @link(TKHexEditorColors.SelText) color property } cSelTextDef = clHighlightText; { Default value for the @link(TKHexEditorColors.SelTextFocused) color property } cSelTextFocusedDef = clHighlightText; { Default value for the @link(TKHexEditorColors.Separators) color property } cSeparatorsDef = clWindowText; { Default value for the @link(TKHexEditorColors.TextText) color property } cTextTextDef = clWindowText; { Default value for the @link(TKHexEditorColors.TextBkgnd) color property } cTextBkgndDef = clWindow; { Default value for the @link(TKHexEditorColors.VertLines) color property } cVertLinesDef = clWindowText; { Index for the @link(TKHexEditorColors.AddressText) color property } ciAddressText = TKColorIndex(0); { Index for the @link(TKHexEditorColors.AddressBkGnd) color property } ciAddressBkGnd = TKColorIndex(1); { Index for the @link(TKHexEditorColors.BkGnd) color property } ciBkGnd = TKColorIndex(2); { Index for the @link(TKHexEditorColors.DigitTextEven) color property } ciDigitTextEven = TKColorIndex(3); { Index for the @link(TKHexEditorColors.DigitTextOdd) color property } ciDigitTextOdd = TKColorIndex(4); { Index for the @link(TKHexEditorColors.DigitBkGnd) color property } ciDigitBkGnd = TKColorIndex(5); { Index for the @link(TKHexEditorColors.HorzLines) color property } ciHorzLines = TKColorIndex(6); { Index for the @link(TKHexEditorColors.InactiveCaretBkGnd) color property } ciInactiveCaretBkGnd = TKColorIndex(7); { Index for the @link(TKHexEditorColors.InactiveCaretSelBkGnd) color property } ciInactiveCaretSelBkGnd = TKColorIndex(8); { Index for the @link(TKHexEditorColors.InactiveCaretSelText) color property } ciInactiveCaretSelText = TKColorIndex(9); { Index for the @link(TKHexEditorColors.InactiveCaretText) color property } ciInactiveCaretText = TKColorIndex(10); { Index for the @link(TKHexEditorColors.LinesHighLight) color property } ciLinesHighLight = TKColorIndex(11); { Index for the @link(TKHexEditorColors.SelBkGnd) color property } ciSelBkGnd = TKColorIndex(12); { Index for the @link(TKHexEditorColors.SelBkGndFocused) color property } ciSelBkGndFocused = TKColorIndex(13); { Index for the @link(TKHexEditorColors.SelText) color property } ciSelText = TKColorIndex(14); { Index for the @link(TKHexEditorColors.SelTextFocused) color property } ciSelTextFocused = TKColorIndex(15); { Index for the @link(TKHexEditorColors.Separators) color property } ciSeparators = TKColorIndex(16); { Index for the @link(TKHexEditorColors.TextText) color property } ciTextText = TKColorIndex(17); { Index for the @link(TKHexEditorColors.TextBkgnd) color property } ciTextBkGnd = TKColorIndex(18); { Index for the @link(TKHexEditorColors.VertLines) color property } ciVertLines = TKColorIndex(19); { Maximum color array index } ciHexEditorColorsMax = ciVertLines; { Default value for the @link(TKCustomHexEditor.AddressMode) property } cAddressModeDef = eamHex; { Default value for the @link(TKCustomHexEditor.Addressoffset) property } cAddressOffsetDef = 0; { Default value for the @link(TKCustomHexEditor.DrawStyles) property } cDrawStylesDef = [edAddress, edDigits, edText, edInactiveCaret, edSeparators]; { Default value for the @link(TKCustomHexEditor.AddressPrefix) property } cAddressPrefixDef = '0x'; { Default value for the @link(TKHexEditor.Font).Name property } cFontNameDef = {$IFDEF MSWINDOWS}'Courier New'{$ELSE}'Courier'{$ENDIF}; { Default value for the @link(TKHexEditor.Font).Style property } cFontStyleDef = [fsBold]; { Declares the Index member of the @link(TKHexEditorSelection) record invalid} cInvalidIndex = -1; { Default value for the @link(TKCustomHexEditor.AddressCursor) property } cAddressCursorDef = crHandPoint; { Default value for the @link(TKHexEditor.Height) property } cHeight = 300; { Default value for the @link(TKHexEditor.Width) property } cWidth = 400; { Default max. chunk size for file IO operations } cIOChunkSize = $2000000; type TKCustomHexEditor = class; { @abstract(Container for all colors used by @link(TKCustomHexEditor) class) This container allows to group many colors into one item in object inspector. Colors are accessible via published properties or several public Color* properties. } TKHexEditorColors = class(TKCustomColors) private FSingleBkGnd: Boolean; protected { Returns the specific color according to ColorScheme. } function InternalGetColor(Index: TKColorIndex): TColor; override; { Returns color specification structure for given index. } function GetColorSpec(Index: TKColorIndex): TKColorSpec; override; { Returns maximum color index. } function GetMaxIndex: Integer; override; public { @link(TKHexEditorColors.BkGnd) is used for all areas if True - @link(edSingleBkGnd) forward } property SingleBkGnd: Boolean read FSingleBkGnd write FSingleBkGnd; published { Address area text color } property AddressText: TColor index ciAddressText read GetColor write SetColor default cAddressTextDef; { Address area background color } property AddressBkGnd: TColor index ciAddressBkgnd read GetColor write SetColor default cAddressBkGndDef; { Hex editor client area background } property BkGnd: TColor index ciBkGnd read GetColor write SetColor default cBkGndDef; { Digits area text color - even digit group } property DigitTextEven: TColor index ciDigitTextEven read GetColor write SetColor default cDigitTextEvenDef; { Digits area text color - odd digit group } property DigitTextOdd: TColor index ciDigitTextOdd read GetColor write SetColor default cDigitTextOddDef; { Digits area background color } property DigitBkGnd: TColor index ciDigitBkGnd read GetColor write SetColor default cDigitBkGndDef; { Color of the horizontal leading lines } property HorzLines: TColor index ciHorzLines read GetColor write SetColor default cHorzLinesDef; { Inactive (hex editor without focus) caret background color - caret mark is not part of a selection } property InactiveCaretBkGnd: TColor index ciInactiveCaretBkGnd read GetColor write SetColor default cInactiveCaretBkGndDef; { Inactive (hex editor without focus) caret background color - caret mark is part of a selection } property InactiveCaretSelBkGnd: TColor index ciInactiveCaretSelBkGnd read GetColor write SetColor default cInactiveCaretSelBkGndDef; { Inactive (hex editor without focus) caret text color - caret mark is part of a selection } property InactiveCaretSelText: TColor index ciInactiveCaretSelText read GetColor write SetColor default cInactiveCaretSelTextDef; { Inactive (hex editor without focus) caret text color - caret mark is not part of a selection } property InactiveCaretText: TColor index ciInactiveCaretText read GetColor write SetColor default cInactiveCaretTextDef; { Color of horizontal leading lines involved into a selection } property LinesHighLight: TColor index ciLinesHighLight read GetColor write SetColor default cLinesHighLightDef; { Selection background - inactive edit area } property SelBkGnd: TColor index ciSelBkGnd read GetColor write SetColor default cSelBkGndDef; { Selection background - active edit area } property SelBkGndFocused: TColor index ciSelBkGndFocused read GetColor write SetColor default cSelBkGndFocusedDef; { Selection text - inactive edit area } property SelText: TColor index ciSelText read GetColor write SetColor default cSelTextDef; { Selection text - active edit area } property SelTextFocused: TColor index ciSelTextFocused read GetColor write SetColor default cSelTextFocusedDef; { Color of the vertical area separating lines } property Separators: TColor index ciSeparators read GetColor write SetColor default cSeparatorsDef; { Text area text color } property TextText: TColor index ciTextText read GetColor write SetColor default cTextTextDef; { Text area background color } property TextBkgnd: TColor index ciTextBkgnd read GetColor write SetColor default cTextBkGndDef; { Color of the vertical leading lines } property VertLines: TColor index ciVertLines read GetColor write SetColor default cVertLinesDef; end; { Declares possible values for the ItemReason member of the @link(TKHexEditorChangeItem) structure } TKHexEditorChangeReason = ( { Save caret position only } crCaretPos, { Save inserted character to be able to delete it } crDeleteChar, { Save inserted hexadecimal digits to be able to delete them } crDeleteDigits, { Save inserted binary string to be able to delete it } crDeleteString, { Save deleted character to be able to insert it } crInsertChar, { Save deleted hexadecimal digits to be able to insert them } crInsertDigits, { Save deleted binary string to be able to insert it } crInsertString ); { @abstract(Declares @link(TKHexEditorChangeList.OnChange) event handler)
    Parameters:
  • Sender - identifies the event caller
  • ItemReason - specifies the undo/redo reason
} TKHexEditorUndoChangeEvent = procedure(Sender: TObject; ItemReason: TKHexEditorChangeReason) of object; { @abstract(Declares the undo/redo item description structure used by the @link(TKHexEditorChangeList) class)
    Members:
  • Data - characters (binary or digit string) needed to execute this item
  • EditArea - active edit area at the time this item was recorded
  • Group - identifies the undo/redo group. Some editor modifications produce a sequence of 2 or more undo items. This sequence is called undo/redo group and is always interpreted as a single undo/redo item. Moreover, if there is eoGroupUndo in @link(TKCustomHexEditor.Options), a single ecUndo or ecRedo command manipulates all following undo groups of the same kind (reason) as if they were a single undo/redo item.
  • GroupReason - reason (kind) of this undo group
  • ItemReason - reason (kind) of this item
  • SelEnd - end of the selection at the time this item was recorded
  • SelStart - start of the selection at the time this item was recorded
} TKHexEditorChangeItem = record Data: AnsiString; EditArea: TKHexEditorArea; Group: Cardinal; GroupReason: TKHexEditorChangeReason; Inserted: Boolean; ItemReason: TKHexEditorChangeReason; SelEnd: TKHexEditorSelection; SelStart: TKHexEditorSelection; end; { Pointer to @link(TKHexEditorChangeItem) } PKHexEditorChangeItem = ^TKHexEditorChangeItem; { @abstract(Change (undo/redo item) list manager) } TKHexEditorChangeList = class(TList) private FEditor: TKCustomHexEditor; FGroup: Cardinal; FGroupUseLock: Integer; FGroupReason: TKHexEditorChangeReason; FIndex: Integer; FModifiedIndex: Integer; FLimit: Integer; FRedoList: TKHexEditorChangeList; FOnChange: TKHexEditorUndoChangeEvent; function GetModified: Boolean; procedure SetLimit(Value: Integer); procedure SetModified(Value: Boolean); protected { Redefined to properly destroy the items } procedure Notify(Ptr: Pointer; Action: TListNotification); override; public { Performs necessary initializations
    Parameters:
  • AEditor - identifies the undo/redo list owner
  • RedoList - when this instance is used as undo list, specify a redo list to allow clear it at each valid AddChange call
} constructor Create(AEditor: TKCustomHexEditor; RedoList: TKHexEditorChangeList); { Inserts a undo/redo item
    Parameters:
  • ItemReason - specifies the undo/redo item reason. The change list doesn't allow to insert succesive crCaretPos items unless Inserted is True
  • Data - specifies the item data. Some items (crCaretPos) don't need to supply any data
  • Inserted - for the urInsert* items, specifies whether the item was recorded with @link(TKCustomHexEditor.InsertMode) on (True) or off (False). See ItemReason for crCaretPos behavior.
} procedure AddChange(ItemReason: TKHexEditorChangeReason; const Data: AnsiString = ''; Inserted: Boolean = True); virtual; { Tells the undo list a new undo/redo group is about to be created. Each BeginGroup call must have a corresponding EndGroup call (use try-finally). BeginGroup calls may be nested, however, only the first call will create an undo/redo group. Use the GroupReason parameter to specify the reason of this group. } procedure BeginGroup(GroupReason: TKHexEditorChangeReason); virtual; { Informs whether there are any undo/redo items available - i.e. CanUndo/CanRedo} function CanPeek: Boolean; { Clears the entire list - overriden to execute some adjustments } procedure Clear; override; { Completes the undo/redo group. See @link(TKHexEditorChangeList.BeginGroup) for details } procedure EndGroup; virtual; { Returns the topmost item to handle or inspect it} function PeekItem: PKHexEditorChangeItem; { If there is no reason to handle an item returned by PeekItem, it has to be poked back with this function to become active for next undo/redo command } procedure PokeItem; { For redo list only - each undo command creates a redo command with the same group information - see source } procedure SetGroupData(Group: Integer; GroupReason: TKHexEditorChangeReason); { Specifies maximum number of items - not groups } property Limit: Integer read FLimit write SetLimit; { For undo list only - returns True if undo list contains some items with regard to the eoUndoAfterSave option } property Modified: Boolean read GetModified write SetModified; { Allows to call TKCustomHexEditor.@link(TKCustomHexEditor.OnChange) event} property OnChange: TKHexEditorUndoChangeEvent read FOnChange write FOnChange; end; { @abstract(Hexadecimal editor base component) } TKCustomHexEditor = class(TKCustomControl) private FAddressCursor: TCursor; FAddressMode: TKHexEditorAddressMode; FAddressOffset: Integer; FAddressPrefix: string; FAddressSize: Integer; FAreaSpacing: Integer; FBuffer: PBytes; FCharHeight: Integer; FCharMapping: TKEditCharMapping; FCharSpacing: Integer; FCharWidth: Integer; FClipboardFormat: Word; FColors: TKHexEditorColors; FDigitGrouping: Integer; FDisabledDrawStyle: TKEditDisabledDrawStyle; FDrawStyles: TKHexEditorDrawStyles; FEditArea: TKHexEditorArea; FKeyMapping: TKEditKeyMapping; FLeftChar: Integer; FLineHeightPercent: Integer; FLineSize: Integer; FMouseWheelAccumulator: Integer; FOptions: TKEditOptions; FRedoList: TKHexEditorChangeList; FScrollBars: TScrollStyle; FScrollDeltaX: Integer; FScrollDeltaY: Integer; FScrollSpeed: Cardinal; FScrollTimer: TTimer; FSelEnd: TKHexEditorSelection; FSelStart: TKHexEditorSelection; FSize: Int64; FStates: TKHexEditorStates; FTopLine: Int64; FTotalCharSpacing: Integer; FUndoList: TKHexEditorChangeList; FOnChange: TNotifyEvent; FOnDropFiles: TKEditDropFilesEvent; FOnReplaceText: TKEditReplaceTextEvent; function GetCommandKey(Index: TKEditCommand): TKEditKey; function GetCaretVisible: Boolean; function GetData: TDataSize; function GetEmpty: Boolean; function GetFirstVisibleIndex: Integer; function GetInsertMode: Boolean; function GetLastVisibleIndex: Integer; function GetLineCount: Int64; function GetLines(Index: Int64): TDataSize; function GetModified: Boolean; function GetReadOnly: Boolean; function GetSelLength: TKHexEditorSelection; function GetSelText: TKHexEditorSelText; function GetUndoLimit: Integer; function IsAddressPrefixStored: Boolean; function IsDrawStylesStored: Boolean; function IsOptionsStored: Boolean; procedure ScrollTimerHandler(Sender: TObject); procedure SetAddressCursor(Value: TCursor); procedure SetAddressMode(Value: TKHexEditorAddressMode); procedure SetAddressOffset(Value: Integer); procedure SetAddressPrefix(const Value: string); procedure SetAddressSize(Value: Integer); procedure SetAreaSpacing(Value: Integer); procedure SetCharSpacing(Value: Integer); procedure SetColors(Value: TKHexEditorColors); procedure SetCommandKey(Index: TKEditCommand; Value: TKEditKey); procedure SetData(const Value: TDataSize); procedure SetDigitGrouping(Value: Integer); procedure SetDisabledDrawStyle(Value: TKEditDisabledDrawStyle); procedure SetDrawStyles(const Value: TKHexEditorDrawStyles); procedure SetEditArea(Value: TKHexEditorArea); procedure SetLeftChar(Value: Integer); procedure SetLineHeightPercent(Value: Integer); procedure SetLines(Index: Int64; const Value: TDataSize); procedure SetLineSize(Value: Integer); procedure SetModified(Value: Boolean); procedure SetOptions(const Value: TKEditOptions); procedure SetReadOnly(Value: Boolean); procedure SetScrollBars(Value: TScrollStyle); procedure SetScrollSpeed(Value: Cardinal); procedure SetSelEnd(Value: TKHexEditorSelection); procedure SetSelLength(Value: TKHexEditorSelection); procedure SetSelStart(Value: TKHexEditorSelection); procedure SetTopLine(Value: Int64); procedure SetUndoLimit(Value: Integer); procedure CMEnabledChanged(var Msg: TLMessage); message CM_ENABLEDCHANGED; procedure CMSysColorChange(var Msg: TLMessage); message CM_SYSCOLORCHANGE; {$IFNDEF FPC} // no way to get filenames in Lazarus inside control (why??) procedure WMDropFiles(var Msg: TLMessage); message LM_DROPFILES; {$ENDIF} procedure WMEraseBkgnd(var Msg: TLMessage); message LM_ERASEBKGND; procedure WMGetDlgCode(var Msg: TLMNoParams); message LM_GETDLGCODE; procedure WMHScroll(var Msg: TLMHScroll); message LM_HSCROLL; procedure WMKillFocus(var Msg: TLMKillFocus); message LM_KILLFOCUS; procedure WMSetFocus(var Msg: TLMSetFocus); message LM_SETFOCUS; procedure WMVScroll(var Msg: TLMVScroll); message LM_VSCROLL; protected FInUpdateScrollRange: Boolean; { Inserts a single crCaretPos item into undo list. Unless Force is set to True, this change will be inserted only if previous undo item is not crCaretPos. } procedure AddUndoCaretPos(Force: Boolean = True); { Inserts a single byte change into undo list.
    Parameters:
  • ItemReason - specifies the undo/redo item reason - most likely crInsertChar or crDeleteChar.
  • Data - specifies the data byte needed to restore the original buffer state
  • Inserted - for the urInsert* items, specifies the current @link(TKCustomHexEditor.InsertMode) status.
} procedure AddUndoByte(ItemReason: TKHexEditorChangeReason; Data: Byte; Inserted: Boolean = True); { Inserts a byte array change into undo list.
    Parameters:
  • ItemReason - specifies the undo/redo item reason - crInsert* or crDelete*.
  • Data - specifies the data bytes needed to restore the original buffer state
  • Inserted - for the urInsert* items, specifies the current @link(TKCustomHexEditor.InsertMode) status.
} procedure AddUndoBytes(ItemReason: TKHexEditorChangeReason; Data: PBytes; Length: Integer; Inserted: Boolean = True); { Inserts a string change into undo list. Has the same functionality as AddUndoBytes only Data is supplied as a string. } procedure AddUndoString(ItemReason: TKHexEditorChangeReason; const S: AnsiString; Inserted: Boolean = True); { Begins a new undo group. Use the GroupReason parameter to label it. } procedure BeginUndoGroup(GroupReason: TKHexEditorChangeReason); { Performs necessary adjustments when the buffer is modified programatically (not by user) } procedure BufferChanged; { Determines whether an ecScroll* command can be executed } function CanScroll(Command: TKEditCommand): Boolean; virtual; { Clears a character at position At. Doesn't perform any succesive adjustments. } procedure ClearChar(At: Integer); { Clears a the digit fields both in SelStart and SelEnd. Doesn't perform any succesive adjustments.} procedure ClearDigitSelection; { Clears a string of the Size length at position At. Doesn't perform any succesive adjustments. } procedure ClearString(At, Size: Int64); { Overriden method - defines additional styles for the hex editor window (scrollbars etc.)} procedure CreateParams(var Params: TCreateParams); override; { Overriden method - adjusts file drag&drop functionality } procedure CreateWnd; override; { Overriden method - adjusts file drag&drop functionality } procedure DestroyWnd; override; { Calls the @link(TKCustomHexEditor.OnChange) event } procedure DoChange; virtual; { Overriden method - handles mouse wheel messages } function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override; { Validates the EditArea property after it has been modified } procedure EditAreaChanged; virtual; { Closes the undo group created by @link(TKCustomHexEditor.BeginUndoGroup) } procedure EndUndoGroup; { Ensures that font pitch is always fpFixed and Font.Size is not too small or big } procedure FontChange(Sender: TObject); virtual; { Returns the horizontal page extent for the current edit area. This function is used by the ecPageLeft and ecPageRight commands. } function GetPageHorz: Integer; virtual; { Determines if the editor has input focus. } function HasFocus: Boolean; virtual; { Hides the caret. } procedure HideEditorCaret; virtual; { Inserts a character at specified position. Doesn't perform any succesive adjustments.
    Parameters:
  • At - position where the character should be inserted.
  • Value - character (data byte)
} procedure InsertChar(At: Int64; Value: Byte); { Inserts a string at specified position. Doesn't perform any succesive adjustments.
    Parameters:
  • At - position where the string should be inserted.
  • Value - data byte string
} procedure InsertString(At: Int64; const Value: TDataSize); overload; { Inserts a string at specified position. Doesn't perform any succesive adjustments.
    Parameters:
  • At - position where the string should be inserted.
  • Value - data byte string
} procedure InsertString(At: Int64; const Value: AnsiString); overload; { Returns True if the control has a selection. } function InternalGetSelAvail: Boolean; override; { Moves the caret one position left. Doesn't perform any succesive adjustments.} procedure InternalMoveLeft; virtual; { Moves the caret one position right. Doesn't perform any succesive adjustments.} procedure InternalMoveRight; virtual; { Responds to PostLateUpdate. } procedure LateUpdate(var Msg: TLMessage); override; { Overriden method - processes virtual key strokes according to current key mapping scheme.) } procedure KeyDown(var Key: Word; Shift: TShiftState); override; { Overriden method - processes character key strokes - data editing } procedure KeyPress(var Key: Char); override; { Updates information about printed shape. } procedure MeasurePages(var Info: TKPrintMeasureInfo); override; { Processes scrollbar messages.
    Parameters:
  • ScrollBar - scrollbar type from OS
  • ScrollCode - scrollbar action from OS
  • Delta - scrollbar position change
  • UpdateNeeded - set to True if you want to invalidate and update caret position
} procedure ModifyScrollBar(ScrollBar, ScrollCode, Delta: Integer; UpdateNeeded: Boolean); { Overriden method - updates caret position/selection } procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; { Overriden method - updates caret position/selection and initializes scrolling when needed. } procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; { Overriden method - releases mouse capture acquired by MouseDown } procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; { Overriden method - calls PaintLines for drawing the hex editor outline into window client area } procedure PaintToCanvas(ACanvas: TCanvas); override; { Paints/prints hex editor outline. This function must retain its reentrancy.
    Parameters:
  • Data - paint settings
} procedure PaintLines(const Data: TKHexEditorPaintData); virtual; { Paints a page to a printer/preview canvas. } procedure PaintPage; override; { Grants the input focus to the control when possible and the control has had none before } procedure SafeSetFocus; { Performs necessary adjustments after a selection property changed.
    Parameters:
  • StartEqualEnd - forces SelStart equal to SelEnd
  • ScrollToView - forces scrolling if SelEnd (caret) became invisible
} procedure SelectionChanged(StartEqualEnd: Boolean; ScrollToView: Boolean = True); { Scrolls the hex editor window horizontaly by HChars characters and/or vertically by VChars characters } procedure ScrollBy(HChars, VChars: Integer; UpdateNeeded: Boolean); reintroduce; { Scrolls the hex editor window to ensure data under defined (mouse) coordinates are visible
    Parameters:
  • Point - (mouse) coordinates
  • Timed - set to True to continue scroll via a timer. The scrolling will continue until the mouse cursor is outside of the modified client rect (@link(TKCustomHexEditor.GetModifiedClientRect)).
  • AlwaysScroll - set to True to disable new line overscrolling
} procedure ScrollTo(Point: TKPoint64; Timed, AlwaysScroll: Boolean); virtual; { Updates mouse cursor according to the state determined from current mouse position. Returns True if cursor has been changed. } function SetMouseCursor(X, Y: Integer): Boolean; override; { Shows the caret. } procedure ShowEditorCaret; virtual; { Calls the @link(TKCustomHexEditor.DoChange) method} procedure UndoChange(Sender: TObject; ItemReason: TKHexEditorChangeReason); { Updates caret position, shows/hides caret according to the input focus
    Parameters:
  • Recreate - set to True to recreate the caret after it has already been created and displayed
} procedure UpdateEditorCaret(Recreate: Boolean = False); virtual; { Updates font based dimensions } procedure UpdateCharMetrics; virtual; { Updates mouse cursor } procedure UpdateMouseCursor; virtual; { Updates the scrolling range } procedure UpdateScrollRange; virtual; { Updates selection according to the supplied coordinates.
    Parameters:
  • Point - specifies the coordinates
  • ClipToClient - specifies whether the coordinates should be clipped to modified client rectangle (@link(TKCustomHexEditor.GetModifiedClientRect)) first
} procedure UpdateSelEnd(Point: TKPoint64; ClipToClient: Boolean); virtual; { Updates the control size. } procedure UpdateSize; override; { Data buffer - made accessible for descendant classes } property Buffer: PBytes read FBuffer write FBuffer; { Redo list manager - made accessible for descendant classes } property RedoList: TKHexEditorChangeList read FRedoList; { Data buffer size - made accessible for descendant classes } property Size: Int64 read FSize write FSize; { States of this class - made accessible for descendant classes } property States: TKHexEditorStates read FStates write FStates; { Undo list manager - made accessible for descendant classes } property UndoList: TKHexEditorChangeList read FUndoList; public { Performs necessary initializations - default values to properties, create undo/redo list managers } constructor Create(AOwner: TComponent); override; { Destroy instance, undo/redo list managers, dispose buffer... } destructor Destroy; override; { Appends data at current position. Use -1 for At parameter to append at the end of the buffer. } procedure Append(At: Integer; const Data: TDataSize); overload; virtual; { Appends data at current position. Use -1 for At parameter to append at the end of the buffer. } procedure Append(At: Integer; const Data: AnsiString); overload; virtual; { Takes property values from another TKCustomHexEditor class } procedure Assign(Source: TPersistent); override; { Determines whether the caret is visible } function CaretInView: Boolean; { Clears entire data buffer. Unlike ecClearAll this method clears everything inclusive undo a redo lists. } procedure Clear; { Clears undo (and redo) list } procedure ClearUndo; { Determines whether given command can be executed at this time. Use this function in TAction.OnUpdate events.
    Parameters:
  • Command - specifies the command to inspect
} function CommandEnabled(Command: TKEditCommand): Boolean; virtual; { Executes given command. This function first calls CommandEnabled to assure given command can be executed.
    Parameters:
  • Command - specifies the command to execute
  • Data - specifies the data needed for the command
} function ExecuteCommand(Command: TKEditCommand; Data: Pointer = nil): Boolean; virtual; { Returns dimensions of all 3 possible areas according to current area definition } function GetAreaDimensions: TKHexEditorAreaDimensions; virtual; { Returns current character mapping. } function GetCharMapping: TKEditCharMapping; { Returns number of characters that vertically fit into client window } function GetClientHeightChars: Integer; virtual; { Returns number of characters that horizontally fit into client window } function GetClientWidthChars: Integer; virtual; { Returns modified client rect - a window client rect aligned to character width and character height } function GetModifiedClientRect: TRect; virtual; { Returns current maximum value for the @link(TKCustomHexEditor.LeftChar) property
    Parameters:
  • Extent - specify @link(TKHexEditorAreaDimensions).TotalHorz here, otherwise the function calculates it itself
} function GetMaxLeftChar(Extent: Integer = 0): Integer; virtual; { Returns current maximum value for the @link(TKCustomHexEditor.TopLine) property
    Parameters:
  • Extent - specify @link(TKHexEditorAreaDimensions).TotalVert here, otherwise the function calculates it itself
} function GetMaxTopLine(Extent: Int64 = 0): Int64; virtual; { Returns "real" selection end - with always higher index value than selection start value } function GetRealSelEnd: TKHexEditorSelection; { Returns "real" selection start - with always lower index value than selection end value } function GetRealSelStart: TKHexEditorSelection; { Loads data from a file } procedure LoadFromFile(const FileName: TFileName); { Loads data from a stream - stream position remains untouched } procedure LoadFromStream(Stream: TStream); { Paints the editor outline to another canvas
    Parameters:
  • ACanvas - canvas to paint the outline to
  • ARect - given rectangle in the canvas
  • ALeftChar - first left visible character
  • ATopLine - first top visible line
} procedure PaintToCanvasEx(ACanvas: TCanvas; ARect: TRect; ALeftChar: Integer; ATopLine: Int64); { Converts window coordinates into a selection
    Parameters:
  • P - window client coordinates
  • OutOfArea - uses the Area parameter to compute selection for this area even if the supplied coordinates are outside of the area outline
  • Area output parameter if OutOfArea = False, otherwise input parameter
} function PointToSel(P: TKPoint64; OutOfArea: Boolean; var Area: TKHexEditorArea): TKHexEditorSelection; virtual; { Saves data into a file } procedure SaveToFile(const FileName: TFileName); { Saves data into a stream - stream position remains untouched } procedure SaveToStream(Stream: TStream); { Determines whether a seletion (not digit selection) is available } function SelAvail: Boolean; { Determines whether a given selection is valid for given area
    Parameters:
  • Value - selection to examine
  • Area - area for which the selection must be examined
} function SelectionValid(Value: TKHexEditorSelection; Area: TKHexEditorArea): Boolean; virtual; { Converts a selection into window coordinates
    Parameters:
  • Value - selection to convert
  • Area - the same selection delivers another coordinates for each area
} function SelToPoint(Value: TKHexEditorSelection; Area: TKHexEditorArea): TKPoint64; virtual; { Specifies character mapping. The main purpose of this is to avoid non-printable characters in the text area and in AsText copies. Avoid non-printable characters when delivering a new character mapping. } procedure SetCharMapping(Value: TKEditCharMapping); { Specifies the current key stroke mapping scheme } procedure SetKeyMapping(const Value: TKEditKeyMapping); { Validates a selection for given area
    Parameters:
  • Value - selection to validate
  • Area - area for which the selection must be validated
} procedure ValidateSelection(var Value: TKHexEditorSelection; Area: TKHexEditorArea); virtual; { Specifies the address area mouse cursor. Other areas have crIBeam - should not be needed to modify that } property AddressCursor: TCursor read FAddressCursor write SetAddressCursor default cAddressCursorDef; { Specifies the radix of addresses } property AddressMode: TKHexEditorAddressMode read FAddressMode write SetAddressMode default cAddressModeDef; { Specifies the address offset } property AddressOffset: Integer read FAddressOffset write SetAddressOffset default cAddressOffsetDef; { Specifies the address number prefix i.e. 0x or $ - modify together with AddressMode } property AddressPrefix: string read FAddressPrefix write SetAddressPrefix stored IsAddressPrefixStored; { Specifies the number of address digits - up to 10 for decimal addresses } property AddressSize: Integer read FAddressSize write SetAddressSize default cAddressSizeDef; { Defines space between neighbour areas } property AreaSpacing: Integer read FAreaSpacing write SetAreaSpacing default cAreaSpacingDef; { Returns current caret position = selection end } property CaretPos: TKHexEditorSelection read FSelEnd; { Returns True if caret is visible } property CaretVisible: Boolean read GetCaretVisible; { Returns current character width = not necessarily equal to font character width } property CharWidth: Integer read FCharWidth; { Defines additional inter-character spacing } property CharSpacing: Integer read FCharSpacing write SetCharSpacing default cCharSpacingDef; { Returns current character height = not equal to font character height } property CharHeight: Integer read FCharHeight; { Returns the binary data clipboard format } property ClipboardFormat: Word read FClipboardFormat; { Makes it possible to take all color properties from another TKCustomHexEditor class } property Colors: TKHexEditorColors read FColors write SetColors; { Specifies a new key stroke combination for given command } property CommandKey[Index: TKEditCommand]: TKEditKey read GetCommandKey write SetCommandKey; { This property provides direct access to the data buffer } property Data: TDataSize read GetData write SetData; { Specifies the byte grouping in the digits area } property DigitGrouping: Integer read FDigitGrouping write SetDigitGrouping default cDigitGroupingDef; { Specifies the style how the outline is drawn when editor is disabled } property DisabledDrawStyle: TKEditDisabledDrawStyle read FDisabledDrawStyle write SetDisabledDrawStyle default cEditDisabledDrawStyleDef; { Defines areas to paint, whether to paint horizontal and vertical trailing lines, area separator lines and caret mark when the editor has no input focus } property DrawStyles: TKHexEditorDrawStyles read FDrawStyles write SetDrawStyles stored IsDrawStylesStored; { Specifies the current area for editing } property EditArea: TKHexEditorArea read FEditArea write SetEditArea default eaDigits; { Returns True if data buffer is empty } property Empty: Boolean read GetEmpty; { Returns the first visible index } property FirstVisibleIndex: Integer read GetFirstVisibleIndex; { Returns True if insert mode is on } property InsertMode: Boolean read GetInsertMode; { Specifies the current key stroke mapping scheme. } property KeyMapping: TKEditKeyMapping read FKeyMapping; { Returns the last visible index } property LastVisibleIndex: Integer read GetLastVisibleIndex; { Specifies the horizontal scroll position } property LeftChar: Integer read FLeftChar write SetLeftChar; { Determines the number of lines } property LineCount: Int64 read GetLineCount; { Specifies the line height. 100% is the current font height } property LineHeightPercent: Integer read FLineHeightPercent write SetLineHeightPercent default cLineHeightPercentDef; { Allows to modify/add data lines. If greater than LineSize, the Size member of the supplied TDataSize structure will be always trimmed to LineSize. If Index points to last incomplete line or even higher, last line will be extended/completed, i.e new data will be added to the buffer } property Lines[Index: Int64]: TDataSize read GetLines write SetLines; { Specifies the size (length) of a single line } property LineSize: Integer read FLineSize write SetLineSize default cLineSizeDef; { Returns True if the buffer was modified - eoUndoAfterSave taken into account } property Modified: Boolean read GetModified write SetModified; { Specifies the editor options that do not affect painting } property Options: TKEditOptions read FOptions write SetOptions stored IsOptionsStored; { Specifies whether the editor has to be read only editor } property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False; { Defines visible scrollbars - horizontal, vertical or both } property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssBoth; { Specifies how fast the scrolling by timer should be } property ScrollSpeed: Cardinal read FScrollSpeed write SetScrollSpeed default cScrollSpeedDef; { Specifies the current selection end } property SelEnd: TKHexEditorSelection read FSelEnd write SetSelEnd; { Specifies the current selection length. SelStart remains unchanged, SelEnd will be updated accordingly. To mark a selection, either set both SelStart and SelEnd properties or both SelStart and SelLength properties } property SelLength: TKHexEditorSelection read GetSelLength write SetSelLength; { Specifies the current selection start } property SelStart: TKHexEditorSelection read FSelStart write SetSelStart; { Returns selected text in many different formats } property SelText: TKHexEditorSelText read GetSelText; { Specifies the vertical scroll position } property TopLine: Int64 read FTopLine write SetTopLine; { Specifies the maximum number of undo items. Please note this value affects the undo item limit, not undo group limit. } property UndoLimit: Integer read GetUndoLimit write SetUndoLimit default cUndoLimitDef; { When assigned, this event will be invoked at each buffer change, made either by the user or programmatically by public functions } property OnChange: TNotifyEvent read FOnChange write FOnChange; { When assigned, this event will be invoked when the user drops any files onto the window } property OnDropFiles: TKEditDropFilesEvent read FOnDropFiles write FOnDropFiles; { When assigned, this event will be invoked at each prompt-forced search match } property OnReplaceText: TKEditReplaceTextEvent read FOnReplaceText write FOnReplaceText; end; { @abstract(Hexadecimal editor design-time component) } TKHexEditor = class(TKCustomHexEditor) published { See TKCustomHexEditor.@link(TKCustomHexEditor.AddressCursor) for details } property AddressCursor; { See TKCustomHexEditor.@link(TKCustomHexEditor.AddressMode) for details } property AddressMode; { See TKCustomHexEditor.@link(TKCustomHexEditor.AddressOffset) for details } property AddressOffset; { See TKCustomHexEditor.@link(TKCustomHexEditor.AddressPrefix) for details } property AddressPrefix; { See TKCustomHexEditor.@link(TKCustomHexEditor.AddressSize) for details } property AddressSize; { Inherited property - see Delphi help } property Align; { Inherited property - see Delphi help } property Anchors; { See TKCustomControl.@link(TKCustomControl.BorderStyle) for details } property BorderStyle; { Inherited property - see Delphi help } property BorderWidth; { See TKCustomHexEditor.@link(TKCustomHexEditor.CharSpacing) for details } property CharSpacing; { See TKCustomHexEditor.@link(TKCustomHexEditor.Colors) for details } property Colors; { Inherited property - see Delphi help } property Constraints; {$IFNDEF FPC} { Inherited property - see Delphi help. } property Ctl3D; {$ENDIF} { See TKCustomHexEditor.@link(TKCustomHexEditor.DigitGrouping) for details } property DigitGrouping; { See TKCustomHexEditor.@link(TKCustomHexEditor.DisabledDrawStyle) for details } property DisabledDrawStyle; { Inherited property - see Delphi help } property DragCursor; { Inherited property - see Delphi help } property DragKind; { Inherited property - see Delphi help } property DragMode; { See TKCustomHexEditor.@link(TKCustomHexEditor.DrawStyles) for details } property DrawStyles; { See TKCustomHexEditor.@link(TKCustomHexEditor.EditArea) for details } property EditArea; { Inherited property - see Delphi help } property Enabled; { Inherited property - see Delphi help. Font pitch must always remain fpFixed - specify fixed fonts only. Font.Size will also be trimmed if too small or big } property Font; { Inherited property - see Delphi help } property Height default cHeight; { See TKCustomHexEditor.@link(TKCustomHexEditor.LineHeightPercent) for details } property LineHeightPercent; { See TKCustomHexEditor.@link(TKCustomHexEditor.LineSize) for details } property LineSize; { See TKCustomHexEditor.@link(TKCustomHexEditor.Options) for details } property Options; { Inherited property - see Delphi help } property ParentShowHint; { Inherited property - see Delphi help } property PopupMenu; { See TKCustomHexEditor.@link(TKCustomHexEditor.ReadOnly) for details } property ReadOnly; { See TKCustomHexEditor.@link(TKCustomHexEditor.ScrollBars) for details } property ScrollBars; { See TKCustomHexEditor.@link(TKCustomHexEditor.ScrollSpeed) for details } property ScrollSpeed; { Inherited property - see Delphi help } property ShowHint; { Inherited property - see Delphi help } property TabOrder; { Inherited property - see Delphi help } property TabStop default True; { See TKCustomHexEditor.@link(TKCustomHexEditor.UndoLimit) for details } property UndoLimit; { Inherited property - see Delphi help } property Visible; { Inherited property - see Delphi help } property Width default cWidth; { See TKCustomHexEditor.@link(TKCustomHexEditor.OnChange) for details } property OnChange; { Inherited property - see Delphi help } property OnClick; { Inherited property - see Delphi help } property OnContextPopup; { Inherited property - see Delphi help } property OnDblClick; { Inherited property - see Delphi help } property OnDockDrop; { Inherited property - see Delphi help } property OnDockOver; { Inherited property - see Delphi help } property OnDragDrop; { Inherited property - see Delphi help } property OnDragOver; { See TKCustomHexEditor.@link(TKCustomHexEditor.OnDropFiles) for details } property OnDropFiles; { Inherited property - see Delphi help } property OnEndDock; { Inherited property - see Delphi help } property OnEndDrag; { Inherited property - see Delphi help } property OnEnter; { Inherited property - see Delphi help } property OnExit; { Inherited property - see Delphi help } property OnGetSiteInfo; { Inherited property - see Delphi help } property OnKeyDown; { Inherited property - see Delphi help } property OnKeyPress; { Inherited property - see Delphi help } property OnKeyUp; { Inherited property - see Delphi help } property OnMouseDown; {$IFDEF COMPILER9_UP} { Inherited property - see Delphi help. } property OnMouseEnter; { Inherited property - see Delphi help. } property OnMouseLeave; {$ENDIF} { Inherited property - see Delphi help } property OnMouseMove; { Inherited property - see Delphi help } property OnMouseUp; { Inherited property - see Delphi help } property OnMouseWheel; { Inherited property - see Delphi help } property OnMouseWheelDown; { Inherited property - see Delphi help } property OnMouseWheelUp; { See TKCustomControl.@link(TKCustomControl.OnPrintNotify) for details } property OnPrintNotify; { See TKCustomControl.@link(TKCustomControl.OnPrintPaint) for details } property OnPrintPaint; { See TKCustomHexEditor.@link(TKCustomHexEditor.OnReplaceText) for details } property OnReplaceText; { Inherited property - see Delphi help } property OnResize; { Inherited property - see Delphi help } property OnStartDock; { Inherited property - see Delphi help } property OnStartDrag; { Inherited property - see Delphi help } property OnUnDock; end; { Declared for backward compatibility only. Use @link(TKCustomHexEditor.Colors) and its properties/methods. } function GetColorSpec(Index: TKHexEditorColorIndex): TKHexEditorColorSpec; function MakeSelection(Index: Int64; Digit: Integer): TKHexEditorSelection; implementation uses {$IFDEF USE_THEMES} Themes, {$ENDIF} Math, {$IFDEF MSWINDOWS} ShellApi, {$ENDIF} ClipBrd, Printers, Types, KRes; function OppositeReason(ItemReason: TKHexEditorChangeReason): TKHexEditorChangeReason; begin case ItemReason of crDeleteChar: Result := crInsertChar; crDeleteDigits: Result := crInsertDigits; crDeleteString: Result := crInsertString; crInsertChar: Result := crDeleteChar; crInsertDigits: Result := crDeleteDigits; crInsertString: Result := crDeleteString; else Result := ItemReason; end; end; function GetColorSpec(Index: TKHexEditorColorIndex): TKHexEditorColorSpec; var Colors: TKHexEditorColors; begin Colors := TKHexEditorColors.Create(nil); try Result.Def := Colors.DefaultColor[Index]; Result.Name := Colors.ColorName[Index]; finally Colors.Free; end; end; function MakeSelection(Index: Int64; Digit: Integer): TKHexEditorSelection; begin Result := MakeHexDigitPosition(Index, Digit); end; { TKHexEditorColors } function TKHexEditorColors.GetColorSpec(Index: TKColorIndex): TKColorSpec; begin case Index of ciAddressText: begin Result.Def := cAddressTextDef; Result.Name := sHEAddressText; end; ciAddressBkGnd: begin Result.Def := cAddressBkgndDef; Result.Name := sHEAddressBkGnd; end; ciBkGnd: begin Result.Def := cBkGndDef; Result.Name := sHEBkGnd; end; ciDigitTextEven: begin Result.Def := cDigitTextEvenDef; Result.Name := sHEDigitTextEven; end; ciDigitTextOdd: begin Result.Def := cDigitTextOddDef; Result.Name := sHEDigitTextOdd; end; ciDigitBkGnd: begin Result.Def := cDigitBkGndDef; Result.Name := sHEDigitBkgnd; end; ciHorzLines: begin Result.Def := cHorzLinesDef; Result.Name := sHEHorzLines; end; ciInactiveCaretBkGnd: begin Result.Def := cInactiveCaretBkGndDef; Result.Name := sHEInactiveCaretBkGnd; end; ciInactiveCaretSelBkGnd: begin Result.Def := cInactiveCaretSelBkGndDef; Result.Name := sHEInactiveCaretSelBkGnd; end; ciInactiveCaretSelText: begin Result.Def := cInactiveCaretSelTextDef; Result.Name := sHEInactiveCaretSelText; end; ciInactiveCaretText: begin Result.Def := cInactiveCaretTextDef; Result.Name := sHEInactiveCaretText; end; ciLinesHighLight: begin Result.Def := cLinesHighLightDef; Result.Name := sHELinesHighLight; end; ciSelBkGnd: begin Result.Def := cSelBkGndDef; Result.Name := sHESelBkGnd; end; ciSelBkGndFocused: begin Result.Def := cSelBkGndFocusedDef; Result.Name := sHESelBkGndFocused; end; ciSelText: begin Result.Def := cSelTextDef; Result.Name := sHESelText; end; ciSelTextFocused: begin Result.Def := cSelTextFocusedDef; Result.Name := sHESelTextFocused; end; ciSeparators: begin Result.Def := cSeparatorsDef; Result.Name := sHESeparators; end; ciTextText: begin Result.Def := cTextTextDef; Result.Name := sHETextText; end; ciTextBkGnd: begin Result.Def := cTextBkgndDef; Result.Name := sHETextBkGnd; end; ciVertLines: begin Result.Def := cVertLinesDef; Result.Name := sHEVertLines; end; else Result := inherited GetColorSpec(Index); end; end; function TKHexEditorColors.InternalGetColor(Index: TKColorIndex): TColor; const AreaBkGndSet = [ciAddressBkgnd, ciDigitBkGnd, ciTextBkGnd]; BkGndSet = [ciAddressBkgnd, ciBkGnd, ciDigitBkGnd, ciInactiveCaretBkGnd, ciInactiveCaretSelBkGnd, ciSelBkGnd, ciSelBkGndFocused, ciTextBkgnd]; begin case FColorScheme of csGrayed: if Index in BkGndSet then Result := clWindow else Result := clGrayText; csBright: begin if FBrightColors[Index] = clNone then FBrightColors[Index] := BrightColor(FColors[Index], 0.5, bsOfTop); if FSingleBkGnd and (Index in AreaBkGndSet) then Result := FBrightColors[ciBkGnd] else Result := FBrightColors[Index]; end; csGrayScale: Result := ColorToGrayScale(FColors[Index]); else if FSingleBkGnd and (Index in AreaBkGndSet) then Result := FColors[ciBkGnd] else Result := FColors[Index]; end; end; function TKHexEditorColors.GetMaxIndex: Integer; begin Result := ciHexEditorColorsMax; end; { TKHexEditorChangeList } constructor TKHexEditorChangeList.Create(AEditor: TKCustomHexEditor; RedoList: TKHexEditorChangeList); begin inherited Create; FEditor := AEditor; FGroupUseLock := 0; FLimit := cUndoLimitDef; FIndex := -1; FModifiedIndex := FIndex; FRedoList := RedoList; FOnChange := nil; end; procedure TKHexEditorChangeList.AddChange(ItemReason: TKHexEditorChangeReason; const Data: AnsiString; Inserted: Boolean); var P: PKHexEditorChangeItem; begin // don't allow succesive crCaretPos if (ItemReason = crCaretPos) and not Inserted and (FIndex >= 0) and (PKHexEditorChangeItem(Items[FIndex]).ItemReason = crCaretPos) then Exit; if FIndex < FLimit - 1 then begin if FIndex < Count - 1 then Inc(FIndex) else FIndex := Add(New(PKHexEditorChangeItem)); P := Items[FIndex]; if FGroupUseLock > 0 then begin P.Group := FGroup; P.GroupReason := FGroupReason; end else begin P.Group := 0; P.GroupReason := ItemReason; end; P.ItemReason := ItemReason; P.EditArea := FEditor.EditArea; P.SelEnd := FEditor.SelEnd; P.SelStart := FEditor.SelStart; P.Data := Data; P.Inserted := Inserted; if FRedoList <> nil then FRedoList.Clear; if Assigned(FOnChange) then FOnChange(Self, ItemReason); end; end; procedure TKHexEditorChangeList.BeginGroup(GroupReason: TKHexEditorChangeReason); begin if FGroupUseLock = 0 then begin FGroupReason := GroupReason; Inc(FGroup); if FGroup = 0 then Inc(FGroup); end; Inc(FGroupUseLock); end; function TKHexEditorChangeList.CanPeek: Boolean; begin Result := FIndex >= 0; end; procedure TKHexEditorChangeList.Clear; begin inherited; FGroupUseLock := 0; FIndex := -1; FModifiedIndex := FIndex; end; procedure TKHexEditorChangeList.EndGroup; begin if FGroupUseLock > 0 then Dec(FGroupUseLock); end; function TKHexEditorChangeList.GetModified: Boolean; function CaretPosOnly: Boolean; var I: Integer; begin Result := True; for I := FModifiedIndex + 1 to FIndex do begin if PKHexEditorChangeItem(Items[I]).ItemReason <> crCaretPos then begin Result := False; Exit; end; end; end; begin Result := (FIndex > FModifiedIndex) and not CaretPosOnly; end; procedure TKHexEditorChangeList.Notify(Ptr: Pointer; Action: TListNotification); var P: PKHexEditorChangeItem; begin case Action of lnDeleted: if Ptr <> nil then begin P := Ptr; Dispose(P); end; end; end; function TKHexEditorChangeList.PeekItem: PKHexEditorChangeItem; begin if CanPeek then begin Result := Items[FIndex]; Dec(FIndex); end else Result := nil; end; procedure TKHexEditorChangeList.PokeItem; begin if FIndex < Count - 1 then Inc(FIndex); end; procedure TKHexEditorChangeList.SetGroupData(Group: Integer; GroupReason: TKHexEditorChangeReason); begin FGroup := Group; FGroupReason := GroupReason; FGroupUseLock := 1; end; procedure TKHexEditorChangeList.SetLimit(Value: Integer); begin if Value <> FLimit then begin FLimit := MinMax(Value, cUndoLimitMin, cUndoLimitMax); while Count > FLimit do Delete(0); FIndex := Min(FIndex, FLimit - 1); end; end; procedure TKHexEditorChangeList.SetModified(Value: Boolean); begin if not Value then FModifiedIndex := FIndex; end; { TKCustomHexEditor } constructor TKCustomHexEditor.Create(AOwner: TComponent); begin inherited Create(AOwner); Color := clWindow; ControlStyle := [csOpaque, csClickEvents, csDoubleClicks, csCaptureMouse]; Font.Name := cFontNameDef; Font.Style := cFontStyleDef; Font.Size := cFontSizeDef; Font.Pitch := fpFixed; Font.OnChange := FontChange; Height := cHeight; ParentColor := False; ParentFont := False; TabStop := True; Width := cWidth; FAddressCursor := cAddressCursorDef; FAddressMode := cAddressModeDef; FAddressOffset := cAddressOffsetDef; FAddressPrefix := cAddressPrefixDef; FAddressSize := cAddressSizeDef; FAreaSpacing := cAreaSpacingDef; FBuffer := nil; {$IFNDEF FPC} FClipBoardFormat := RegisterClipboardFormat('Any binary data'); {$ENDIF} FColors := TKHexEditorColors.Create(Self); FCharHeight := 8; FCharMapping := DefaultCharMapping; FCharSpacing := cCharSpacingDef; FCharWidth := 6; FDigitGrouping := cDigitGroupingDef; FDisabledDrawStyle := cEditDisabledDrawStyleDef; FDrawStyles := cDrawStylesDef; FEditArea := eaDigits; FInUpdateScrollRange := False; FLeftChar := 0; FLineHeightPercent := cLineHeightPercentDef; FLineSize := cLineSizeDef; FMouseWheelAccumulator := 0; FOptions := [eoGroupUndo]; FKeyMapping := TKEditKeyMapping.Create; FRedoList := TKHexEditorChangeList.Create(Self, nil); FScrollBars := ssBoth; FScrollSpeed := cScrollSpeedDef; FScrollTimer := TTimer.Create(Self); FScrollTimer.Enabled := False; FScrollTimer.Interval := FScrollSpeed; FScrollTimer.OnTimer := ScrollTimerHandler; FSelStart := MakeSelection(0, 0); FSelEnd := MakeSelection(0, 0); FStates := []; FTopLine := 0; FTotalCharSpacing := 0; FUndoList := TKHexEditorChangeList.Create(Self, FRedoList); FUndoList.OnChange := UndoChange; FOnChange := nil; FOnReplaceText := nil; UpdateCharMetrics; end; destructor TKCustomHexEditor.Destroy; begin inherited; FOnChange := nil; FColors.Free; FKeyMapping.Free; FUndoList.Free; FRedoList.Free; FreeMem(FBuffer); FBuffer := nil; end; procedure TKCustomHexEditor.AddUndoCaretPos(Force: Boolean); begin FUndoList.AddChange(crCaretPos, '', Force); end; procedure TKCustomHexEditor.AddUndoByte(ItemReason: TKHexEditorChangeReason; Data: Byte; Inserted: Boolean = True); begin FUndoList.AddChange(ItemReason, AnsiChar(Data), Inserted); end; procedure TKCustomHexEditor.AddUndoBytes(ItemReason: TKHexEditorChangeReason; Data: PBytes; Length: Integer; Inserted: Boolean = True); var S: AnsiString; begin if Length > 0 then begin SetLength(S, Length); Move(Data^, S[1], Length); FUndoList.AddChange(ItemReason, S, Inserted); end; end; procedure TKCustomHexEditor.AddUndoString(ItemReason: TKHexEditorChangeReason; const S: AnsiString; Inserted: Boolean = True); begin if S <> '' then FUndoList.AddChange(ItemReason, S, Inserted); end; procedure TKCustomHexEditor.Append(At: Integer; const Data: TDataSize); begin if (Data.Size > 0) and (Data.Data <> nil) then begin if At < 0 then At := FSize; InsertString(At, Data); end; end; procedure TKCustomHexEditor.Append(At: Integer; const Data: AnsiString); begin if Length(Data) > 0 then Append(At, MakeDataSize(@Data[1], Length(Data))); end; procedure TKCustomHexEditor.Assign(Source: TPersistent); begin if Source is TKCustomHexEditor then with Source as TKCustomHexEditor do begin Self.AddressCursor := AddressCursor; Self.AddressMode := AddressMode; Self.AddressPrefix := AddressPrefix; Self.AddressSize := AddressSize; Self.Align := Align; Self.Anchors := Anchors; Self.AutoSize := AutoSize; Self.BiDiMode := BiDiMode; Self.BorderStyle := BorderStyle; Self.BorderWidth := BorderWidth; Self.CharSpacing := CharSpacing; Self.Color := Color; Self.Colors := Colors; Self.Constraints.Assign(Constraints); {$IFNDEF FPC} Self.Ctl3D := Ctl3D; {$ENDIF} Self.Data := Data; Self.DigitGrouping := DigitGrouping; Self.DisabledDrawStyle := DisabledDrawStyle; Self.DragCursor := DragCursor; Self.DragKind := DragKind; Self.DragMode := DragMode; Self.DrawStyles := DrawStyles; Self.EditArea := EditArea; Self.Enabled := Enabled; Self.Font := Font; {$IFNDEF FPC} Self.ImeMode := ImeMode; Self.ImeName := ImeName; {$ENDIF} Self.KeyMapping.Assign(KeyMapping); Self.LineHeightPercent := LineHeightPercent; Self.LineSize := LineSize; Self.Modified := False; Self.Options := Options; Self.ParentBiDiMode := ParentBiDiMode; Self.ParentColor := ParentColor; {$IFNDEF FPC} Self.ParentCtl3D := ParentCtl3D; {$ENDIF} Self.ParentFont := ParentFont; Self.ParentShowHint := ParentShowHint; Self.PopupMenu := PopupMenu; Self.ScrollBars := ScrollBars; Self.SelEnd := SelEnd; Self.SelStart := SelStart; Self.SetCharMapping(GetCharMapping); Self.ShowHint := ShowHint; Self.TabOrder := TabOrder; Self.TabStop := TabStop; Self.Visible := Visible; end else inherited; end; procedure TKCustomHexEditor.BeginUndoGroup(GroupReason: TKHexEditorChangeReason); begin FUndoList.BeginGroup(GroupReason); end; procedure TKCustomHexEditor.BufferChanged; begin FUndoList.Clear; FRedoList.Clear; UpdateScrollRange; SelectionChanged(False); DoChange; end; function TKCustomHexEditor.CanScroll(Command: TKEditCommand): Boolean; var XMax, YMax: Integer; P: TKPoint64; AD: TKHExEditorAreaDimensions; begin AD := GetAreaDimensions; XMax := GetMaxLeftChar(AD.TotalHorz); YMax := GetMaxTopLine(AD.TotalVert); case Command of ecScrollUp: Result := FTopLine > 0; ecScrollDown: Result := FTopLine < YMax; ecScrollLeft: Result := FLeftChar > 0; ecScrollRight: Result := FLeftChar < XMax; ecScrollCenter: begin P := SelToPoint(FSelEnd, FEditArea); P.X := P.X - ClientWidth div 2; P.Y := P.Y - ClientHeight div 2; Result := (FLeftChar > 0) and (P.X < 0) or (FLeftChar < XMax) and (P.X > FCharWidth) or (FTopLine > 0) and (P.Y < 0) or (FTopLine < YMax) and (P.Y > FCharHeight); end; else Result := False; end; end; function TKCustomHexEditor.CaretInView: Boolean; begin Result := Pt64InRect(GetModifiedClientRect, SelToPoint(FSelEnd, FEditArea)); end; procedure TKCustomHexEditor.Clear; begin if FBuffer <> nil then begin FreeMem(FBuffer); FBuffer := nil; FSize := 0; BufferChanged; end; end; procedure TKCustomHexEditor.ClearChar(At: Integer); begin ClearString(At, 1); end; procedure TKCustomHexEditor.ClearDigitSelection; begin FSelStart.Digit := 0; FSelEnd.Digit := 0; end; procedure TKCustomHexEditor.ClearString(At, Size: Int64); begin if (FBuffer <> nil) and (Size > 0) and (At >= 0) and (At + Size <= FSize) then begin Move(FBuffer[At + Size], FBuffer[At], (FSize - At - Size) * SizeOf(Byte)); Dec(FSize, Size); ReallocMem(FBuffer, FSize); UpdateScrollRange; Invalidate; end; end; procedure TKCustomHexEditor.ClearUndo; begin FUndoList.Clear; FRedoList.Clear; end; procedure TKCustomHexEditor.CMEnabledChanged(var Msg: TLMessage); begin inherited; UpdateEditorCaret; Invalidate; end; procedure TKCustomHexEditor.CMSysColorChange(var Msg: TLMessage); begin inherited; FColors.ClearBrightColors; end; function TKCustomHexEditor.CommandEnabled(Command: TKEditCommand): Boolean; var L: TKHexEditorSelection; begin if Enabled and Visible and not (csDesigning in ComponentState) then begin L := SelLength; case Command of // movement commands ecLeft, ecSelLeft: Result := (FSelEnd.Index > 0) or (FEditArea = eaDigits) and (FSelEnd.Digit > 0); ecRight, ecSelRight: Result := (FEditArea <> eaNone) and (FSelEnd.Index < FSize); ecUp, ecSelUp: Result := FSelEnd.Index >= FLineSize; ecDown, ecSelDown: Result := (FEditArea <> eaNone) and (FSelEnd.Index < FSize); ecLineStart, ecSelLineStart: Result := (FEditArea <> eaNone) and (FSelEnd.Index mod FLineSize > 0); ecLineEnd, ecSelLineEnd: Result := (FEditArea <> eaNone) and (FSelEnd.Index mod FLineSize < Min(FLineSize - 1, FSize)); ecPageUp, ecSelPageUp: Result := FSelEnd.Index >= FlineSize; ecPageDown, ecSelPageDown: Result := (FEditArea <> eaNone) and (FSelEnd.Index < FSize div FLineSize * FLineSize); ecPageLeft, ecSelPageLeft: Result := (FEditArea <> eaNone) and (GetPageHorz > 0) and (FSelEnd.Index mod FLineSize > 0); ecPageRight, ecSelPageRight: Result := (FEditArea <> eaNone) and (GetPageHorz > 0) and (FSelEnd.Index mod FLineSize < Min(FLineSize - 1, FSize)); ecPageTop, ecSelPageTop: Result := (FEditArea <> eaNone) and (FSelEnd.Index > 0) and (SelToPoint(MakeSelection(FSelEnd.Index, 0), FEditArea).Y div FCharHeight <> 0); ecPageBottom, ecSelPageBottom: Result := (FEditArea <> eaNone) and (FSelEnd.Index < FSize) and ((ClientHeight - SelToPoint(MakeSelection(FSelEnd.Index, 0), FEditArea).Y) div FCharHeight - 1 <> 0); ecEditorTop, ecSelEditorTop: Result := FSelEnd.Index > 0; ecEditorBottom, ecSelEditorBottom: Result := (FEditArea <> eaNone) and (FSelEnd.Index < FSize); ecGotoXY, ecSelGotoXY: Result := True; // scroll commands ecScrollUp, ecScrollDown, ecScrollLeft, ecScrollRight, ecScrollCenter: Result := CanScroll(Command); // editing commands ecUndo: Result := not ReadOnly and FUndoList.CanPeek; ecRedo: Result := not ReadOnly and FRedoList.CanPeek; ecCopy, ecCut: Result := not Empty and (not ReadOnly or (Command = ecCopy)) and ((L.Index <> 0) or (L.Digit <> 0)); ecPaste: Result := not ReadOnly and (FEditArea <> eaNone) and (ClipBoard.FormatCount > 0); ecInsertChar: Result := not ReadOnly and (FEditArea <> eaNone); ecInsertDigits: Result := not ReadOnly and (FEditArea = eaDigits); ecInsertString: Result := not ReadOnly and (FEditArea <> eaNone); ecDeleteLastChar: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone) and ((L.Index > 0) or (FSelEnd.Index > 0)); ecDeleteChar: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone) and ((L.Index > 0) or (FSelEnd.Index < FSize)); ecDeleteBOL: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone) and ((L.Index > 0) or (FSelEnd.Index mod FLineSize > 0)); ecDeleteEOL: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone) and ((L.Index > 0) or (FSelEnd.Index mod FLineSize < Min(FLineSize, FSize))); ecDeleteLine: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone) and ((L.Index > 0) or (FSelEnd.Index mod FLineSize > 0) or (FSelEnd.Index < FSize)); ecSelectAll: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone); ecClearAll: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone); ecClearIndexSelection, ecClearSelection: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone) and (L.Index > 0); ecSearch: Result := not Empty; ecReplace: Result := not (Empty or ReadOnly); ecInsertMode: Result := elOverwrite in FStates; ecOverwriteMode: Result := not (elOverwrite in FStates); else Result := True; end; end else Result := False; end; procedure TKCustomHexEditor.CreateParams(var Params: TCreateParams); begin inherited; with Params do begin if FScrollBars in [ssVertical, ssBoth] then Style := Style or WS_VSCROLL; if FScrollBars in [ssHorizontal, ssBoth] then Style := Style or WS_HSCROLL; end; end; procedure TKCustomHexEditor.CreateWnd; begin inherited; {$IFDEF MSWINDOWS} if (eoDropFiles in FOptions) and not (csDesigning in ComponentState) then DragAcceptFiles(Handle, TRUE); {$ENDIF} end; procedure TKCustomHexEditor.DestroyWnd; begin {$IFDEF MSWINDOWS} if (eoDropFiles in FOptions) and not (csDesigning in ComponentState) then DragAcceptFiles(Handle, FALSE); {$ENDIF} inherited; end; procedure TKCustomHexEditor.DoChange; begin if Assigned(FOnChange) then FOnChange(Self); end; function TKCustomHexEditor.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; const WHEEL_DIVISOR = 120; var LinesToScroll, WheelClicks: Integer; begin Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos); if not Result then begin if ssCtrl in Shift then LinesToScroll := GetModifiedClientRect.Bottom div FCharHeight else LinesToScroll := 3; Inc(FMouseWheelAccumulator, WheelDelta); WheelClicks := FMouseWheelAccumulator div WHEEL_DIVISOR; FMouseWheelAccumulator := FMouseWheelAccumulator mod WHEEL_DIVISOR; ScrollBy(0, - WheelClicks * LinesToScroll, True); Result := True; end; end; procedure TKCustomHexEditor.EditAreaChanged; begin if FEditArea = eaNone then FEditArea := eaDigits; if not (edAddress in FDrawStyles) and (FEditArea = eaAddress) then FEditArea := eaDigits; if not (edDigits in FDrawStyles) and (FEditArea = eaDigits) then FEditArea := eaText; if not (edText in FDrawStyles) and (FEditArea = eaText) then if edDigits in FDrawStyles then FEditArea := eaDigits else FEditArea := eaNone; end; procedure TKCustomHexEditor.EndUndoGroup; begin FUndoList.EndGroup; end; function TKCustomHexEditor.ExecuteCommand(Command: TKEditCommand; Data: Pointer): Boolean; var I, J, K, O, N, SLen: Integer; Count, Index, Size, StartIndex, EndIndex: Int64; B: Byte; CanInsert, MoreBytes, Found, MatchCase: Boolean; C1, C2, C3: AnsiChar; S, S_FirstChar, S_LastChar, T: AnsiString; P: TKPoint64; Area: TKHexEditorArea; L, OldSelStart, OldSelEnd, Sel1, Sel2: TKHexEditorSelection; PChI, PChI_First, PChI_Next: PKHexEditorChangeItem; PSD: PKEditSearchData; ReplaceAction: TKEditReplaceAction; {$IFNDEF FPC} BA: PBytes; H: THandle; {$ENDIF} begin Result := False; if CommandEnabled(Command) then begin Result := True; L := SelLength; OldSelEnd := FSelEnd; OldSelStart := FSelStart; case Command of ecLeft..ecSelGotoXY: AddUndoCaretPos(False); end; case Command of ecLeft, ecSelLeft: begin InternalMoveLeft; SelectionChanged(Command <> ecSelLeft); end; ecRight, ecSelRight: begin InternalMoveRight; SelectionChanged(Command <> ecSelRight); end; ecUp, ecSelUp: begin Dec(FSelEnd.Index, FLineSize); SelectionChanged(Command <> ecSelUp); end; ecDown, ecSelDown: begin Inc(FSelEnd.Index, FLineSize); SelectionChanged(Command <> ecSelDown); end; ecLineStart, ecSelLineStart: begin FSelEnd := MakeSelection((FSelEnd.Index div FLineSize) * FLineSize, 0); SelectionChanged(Command <> ecSelLineStart); end; ecLineEnd, ecSelLineEnd: begin FSelEnd := MakeSelection((FSelEnd.Index div FLineSize) * FLineSize + FLineSize - 1, cHexDigitCount - 1); SelectionChanged(Command <> ecSelLineEnd); end; ecPageUp, ecSelPageUp: begin Dec(FSelEnd.Index, Min(ClientHeight div FCharHeight, FSelEnd.Index div FLineSize) * FLineSize); SelectionChanged(Command <> ecSelPageUp); end; ecPageDown, ecSelPageDown: begin Inc(FSelEnd.Index, Min(ClientHeight div FCharHeight, (FSize - FSelEnd.Index) div FLineSize) * FLineSize); SelectionChanged(Command <> ecSelPageDown); end; ecPageLeft, ecSelPageLeft: begin Dec(FSelEnd.Index, Min(GetPageHorz, FSelEnd.Index mod FLineSize)); SelectionChanged(Command <> ecSelPageLeft); end; ecPageRight, ecSelPageRight: begin Inc(FSelEnd.Index, Min(GetPageHorz, FLineSize - 1 - FSelEnd.Index mod FLineSize)); SelectionChanged(Command <> ecSelPageRight); end; ecPageTop, ecSelPageTop: begin P := SelToPoint(MakeSelection(FSelEnd.Index, 0), FEditArea); Dec(FSelEnd.Index, P.Y div FCharHeight * FLineSize); SelectionChanged(Command <> ecSelPageTop); end; ecPageBottom, ecSelPageBottom: begin P := SelToPoint(MakeSelection(FSelEnd.Index, 0), FEditArea); Inc(FSelEnd.Index, ((ClientHeight - P.Y) div FCharHeight - 1) * FLineSize); SelectionChanged(Command <> ecSelPageBottom); end; ecEditorTop, ecSelEditorTop: begin FSelEnd := MakeSelection(0, 0); SelectionChanged(Command <> ecSelEditorTop); end; ecEditorBottom, ecSelEditorBottom: begin FSelEnd := MakeSelection(FSize, 0); SelectionChanged(Command <> ecSelEditorBottom); end; ecGotoXY, ecSelGotoXY: begin Sel1 := PointToSel(PKPoint64(Data)^, False, Area); if Area <> eaNone then begin FSelEnd := Sel1; FEditArea := Area; SelectionChanged(Command <> ecSelGotoXY); end else Result := False; end; // scroll commands ecScrollUp: begin if (FEditArea <> eaNone) and (SelToPoint(FSelEnd, FEditArea).Y >= GetModifiedClientRect.Bottom - FCharHeight) then begin ScrollBy(0, -1, False); Dec(FSelEnd.Index, FLineSize); SelectionChanged(True, False); Invalidate; end else ScrollBy(0, -1, True); end; ecScrollDown: begin if (FEditArea <> eaNone) and (SelToPoint(FSelEnd, FEditArea).Y <= GetModifiedClientRect.Top) then begin ScrollBy(0, 1, False); Inc(FSelEnd.Index, FLineSize); SelectionChanged(True, False); Invalidate; end else ScrollBy(0, 1, True); end; ecScrollLeft: begin if FEditArea <> eaNone then begin // overscroll check P := SelToPoint(MakeSelection(0, 0), FEditArea); if P.X < GetModifiedClientRect.Right - FCharWidth then begin ScrollBy(-1, 0, True); P := SelToPoint(FSelEnd, FEditArea); if (P.X >= GetModifiedClientRect.Right) and ((FSelEnd.Index mod FLineSize > 0) or (FSelEnd.Digit > 0)) then ExecuteCommand(ecLeft) end; end else ScrollBy(-1, 0, True); end; ecScrollRight: begin if FEditArea <> eaNone then begin // overscroll check P := SelToPoint(MakeSelection(FLineSize - 1, cHexDigitCount - 1), FEditArea); if P.X > 0 then begin ScrollBy(1, 0, True); P := SelToPoint(FSelEnd, FEditArea); if (P.X < 0) and ((FSelEnd.Index mod FLineSize < FLineSize - 1) or (FSelEnd.Digit < cHexDigitCount - 1)) then ExecuteCommand(ecRight) end; end else ScrollBy(1, 0, True); end; ecScrollCenter: begin P := SelToPoint(FSelEnd, FEditArea); I := (P.X - ClientWidth div 2) div FCharWidth; J := (P.Y - ClientHeight div 2) div FCharHeight; ScrollBy(I, J, True); end; // editing commands ecUndo: begin PChI := FUndoList.PeekItem; PChI_First := PChI; while PChI <> nil do begin Size := Length(PChI.Data); Count := Min(Size, FSize - PChI.SelEnd.Index); FRedoList.SetGroupData(PChI.Group, PChI.GroupReason); case PChI.ItemReason of crCaretPos: FRedoList.AddChange(crCaretPos, ''); crDeleteChar, crDeleteDigits, crDeleteString: begin if FBuffer <> nil then begin SetLength(S, Count); System.Move(FBuffer[PChI.SelEnd.Index], S[1], Count); end else S := ''; FRedoList.AddChange(OppositeReason(PChI.ItemReason), S, PChI.Inserted); end; crInsertChar, crInsertDigits, crInsertString: FRedoList.AddChange(OppositeReason(PChI.ItemReason), PChI.Data); end; FSelEnd := PChI.SelEnd; FSelStart := PChI.SelStart; FEditArea := PChI.EditArea; case PChI.ItemReason of crDeleteChar, crDeleteDigits, crDeleteString: begin if PChI.Inserted then ClearString(PChI.SelEnd.Index, Size) else if FBuffer <> nil then begin System.Move(PChI.Data[1], FBuffer[PChI.SelEnd.Index], Count); Invalidate; end; end; crInsertChar, crInsertDigits, crInsertString: InsertString(GetRealSelStart.Index, PChI.Data); end; EditAreaChanged; SelectionChanged(False, False); if PChI.ItemReason <> crCaretPos then DoChange; PChI_Next := FUndoList.PeekItem; if (PChI_Next <> nil) and not ((PChI.Group <> 0) and (PChI.Group = PChI_Next.Group) or (eoGroupUndo in FOptions) and (PChI_First.GroupReason = PChI_Next.GroupReason)) then begin FUndoList.PokeItem; Break; end; PChI := PChI_Next; end; if not CaretInView then ExecuteCommand(ecScrollCenter); end; ecRedo: begin PChI := FRedoList.PeekItem; PChI_First := PChI; while PChI <> nil do begin FUndoList.PokeItem; Size := Length(PChI.Data); Sel1 := GetRealSelStart; case PChI.ItemReason of crInsertChar, crInsertDigits, crInsertString: begin if PChI.Inserted then InsertString(Sel1.Index, PChI.Data) else if FBuffer <> nil then begin System.Move(PChI.Data[1], FBuffer[Sel1.Index], Min(Size, FSize - FSelEnd.Index)); Invalidate; end; end; crDeleteChar, crDeleteDigits, crDeleteString: ClearString(Sel1.Index, Size); end; FSelEnd := PChI.SelEnd; FSelStart := PChI.SelStart; FEditArea := PChI.EditArea; EditAreaChanged; SelectionChanged(False, False); if PChI.ItemReason <> crCaretPos then DoChange; PChI_Next := FRedoList.PeekItem; if (PChI_Next <> nil) and not ((PChI.Group <> 0) and (PChI.Group = PChI_Next.Group) or (eoGroupUndo in FOptions) and (PChI_First.GroupReason = PChI_Next.GroupReason)) then begin FRedoList.PokeItem; Break; end; PChI := PChI_Next; end; if not CaretInView then ExecuteCommand(ecScrollCenter); end; ecCopy: begin Sel1 := GetRealSelStart; Sel2 := GetRealSelEnd; {$IFDEF FPC} ClipBoard.AsText := string(BinaryToDigits(FBuffer, Sel1, Sel2)) {$ELSE} if FEditArea = eaDigits then ClipBoard.AsText := string(BinaryToDigits(FBuffer, Sel1, Sel2)) else if L.Index <> 0 then begin S := BinaryToText(FBuffer, Sel1.Index, Sel2.Index, @FCharMapping); H := GlobalAlloc(GMEM_MOVEABLE + GMEM_DDESHARE, L.Index); try BA := GlobalLock(H); try System.Move(FBuffer[Sel1.Index], BA^, L.Index); finally GlobalUnlock(H); end; ClipBoard.Open; try ClipBoard.SetAsHandle(FClipboardFormat, H); ClipBoard.AsText := string(S); finally ClipBoard.Close; end; except GlobalFree(H); end; end; {$ENDIF} end; ecCut: begin ExecuteCommand(ecCopy); ExecuteCommand(ecClearSelection); end; ecPaste: begin if L.Index > 0 then ExecuteCommand(ecClearSelection); if ClipBoard.FormatCount > 0 then begin S := ''; {$IFNDEF FPC} H := 0; // paste as binary data if ClipBoard.HasFormat(FClipboardFormat) then H := ClipBoard.GetAsHandle(FClipboardFormat) else {$ENDIF} if ClipBoard.HasFormat(CF_TEXT) then begin S := AnsiString(ClipBoard.AsText); if S <> '' then begin SLen := Length(S); if (FEditArea = eaDigits) and ExecuteCommand(ecInsertDigits, Pointer(S)) then begin S := ''; if SLen >= cHexDigitCount then begin Inc(FSelEnd.Index, SLen div cHexDigitCount) end else begin Inc(FSelEnd.Digit, SLen); if FSelEnd.Digit >= cHexDigitCount then begin Inc(FSelEnd.Index); FSelEnd.Digit := FSelEnd.Digit mod cHexDigitCount; end; end; SelectionChanged(True); end else ExecuteCommand(ecInsertString, Pointer(S)); end; end {$IFNDEF FPC} else H := ClipBoard.GetAsHandle(ClipBoard.Formats[0]); if H <> 0 then begin BA := GlobalLock(H); try I := GlobalSize(H); if I > 0 then begin SetLength(S, I); System.Move(BA^, S[1], I); end; finally GlobalUnlock(H); end; if S <> '' then ExecuteCommand(ecInsertString, Pointer(S)); end {$ENDIF} ; if S <> '' then begin Inc(FSelEnd.Index, Length(S)); FSelEnd.Digit := 0; SelectionChanged(True); end; end; end; ecInsertChar: begin BeginUndoGroup(crInsertChar); try N := PInteger(Data)^; if L.Index > 0 then ExecuteCommand(ecClearSelection); ValidateSelection(FSelEnd, FEditArea); if FBuffer <> nil then B := FBuffer[FSelEnd.Index] else B := 0; CanInsert := (FBuffer = nil) or (FSelEnd.Digit = 0) and (not (elOverwrite in FStates) or (FSelEnd.Index = FSize)); AddUndoByte(crDeleteChar, B, CanInsert); if CanInsert then InsertChar(FSelEnd.Index, 0) else Invalidate; case FEditArea of eaDigits: begin FBuffer[FSelEnd.Index] := ReplaceDigit(FBuffer[FSelEnd.Index], N, FSelEnd.Digit); InternalMoveRight; end; eaText: begin FBuffer[FSelEnd.Index] := Byte(N); InternalMoveRight; end; end; SelectionChanged(True); finally EndUndoGroup; end; end; ecInsertDigits: begin S := AnsiString(Data); if (S <> '') and DigitsToBinStr(S) then begin BeginUndoGroup(crInsertDigits); try if L.Index > 0 then ExecuteCommand(ecClearSelection); ValidateSelection(FSelEnd, FEditArea); MoreBytes := Length(S) >= cHexDigitCount; if MoreBytes then // we don't move digit positions of the remaining block SetLength(S, Length(S) div cHexDigitCount * cHexDigitCount); J := 0; if (FBuffer <> nil) and (not MoreBytes or (FSelEnd.Digit > 0)) then begin B := FBuffer[FSelEnd.Index]; S_FirstChar := AnsiChar(B); S_LastChar := S_FirstChar; // split current byte AddUndoByte(crInsertChar, B); ClearChar(FSelEnd.Index); N := Length(S); for I := FSelEnd.Digit to cHexDigitCount - 1 do begin if J < N then begin Inc(J); S_FirstChar := AnsiChar(ReplaceDigit(Ord(S_FirstChar[1]), Ord(S[J]), I)); end else Break; end; K := Length(S); if K > J then for I := FSelEnd.Digit - 1 downto 0 do begin if K > J then begin S_LastChar := AnsiChar(ReplaceDigit(Ord(S_LastChar[1]), Ord(S[K]), I)); Dec(K); end else Break; end else S_LastChar := ''; O := cHexDigitCount; end else begin S_FirstChar := ''; S_LastChar := ''; O := 0; end; T := ''; if MoreBytes then begin N := Length(S) - O; O := J; for I := 0 to N div cHexDigitCount - 1 do begin K := 0; for J := 1 to cHexDigitCount do begin K := K * cHexBase; Inc(K, Ord(S[I * 2 + J + O])); end; T := AnsiString(Format('%s%s', [T, AnsiChar(K)])); end; end; S := S_FirstChar + T + S_LastChar; // always insert (don't overwrite) AddUndoString(crDeleteDigits, S); InsertString(FSelEnd.Index, S); SelectionChanged(True); finally EndUndoGroup; end; end else Result := False; end; ecInsertString: begin S := AnsiString(Data); if S <> '' then begin BeginUndoGroup(crInsertString); try if L.Index > 0 then ExecuteCommand(ecClearIndexSelection); // always insert (don't overwrite) AddUndoString(crDeleteString, S); InsertString(FSelEnd.Index, S); SelectionChanged(True); finally EndUndoGroup; end; end else Result := False; end; ecDeleteLastChar: begin if L.Index <> 0 then ExecuteCommand(ecClearSelection) else begin BeginUndoGroup(crDeleteString); try AddUndoCaretPos; FSelStart.Index := FSelEnd.Index - 1; ExecuteCommand(ecClearIndexSelection) finally EndUndoGroup; end; end; end; ecDeleteChar: begin if L.Index <> 0 then ExecuteCommand(ecClearSelection) else begin BeginUndoGroup(crDeleteString); try AddUndoCaretPos; FSelStart.Index := FSelEnd.Index + 1; ExecuteCommand(ecClearIndexSelection) finally EndUndoGroup; end; end; end; ecDeleteBOL: begin if L.Index <> 0 then ExecuteCommand(ecClearSelection) else begin BeginUndoGroup(crDeleteString); try AddUndoCaretPos; FSelStart.Index := (FSelEnd.Index div FLineSize) * FLineSize; ExecuteCommand(ecClearIndexSelection) finally EndUndoGroup; end; end; end; ecDeleteEOL: begin if L.Index <> 0 then ExecuteCommand(ecClearSelection) else begin BeginUndoGroup(crDeleteString); try AddUndoCaretPos; FSelStart.Index := Min((FSelEnd.Index div FLineSize + 1) * FLineSize, FSize); ExecuteCommand(ecClearIndexSelection) finally EndUndoGroup; end; end; end; ecDeleteLine: begin if L.Index <> 0 then ExecuteCommand(ecClearSelection) else begin BeginUndoGroup(crDeleteString); try AddUndoCaretPos; FSelStart.Index := (FSelEnd.Index div FLineSize) * FLineSize; FSelEnd.Index := Min(FSelStart.Index + FLineSize, FSize); ExecuteCommand(ecClearIndexSelection) finally EndUndoGroup; end; end; end; ecSelectAll: begin AddUndoCaretPos; FSelStart := MakeSelection(0, 0); FSelEnd := MakeSelection(FSize, 0); SelectionChanged(False); end; ecClearAll: begin ExecuteCommand(ecSelectAll); ExecuteCommand(ecClearIndexSelection); end; ecClearIndexSelection: begin Index := GetRealSelStart.Index; AddUndoBytes(crInsertString, PBytes(@FBuffer[Index]), L.Index, True); ClearString(Index, L.Index); FSelEnd := MakeSelection(Index, 0); SelectionChanged(True); end; ecClearSelection: begin Sel1 := GetRealSelStart; Sel2 := GetRealSelEnd; if (Sel1.Digit > 0) {and (Sel1.Digit + Sel2.Digit = cHexDigitCount) }then begin BeginUndoGroup(crDeleteDigits); try // digit clear mode AddUndoCaretPos; FSelEnd := MakeSelection(Sel1.Index + 1, 0); FSelStart := FSelEnd; if Sel2.Digit = 0 then begin Dec(L.Index); N := FBuffer[Sel2.Index - 1]; end else N := FBuffer[Sel2.Index]; AddUndoBytes(crInsertDigits, PBytes(@FBuffer[FSelEnd.Index]), L.Index, True); ClearString(FSelEnd.Index, L.Index); FSelEnd := Sel1; AddUndoByte(crDeleteChar, FBuffer[Sel1.Index], False); for I := Sel1.Digit to cHexDigitCount - 1 do begin FBuffer[Sel1.Index] := ReplaceDigit(FBuffer[Sel1.Index], N mod cHexBase, I); N := N div cHexBase; end; SelectionChanged(True); finally EndUndoGroup; end; end else ExecuteCommand(ecClearIndexSelection); end; ecSearch, ecReplace: begin // doesn't search for single digits PSD := Data; if PSD <> nil then begin PSD.ErrorReason := eseOk; S := AnsiString(PSD.TextToFind); if Command = ecReplace then begin T := AnsiString(PSD.TextToReplace); ReplaceAction := eraYes; end; if esoSelectedOnly in PSD.Options then if esoFirstSearch in PSD.Options then begin PSD.SelStart := GetRealSelStart.Index; PSD.SelEnd := GetRealSelEnd.Index; end else begin PSD.SelStart := MinMax(PSD.SelStart, 0, FSize); PSD.SelEnd := MinMax(PSD.SelEnd, 0, FSize); end; if esoFirstSearch in PSD.Options then Exclude(PSD.Options, esoWereDigits); if esoTreatAsDigits in PSD.Options then begin if DigitsToBinStr(S) then begin S := BinStrToBinary(S); if Command = ecReplace then begin if DigitsToBinStr(T) then begin T := BinStrToBinary(T); PSD.TextToFind := string(S); PSD.TextToReplace := string(T); Exclude(PSD.Options, esoTreatAsDigits); Include(PSD.Options, esoWereDigits); end else PSD.ErrorReason := eseNoDigitsReplace; end else begin PSD.TextToFind := string(S); Exclude(PSD.Options, esoTreatAsDigits); Include(PSD.Options, esoWereDigits); end; end else PSD.ErrorReason := eseNoDigitsFind; end; if PSD.ErrorReason = eseOk then begin SLen := Length(S); if esoBackwards in PSD.Options then begin O := -1; if (esoEntireScope in PSD.Options) and (esoFirstSearch in PSD.Options) then StartIndex := FSize else StartIndex := GetRealSelStart.Index - 1; if esoSelectedOnly in PSD.Options then begin EndIndex := PSD.SelStart; if esoFirstSearch in PSD.Options then StartIndex := PSD.SelEnd end else EndIndex := 0; StartIndex := Min(StartIndex, FSize - SLen + 1); if StartIndex < EndIndex then PSD.ErrorReason := eseNoMatch end else begin O := 1; if (esoEntireScope in PSD.Options) and (esoFirstSearch in PSD.Options) then StartIndex := 0 else StartIndex := GetRealSelEnd.Index; if esoSelectedOnly in PSD.Options then begin EndIndex := PSD.SelEnd; if esoFirstSearch in PSD.Options then StartIndex := PSD.SelStart end else EndIndex := FSize; EndIndex := Min(EndIndex, FSize - SLen + 1); if StartIndex >= EndIndex then PSD.ErrorReason := eseNoMatch end; if PSD.ErrorReason = eseOk then begin Found := False; MatchCase := PSD.Options * [esoMatchCase, esoWereDigits] <> []; if MatchCase then C1 := S[1] else C1 := UpCase(S[1]); StartIndex := MinMax(StartIndex, 0, FSize - 1); while StartIndex <> EndIndex do begin if MatchCase then C2 := AnsiChar(FBuffer[StartIndex]) else C2 := UpCase(AnsiChar(FBuffer[StartIndex])); if C1 = C2 then begin if FSize - StartIndex >= SLen then begin J := 2; Dec(StartIndex); while (J <= SLen) do begin if MatchCase then begin C2 := AnsiChar(FBuffer[StartIndex + J]); C3 := S[J]; end else begin C2 := Upcase(AnsiChar(FBuffer[StartIndex + J])); C3 := Upcase(S[J]); end; if C2 = C3 then Inc(J) else Break; end; Inc(StartIndex); if J = SLen + 1 then begin Found := True; FSelStart := MakeSelection(StartIndex, 0); FSelEnd := MakeSelection(StartIndex + SLen, 0); if Command = ecReplace then begin if (esoPrompt in PSD.Options) and Assigned(FOnReplaceText) then begin SelectionChanged(False, False); if not CaretInView then ExecuteCommand(ecScrollCenter); FOnReplaceText(Self, string(S), string(T), ReplaceAction) end else ReplaceAction := eraYes; case ReplaceAction of eraCancel: Break; eraYes, eraAll: begin if T = '' then ExecuteCommand(ecClearIndexSelection) else ExecuteCommand(ecInsertString, Pointer(T)); FSelEnd := MakeSelection(StartIndex + Length(T), 0); AddUndoCaretPos; if ReplaceAction = eraAll then Include(PSD.Options, esoAll); end; end; if not (esoAll in PSD.Options) then Break; end else Break; end end; end; Inc(StartIndex, O); end; if Found then begin SelectionChanged(False, False); if not CaretInView then ExecuteCommand(ecScrollCenter); end else PSD.ErrorReason := eseNoMatch; end; end; Exclude(PSD.Options, esoFirstSearch); end else Result := False; end; ecInsertMode: begin Exclude(FStates, elOverwrite); UpdateEditorCaret(True); end; ecOverwriteMode: begin Include(FStates, elOverwrite); UpdateEditorCaret(True); end; ecToggleMode: begin if elOverwrite in FStates then Exclude(FStates, elOverwrite) else Include(FStates, elOverwrite); UpdateEditorCaret(True); end; // focus change ecGotFocus, ecLostFocus: begin UpdateEditorCaret; Invalidate; end; end; if (OldSelStart.Index <> OldSelEnd.Index) or (FSelStart.Index <> FSelEnd.Index) or (OldSelStart.Digit <> OldSelEnd.Digit) or (FSelStart.Digit <> FSelEnd.Digit) or not (elCaretVisible in FStates) and (edInactiveCaret in FDrawStyles) and ((FSelStart.Index <> OldSelStart.Index) or (FSelStart.Digit <> OldSelStart.Digit) or (FSelEnd.Index <> OldSelEnd.Index) or (FSelEnd.Digit <> OldSelEnd.Digit)) then Invalidate; end; end; procedure TKCustomHexEditor.FontChange(Sender: TObject); begin if not (csDestroying in ComponentState) then begin Font.Pitch := fpFixed; if Font.Size >= 0 then Font.Size := MinMax(Font.Size, cFontSizeMin, cFontSizeMax); UpdateCharMetrics; UpdateScrollRange; end; end; function TKCustomHexEditor.GetAreaDimensions: TKHexEditorAreaDimensions; begin FillChar(Result, SizeOf(Result), 0); with Result do begin if edAddress in FDrawStyles then begin Address := Length(FAddressPrefix) + FAddressSize; if FDrawStyles * [edDigits, edText] <> [] then AddressOut := FAreaSpacing; end; if edDigits in FDrawStyles then begin Digits := FLineSize * cHexDigitCount + FLineSize div FDigitGrouping; if FLineSize mod FDigitGrouping = 0 then Dec(Digits); if edAddress in FDrawStyles then DigitsIn := FAreaSpacing; if edText in FDrawStyles then DigitsOut := FAreaSpacing; end; if edText in FDrawStyles then begin Text := FLineSize; if FDrawStyles * [edAddress, edDigits] <> [] then TextIn := FAreaSpacing; end; TotalHorz := Address + AddressOut + Digits + DigitsIn + DigitsOut + Text + TextIn; if [edAddress, edDigits, edText] * FDrawStyles <> [] then TotalVert := LineCount else TotalVert := 0; end; end; function TKCustomHexEditor.GetCaretVisible: Boolean; begin Result := elCaretVisible in FStates; end; function TKCustomHexEditor.GetCharMapping: TKEditCharMapping; begin Result := FCharMapping; end; function TKCustomHexEditor.GetClientHeightChars: Integer; begin Result := ClientHeight div FCharHeight; end; function TKCustomHexEditor.GetClientWidthChars: Integer; begin Result := ClientWidth div FCharWidth; end; function TKCustomHexEditor.GetCommandKey(Index: TKEditCommand): TKEditKey; begin Result := FKeyMapping.Key[Index]; end; function TKCustomHexEditor.GetData: TDataSize; begin Result.Data := FBuffer; Result.Size := FSize; end; function TKCustomHexEditor.GetEmpty: Boolean; begin Result := FBuffer = nil; end; function TKCustomHexEditor.GetFirstVisibleIndex: Integer; begin Result := PointToSel(CreateEmptyPoint64, False, FEditArea).Index; end; function TKCustomHexEditor.GetInsertMode: Boolean; begin Result := not (elOverwrite in FStates); end; function TKCustomHexEditor.GetLastVisibleIndex: Integer; begin Result := PointToSel(PointToPoint64(GetModifiedClientRect.BottomRight), False, FEditArea).Index; end; function TKCustomHexEditor.GetLineCount: Int64; begin Result := DivUp64(FSize + 1, FLineSize); end; function TKCustomHexEditor.GetLines(Index: Int64): TDataSize; var I: Int64; begin I := Index * FLineSize; if (FBuffer <> nil) and (I >= 0) and (I < FSize) then begin Result.Data := @FBuffer[I]; Result.Size := Min(FLineSize, FSize - I); end else begin Result.Data := nil; Result.Size := 0; end; end; function TKCustomHexEditor.GetModified: Boolean; begin Result := (elModified in FStates) or FUndoList.Modified; end; function TKCustomHexEditor.GetModifiedClientRect: TRect; begin Result := Rect(0, 0, GetClientWidthChars * FCharWidth, GetClientHeightChars * FCharHeight); end; function TKCustomHexEditor.GetMaxLeftChar(Extent: Integer): Integer; begin if Extent <= 0 then Extent := GetAreaDimensions.TotalHorz; Result := Max(Extent - GetClientWidthChars, 0); end; function TKCustomHexEditor.GetMaxTopLine(Extent: Int64): Int64; begin if Extent <= 0 then Extent := GetAreaDimensions.TotalVert; Result := Max(Extent - GetClientHeightChars, 0); end; function TKCustomHexEditor.GetPageHorz: Integer; begin case FEditArea of eaDigits: Result := ClientWidth * FDigitgrouping div (FCharWidth * (cHexDigitCount * FDigitGrouping + 1)); eaText: Result := ClientWidth div FCharWidth; else Result := 0; end; end; function TKCustomHexEditor.GetReadOnly: Boolean; begin Result := elReadOnly in FStates; end; function TKCustomHexEditor.GetRealSelEnd: TKHexEditorSelection; begin if FSelStart.Index <= FSelEnd.Index then Result := FSelEnd else Result := FSelStart; end; function TKCustomHexEditor.GetRealSelStart: TKHexEditorSelection; begin if FSelStart.Index <= FSelEnd.Index then Result := FSelStart else Result := FSelEnd; end; function TKCustomHexEditor.GetSelLength: TKHexEditorSelection; begin if FSelStart.Index <= FSelEnd.Index then Result.Index := FSelEnd.Index - FSelStart.Index else Result.Index := FSelStart.Index - FSelEnd.Index; if FSelStart.Digit <= FSelEnd.Digit then Result.Digit := FSelEnd.Digit - FSelStart.Digit else Result.Digit := FSelStart.Digit - FSelEnd.Digit; end; function TKCustomHexEditor.GetSelText: TKHexEditorSelText; var L, Sel1, Sel2: TKHexEditorSelection; begin L := SelLength; with Result do begin if L.Index > 0 then begin Sel1 := GetRealSelStart; Sel2 := GetRealSelEnd; AsBinaryRaw := BinaryToText(FBuffer, Sel1.Index, Sel2.Index, nil); AsBinaryMapped := BinaryToText(FBuffer, Sel1.Index, Sel2.Index, @FCharMapping); AsDigits := BinaryToDigits(FBuffer, Sel1, Sel2); Sel1.Digit := 0; Sel2.Digit := 0; AsDigitsByteAligned := BinaryToDigits(FBuffer, Sel1, Sel2); end else begin AsBinaryRaw := ''; AsBinaryMapped := ''; AsDigits := ''; AsDigitsByteAligned := ''; end; end; end; function TKCustomHexEditor.GetUndoLimit: Integer; begin Result := FUndoList.Limit; end; function TKCustomHexEditor.HasFocus: Boolean; var Form: TCustomForm; begin Form := GetParentForm(Self); if (Form <> nil) and Form.Visible and Form.Enabled and Form.Active then Result := (Form.ActiveControl = Self) else Result := False; end; procedure TKCustomHexEditor.HideEditorCaret; {var P: TPoint;} begin if HandleAllocated then //P := SelToPoint(FSelEnd, FEditArea); HideCaret(Handle); //{$IFDEF FPC}SetCaretPosEx(Handle,{$ELSE}SetCaretPos({$ENDIF} P.X, P.Y + 1); end; procedure TKCustomHexEditor.InsertChar(At: Int64; Value: Byte); begin InsertString(At, MakeDataSize(@Value, SizeOf(Value))); end; procedure TKCustomHexEditor.InsertString(At: Int64; const Value: TDataSize); begin if (At >= 0) and (At <= FSize) and (Value.Size > 0) then begin Inc(FSize, Value.Size); ReallocMem(FBuffer, FSize); if At < FSize - Value.Size then Move(FBuffer[At], FBuffer[At + Value.Size], (FSize - At - Value.Size) * SizeOf(Byte)); Move(Value.Data^, FBuffer[At], Value.Size); UpdateScrollRange; end; end; procedure TKCustomHexEditor.InsertString(At: Int64; const Value: AnsiString); begin if length(Value) > 0 then InsertString(At, MakeDataSize(@Value[1], Length(Value))); end; function TKCustomHexEditor.InternalGetSelAvail: Boolean; begin Result := SelAvail; end; procedure TKCustomHexEditor.InternalMoveLeft; begin if FEditArea = eaDigits then begin if FSelEnd.Digit > 0 then Dec(FSelEnd.Digit) else if FSelEnd.Index > 0 then begin FSelEnd.Digit := cHexDigitCount - 1; Dec(FSelEnd.Index); end end else Dec(FSelEnd.Index); end; procedure TKCustomHexEditor.InternalMoveRight; begin if FEditArea = eaDigits then begin if (FSelEnd.Index < FSize) and (FSelEnd.Digit < cHexDigitCount - 1) then Inc(FSelEnd.Digit) else begin FSelEnd.Digit := 0; Inc(FSelEnd.Index); end end else Inc(FSelEnd.Index); end; function TKCustomHexEditor.IsAddressPrefixStored: Boolean; begin Result := FAddressPrefix <> '0x'; end; function TKCustomHexEditor.IsDrawStylesStored: Boolean; begin Result := FDrawStyles <> cDrawStylesDef; end; function TKCustomHexEditor.IsOptionsStored: Boolean; begin Result := FOptions <> [eoGroupUndo]; end; procedure TKCustomHexEditor.KeyDown(var Key: Word; Shift: TShiftState); var Cmd: TKEditCommand; begin inherited; Exclude(FStates, elIgnoreNextChar); if not (csDesigning in ComponentState) then begin Cmd := FKeyMapping.FindCommand(Key, Shift); if Cmd <> ecNone then begin ExecuteCommand(Cmd); Key := 0; Include(FStates, elIgnoreNextChar); end; if Key = VK_ESCAPE then Include(FStates, elIgnoreNextChar); end; end; procedure TKCustomHexEditor.KeyPress(var Key: Char); var I: Integer; begin inherited; if not (csDesigning in ComponentState) then begin if not (elIgnoreNextChar in FStates) then begin case FEditArea of eaDigits: I := DigitToBin(AnsiChar(Key)); {$IFDEF UNICODE} eaText: begin I := 0; WideCharToMultiByte(DefaultSystemCodePage, 0, @Key, 1, @I, 1, nil, nil); end; {$ELSE} eaText: I := Ord(Key); {$ENDIF} else I := -1; end; if I >= 0 then ExecuteCommand(ecInsertChar, @I); end else Exclude(FStates, elIgnoreNextChar); end; end; procedure TKCustomHexEditor.LateUpdate(var Msg: TLMessage); begin inherited; case Msg.Msg of KM_SCROLL: UpdateScrollRange; end; end; procedure TKCustomHexEditor.LoadFromFile(const FileName: TFileName); var Stream: TFileStream; begin Stream := TFileStream.Create(FileName, fmOpenRead); try LoadFromStream(Stream); finally Stream.Free; end; end; procedure TKCustomHexEditor.LoadFromStream(Stream: TStream); var I, Size: Int64; begin Size := Stream.Size - Stream.Position; if Size > 0 then begin Clear; FSize := Size; GetMem(FBuffer, FSize); // unable to read big file at once, so do it stepwise I := 0; while Size > 0 do begin Stream.Read(FBuffer[I], Min(Size, cIOChunkSize)); Inc(I, cIOChunkSize); Dec(Size, cIOChunkSize); end; BufferChanged; end; end; procedure TKCustomHexEditor.MeasurePages(var Info: TKPrintMeasureInfo); var AD: TKHexEditorAreaDimensions; PageLines, ActiveLines: Integer; FitToPage, SelOnly: Boolean; Scale: Double; APageSetup: TKPrintPageSetup; begin APageSetup := PageSetup; FitToPage := poFitToPage in APageSetup.Options; SelOnly := APageSetup.Range = prSelectedOnly; Scale := APageSetup.Scale / 100; AD := GetAreaDimensions; Info.OutlineWidth := AD.TotalHorz * FCharWidth; if FitToPage then Scale := APageSetup.MappedControlPaintAreaWidth / Info.OutlineWidth; PageLines := Round(APageSetup.MappedPaintAreaHeight / Scale) div FCharHeight; if SelOnly then ActiveLines := DivUp64(GetRealSelEnd.Index, FLineSize) - GetRealSelStart.Index div FLineSize else ActiveLines := LineCount; Info.OutlineHeight := PageLines * FCharHeight; Info.ControlHorzPageCount := 1; // cut text off Info.ControlVertPageCount := DivUp(ActiveLines, PageLines); end; procedure TKCustomHexEditor.ModifyScrollBar(ScrollBar, ScrollCode, Delta: Integer; UpdateNeeded: Boolean); var I, J, K: Integer; HasScrollBar: Boolean; SI: TScrollInfo; begin HasScrollBar := (ScrollBar = SB_HORZ) and (ScrollBars = ssHorizontal) or (ScrollBar = SB_VERT) and (ScrollBars = ssVertical) or (ScrollBars = ssBoth); if HasScrollBar then begin FillChar(SI, SizeOf(TScrollInfo), 0); SI.cbSize := SizeOf(TScrollInfo); SI.fMask := SIF_PAGE or SIF_TRACKPOS; GetScrollInfo(Handle, ScrollBar, SI); {$IFDEF UNIX} SI.nTrackPos := Delta; {$ENDIF} end; if ScrollBar = SB_HORZ then begin I := FLeftChar; J := GetMaxLeftChar; end else begin I := FTopLine; J := GetMaxTopLine; end; K := I; case ScrollCode of SB_LINEUP: Dec(I); SB_LINEDOWN: Inc(I); SB_PAGEUP: Dec(I, SI.nPage); SB_PAGEDOWN: Inc(I, SI.nPage); SB_THUMBTRACK, SB_THUMBPOSITION: I := SI.nTrackPos; cScrollDelta: Inc(I, Delta); end; I := MinMax(I, 0, J); if K <> I then begin if HasScrollBar then begin FillChar(SI, SizeOf(TScrollInfo), 0); SI.nPos := I; SI.fMask := SIF_POS; SetScrollInfo(Handle, ScrollBar, SI, True); end; if ScrollBar = SB_HORZ then FLeftChar := I else FTopLine := I; if UpdateNeeded then begin UpdateEditorCaret; Invalidate; end; end; end; procedure TKCustomHexEditor.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var P: TKPoint64; Command: TKEditCommand; begin inherited; if Enabled and (Button = mbLeft) and not (ssDouble in Shift) then begin SafeSetFocus; P := Point64(X, Y); if ssShift in Shift then Command := ecSelGotoXY else Command := ecGotoXY; if ExecuteCommand(Command, @P) then Include(FStates, elMouseCapture); end; end; procedure TKCustomHexEditor.MouseMove(Shift: TShiftState; X, Y: Integer); var P: TKPoint64; R: TRect; begin inherited; if (elMouseCapture in FStates) then begin P := Point64(X, Y); R := GetModifiedClientRect; if Pt64InRect(R, P) then UpdateSelEnd(P, False) else if not FScrollTimer.Enabled then ScrollTo(P, True, False); end; end; procedure TKCustomHexEditor.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; Exclude(FStates, elMouseCapture); end; procedure TKCustomHexEditor.PaintLines(const Data: TKHexEditorPaintData); var HalfPosWidth, I, J, K, M, MaxAddress, WHorz, WVert, WSep: Integer; Index, L, LineIndex, Addr: Int64; LeftIndent, VTextIndent: Integer; BC1, BC2, FC1, FC2, PC1: TColor; EditorFocused, DrawInactiveCaret, DrawNormal, DigitSep, SelCondition: Boolean; S: AnsiString; Fmt: string; C: AnsiChar; R, R1, RClip: TRect; OldColorScheme: TKColorScheme; ASelStart, ASelEnd: TKHexEditorSelection; AD: TKHexEditorAreaDimensions; begin { this function must be reentrant because of print function so there is necessary to backup all changes to global properties} OldColorScheme := FColors.ColorScheme; with Data.Canvas do try R := Data.PaintRect; AD := GetAreaDimensions; // add possible inter-character spacing (in Lazarus not fully implemented yet) SetTextCharacterExtra(Handle, Data.CharSpacing); LeftIndent := R.Left - Data.LeftChar * Data.CharWidth; VTextIndent := (Data.CharHeight - Abs(Font.Height)) div 2; HalfPosWidth := Data.CharWidth div 2; Fmt := ''; MaxAddress := 0; L := LineCount; DrawInactiveCaret := not (Data.Printing or Data.CaretShown) and (edInactiveCaret in FDrawStyles); DrawNormal := not Data.Printing; EditorFocused := HasFocus; if FSelStart.Index <= FSelEnd.Index then begin ASelStart := FSelStart; ASelEnd := FSelEnd; end else begin ASelStart := FSelEnd; ASelEnd := FSelStart; end; // preserve space for lines and separators if edHorzLines in FDrawStyles then WVert := Max(1, Data.CharHeight div 25) else WVert := 0; if edVertLines in FDrawStyles then WHorz := Max(1, Data.CharWidth div 20) else WHorz := 0; if edSeparators in FDrawStyles then WSep := Max(1, Data.CharWidth div 20) else WSep := 0; // address area pre-comp if edAddress in FDrawStyles then begin if FAddressMode = eamDec then begin C := 'd'; J := 10; end else begin C := 'x'; J := 16; end; Fmt := Format('%s%%.%d%s', [FAddressPrefix, FAddressSize, C]); MaxAddress := 1; for I := 1 to FAddressSize do MaxAddress := MaxAddress * J; end; // update color scheme if Data.Printing then begin if Data.PaintColors then FColors.ColorScheme := csNormal else FColors.ColorScheme := csGrayScale; end else begin if Enabled or (FDisabledDrawStyle = eddNormal) then FColors.ColorScheme := csNormal else if FDisabledDrawStyle = eddGrayed then FColors.ColorScheme := csGrayed else FColors.ColorScheme := csBright end; FColors.SingleBkGnd := edSingleBkGnd in FDrawStyles; // get clip box for updating; if Data.Printing then RClip := R else GetClipBox(Handle, {$IFDEF FPC}@{$ENDIF}RClip); // now paint text lines LineIndex := Data.TopLine; while LineIndex <= Min(L - 1, Data.BottomLine) do begin Brush.Style := bsSolid; K := LeftIndent; R.Bottom := R.Top + Data.CharHeight - WVert; if (R.Top <= RClip.Bottom) and (R.Bottom >= RClip.Top) then begin if edAddress in FDrawStyles then begin Index := LineIndex * FLineSize; Brush.Color := clRed; if (DrawNormal or Data.PaintSelection) and ((ASelStart.Index <> ASelEnd.Index) or (ASelStart.Digit <> ASelEnd.Digit)) and (Index + FLineSize - 1 >= ASelStart.Index) and (Index < ASelEnd.Index) then begin PC1 := FColors.LinesHighLight; if (FEditArea = eaAddress) and (EditorFocused or Data.PaintSelection) then begin FC1 := FColors.SelTextFocused; BC1 := FColors.SelBkGndFocused; end else begin FC1 := FColors.SelText; BC1 := FColors.SelBkGnd; end; end else begin PC1 := FColors.HorzLines; FC1 := FColors.AddressText; BC1 := FColors.AddressBkGnd; end; Brush.Color := BC1; Font.Color := FC1; R.Left := K; Inc(K, AD.Address * Data.CharWidth); R.Right := K; Addr := LineIndex * FLineSize + FAddressOffset; if MaxAddress <> 0 then Addr := Addr mod MaxAddress; FillRect(R); TextOut(R.Left, R.Top + VTextIndent, Format(Fmt, [Addr])); if edHorzLines in FDrawStyles then begin Brush.Color := PC1; FillRect(Rect(R.Left, R.Bottom, R.Right, R.Bottom + WVert)); end; if AD.AddressOut > 0 then begin R.Left := K; Inc(K, AD.AddressOut * Data.CharWidth); R.Right := K; Brush.Color := FColors.AddressBkGnd; FillRect(Rect(R.Left, R.Top, R.Right - WSep, R.Bottom)); if edHorzLines in FDrawStyles then begin Brush.Color := FColors.HorzLines; FillRect(Rect(R.Left, R.Bottom, R.Right - WSep, R.Bottom + WVert)); end; end; end; if edDigits in FDrawStyles then begin if AD.DigitsIn > 0 then begin R.Left := K; Inc(K, AD.DigitsIn * Data.CharWidth); R.Right := K; Brush.Color := FColors.DigitBkGnd; FillRect(Rect(R.Left + WSep, R.Top, R.Right, R.Bottom)); if edHorzLines in FDrawStyles then begin Brush.Color := FColors.HorzLines; FillRect(Rect(R.Left + WSep, R.Bottom, R.Right, R.Bottom + WVert)); end; end; Index := 0; for J := 0 to FLineSize - 1 do begin Index := LineIndex * FLineSize + J; DigitSep := (J < FLineSize - 1) and ((J + 1) mod FDigitGrouping = 0); R.Left := K; Inc(K, cHexDigitCount * Data.CharWidth); R.Right := K; if Index <= FSize then begin if Index < FSize then S := AnsiString(Format(cHexFmtText, [FBuffer[Index]])) else S := ' '; if (Index <> FSelStart.Index) and (Index <> FSelEnd.Index) then begin SelCondition := (Index >= ASelStart.Index) and (Index < ASelEnd.Index); if (DrawNormal or Data.PaintSelection) and SelCondition then begin PC1 := FColors.LinesHighLight; if (FEditArea = eaDigits) and (EditorFocused or Data.PaintSelection) then begin FC1 := FColors.SelTextFocused; BC1 := FColors.SelBkGndFocused; end else begin FC1 := FColors.SelText; BC1 := FColors.SelBkGnd; end; FC2 := FColors.InactiveCaretSelText; BC2 := FColors.InactiveCaretSelBkGnd; end else begin PC1 := FColors.HorzLines; if DrawNormal or Data.PaintAll or SelCondition then begin if (J div FDigitGrouping) and 1 = 0 then FC1 := FColors.DigitTextEven else FC1 := FColors.DigitTextOdd; end else FC1 := FColors.DigitBkGnd; BC1 := FColors.DigitBkGnd; FC2 := FColors.InactiveCaretText; BC2 := FColors.InactiveCaretBkGnd; end; Brush.Color := BC1; Font.Color := FC1; Brush.Style := bsSolid; FillRect(R); Brush.Style := bsClear; TextOut(R.Left, R.Top + VTextIndent, string(AnsiChar(S[1]))); TextOut(R.Left + Data.CharWidth, R.Top + VTextIndent, string(AnsiChar(S[2]))); if (Index = FSelEnd.Index) and DrawInactiveCaret then begin // draw inactive caret - place into previous drawn text R1 := R; Inc(R1.Left, Data.CharWidth * Min(FSelEnd.Digit, cHexDigitCount - 1)); R1.Right := R1.Left + Data.CharWidth; Font.Color := FC2; Brush.Color := BC2; Brush.Style := bsSolid; FillRect(R1); Brush.Style := bsClear; TextOut(R1.Left, R1.Top + VTextIndent, string(S)); end; if edHorzLines in FDrawStyles then begin Brush.Color := PC1; Brush.Style := bsSolid; FillRect(Rect(R.Left, R.Bottom, R.Right, R.Bottom + WVert)); end; end else begin R1 := R; R1.Right := R1.Left; Inc(R1.Right, Data.CharWidth); for M := 0 to cHexDigitCount - 1 do begin SelCondition := (ASelStart.Index = ASelEnd.Index) and ( (M >= ASelStart.Digit) and (M < ASelEnd.Digit) or (M >= ASelEnd.Digit) and (M < ASelStart.Digit) ) or (ASelStart.Index <> ASelEnd.Index) and ( (Index = ASelStart.Index) and (M >= ASelStart.Digit) or (Index = ASelEnd.Index) and (M < ASelEnd.Digit) ); if (DrawNormal or Data.PaintSelection) and SelCondition then begin PC1 := FColors.LinesHighLight; if DrawInactiveCaret and (Index = FSelEnd.Index) and (M = FSelEnd.Digit) then begin FC1 := FColors.InactiveCaretSelText; BC1 := FColors.InactiveCaretSelBkGnd; end else if (FEditArea = eaDigits) and (EditorFocused or Data.PaintSelection) then begin FC1 := FColors.SelTextFocused; BC1 := FColors.SelBkGndFocused; end else begin FC1 := FColors.SelText; BC1 := FColors.SelBkGnd; end; end else begin PC1 := FColors.HorzLines; if DrawInactiveCaret and (Index = FSelEnd.Index) and (M = FSelEnd.Digit) then begin FC1 := FColors.InactiveCaretText; BC1 := FColors.InactiveCaretBkGnd; end else begin if DrawNormal or Data.PaintAll or SelCondition then begin if (J div FDigitGrouping) and 1 = 0 then FC1 := FColors.DigitTextEven else FC1 := FColors.DigitTextOdd; end else FC1 := FColors.DigitBkGnd; BC1 := FColors.DigitBkGnd; end; end; Brush.Color := BC1; Font.Color := FC1; Brush.Style := bsSolid; FillRect(R1); Brush.Style := bsClear; TextOut(R1.Left, R1.Top + VTextIndent, string(AnsiChar(S[M + 1]))); if edHorzLines in FDrawStyles then begin Brush.Color := PC1; Brush.Style := bsSolid; FillRect(Rect(R1.Left, R1.Bottom, R1.Right, R1.Bottom + WVert)); end; R1.Left := R1.Right; Inc(R1.Right, Data.CharWidth); end; end; if DigitSep then begin if Index < FSize then M := Data.CharWidth else M := HalfPosWidth; Brush.Color := FColors.DigitBkGnd; Brush.Style := bsSolid; FillRect(Rect(R.Right, R.Top, R.Right + Data.CharWidth, R.Bottom)); if edHorzLines in FDrawStyles then begin Brush.Color := FColors.HorzLines; FillRect(Rect(R.Right, R.Bottom, R.Right + M, R.Bottom + WVert)); end; if edVertLines in FDrawStyles then begin M := R.Right + HalfPosWidth; Brush.Color := FColors.VertLines; FillRect(Rect(M, R.Top, M + WHorz, R.Bottom)); end; Inc(K, Data.CharWidth); end; end else begin Inc(K, Integer(DigitSep) * Data.CharWidth); Brush.Color := FColors.DigitBkGnd; Brush.Style := bsSolid; FillRect(Rect(R.Left, R.Top, K, R.Bottom + WVert)); end; end; if AD.DigitsOut > 0 then begin R.Left := K; Inc(K, AD.DigitsOut * Data.CharWidth); R.Right := K; Brush.Style := bsSolid; Brush.Color := FColors.DigitBkGnd; FillRect(Rect(R.Left, R.Top, R.Right - WSep, R.Bottom)); if edHorzLines in FDrawStyles then begin if Index < FSize then Brush.Color := FColors.HorzLines else Brush.Color := FColors.DigitBkGnd; FillRect(Rect(R.Left, R.Bottom, R.Right - WSep, R.Bottom + WVert)); end; end; end; if edText in FDrawStyles then begin if AD.TextIn > 0 then begin R.Left := K; Inc(K, AD.TextIn * Data.CharWidth); R.Right := K; Brush.Color := FColors.TextBkGnd; Brush.Style := bsSolid; FillRect(Rect(R.Left + WSep, R.Top, R.Right, R.Bottom)); if edHorzLines in FDrawStyles then begin Brush.Color := FColors.HorzLines; FillRect(Rect(R.Left + WSep, R.Bottom, R.Right, R.Bottom + WVert)); end; end; for J := 0 to FLineSize - 1 do begin Index := LineIndex * FLineSize + J; R.Left := K; Inc(K, Data.CharWidth); R.Right := K; if Index <= FSize then begin SelCondition := (Index >= ASelStart.Index) and (Index < ASelEnd.Index); if (DrawNormal or Data.PaintSelection) and SelCondition then begin PC1 := FColors.LinesHighLight; if DrawInactiveCaret and (Index = FSelEnd.Index) then begin FC1 := FColors.InactiveCaretSelText; BC1 := FColors.InactiveCaretSelBkGnd; end else if (FEditArea = eaText) and (EditorFocused or Data.PaintSelection) then begin FC1 := FColors.SelTextFocused; BC1 := FColors.SelBkGndFocused; end else begin FC1 := FColors.SelText; BC1 := FColors.SelBkGnd; end; end else begin PC1 := FColors.HorzLines; if DrawInactiveCaret and (Index = FSelEnd.Index) then begin FC1 := FColors.InactiveCaretText; BC1 := FColors.InactiveCaretBkGnd; end else begin if DrawNormal or Data.PaintAll or SelCondition then FC1 := FColors.TextText else FC1 := FColors.TextBkgnd; BC1 := FColors.TextBkgnd; end; end; Brush.Color := BC1; Brush.Style := bsSolid; FillRect(R); Brush.Style := bsClear; if Index < FSize then begin Font.Color := FC1; TextOut(R.Left, R.Top + VTextIndent, string(AnsiChar(FCharMapping[FBuffer[Index]]))); end; if edHorzLines in FDrawStyles then begin Brush.Color := PC1; Brush.Style := bsSolid; FillRect(Rect(R.Left, R.Bottom, R.Right, R.Bottom + WVert)); end; end else begin Brush.Color := FColors.TextBkGnd; Brush.Style := bsSolid; FillRect(Rect(R.Left, R.Top, K, R.Bottom + WVert)); end; end; end; end; Inc(LineIndex); Inc(R.Top, Data.CharHeight); end; // now complete blank areas below text and optionally paint separators K := LeftIndent; R.Bottom := Data.PaintRect.Bottom; Brush.Style := bsSolid; if edAddress in FDrawStyles then begin R.Left := K; Inc(K, (AD.Address + AD.AddressOut) * Data.CharWidth); R.Right := K; if FDrawStyles * [edDigits, edText] <> [] then Dec(R.Right, WSep); if R.Top < R.Bottom then begin Brush.Color := FColors.AddressBkGnd; FillRect(R); end; if (edSeparators in FDrawStyles) and (FDrawStyles * [edDigits, edText] <> []) then begin Brush.Color := FColors.Separators; FillRect(Rect(K - WSep, Data.PaintRect.Top, K + WSep, Data.PaintRect.Bottom)); end; end; if edDigits in FDrawStyles then begin R.Left := K; if edAddress in FDrawStyles then Inc(R.Left, WSep); Inc(K, (AD.Digits + AD.DigitsIn + AD.DigitsOut) * Data.CharWidth); R.Right := K; if edText in FDrawStyles then Dec(R.Right, WSep); if R.Top < R.Bottom then begin Brush.Color := FColors.DigitBkGnd; FillRect(R); end; if (edSeparators in FDrawStyles) and (edText in FDrawStyles) then begin Brush.Color := FColors.Separators; FillRect(Rect(K - WSep, Data.PaintRect.Top, K + WSep, Data.PaintRect.Bottom)); end; end; if edText in FDrawStyles then begin R.Left := K; if FDrawStyles * [edAddress, edDigits] <> [] then Inc(R.Left, WSep); Inc(K, (AD.TextIn + AD.Text) * Data.CharWidth); R.Right := K; if R.Top < R.Bottom then begin Brush.Color := FColors.TextBkGnd; FillRect(R); end; end; if K < ClientWidth then begin Brush.Color := FColors.BkGnd; FillRect(Rect(K, 0, ClientWidth, ClientHeight)); end; finally FColors.ColorScheme := OldColorScheme; end; end; procedure TKCustomHexEditor.PaintPage; var ActiveLines, AreaWidth, AreaHeight, FirstLine, PageLines: Integer; SelOnly: Boolean; TmpRect, TmpRect1: TRect; APageSetup: TKPrintPageSetup; Data: TKHexEditorPaintData; begin APageSetup := PageSetup; SelOnly := APageSetup.Range = prSelectedOnly; AreaWidth := Round(APageSetup.MappedControlPaintAreaWidth / APageSetup.CurrentScale); AreaHeight := Round(APageSetup.MappedPaintAreaHeight / APageSetup.CurrentScale); PageLines := AreaHeight div FCharHeight; if SelOnly then begin FirstLine := GetRealSelStart.Index div FLineSize; ActiveLines := DivUp64(GetRealSelEnd.Index, FLineSize) - FirstLine; end else begin FirstLine := 0; ActiveLines := LineCount; end; TmpRect := Rect(0, 0, APageSetup.MappedOutlineWidth, APageSetup.MappedOutlineHeight); TmpRect1 := Rect(0, 0, AreaWidth, AreaHeight); IntersectRect(TmpRect, TmpRect, TmpRect1); TmpRect1 := TmpRect; TranslateRectToDevice(APageSetup.Canvas.Handle, TmpRect1); SelectClipRect(APageSetup.Canvas.Handle, TmpRect1); Data.Canvas := APageSetup.Canvas; Data.Canvas.Font := Font; Data.Canvas.Font.Height := Abs(Font.Height); Data.PaintRect := TmpRect; Data.TopLine := (APageSetup.CurrentPageControl - 1) * PageLines; Data.BottomLine := Min(Data.TopLine + PageLines, ActiveLines) - 1; Inc(Data.TopLine, FirstLine); Inc(Data.BottomLine, FirstLine); Data.LeftChar := 0; Data.CharWidth := FCharWidth; Data.CharHeight := FCharHeight; Data.CharSpacing := FTotalCharSpacing; Data.Printing := True; Data.PaintSelection := poPaintSelection in APageSetup.Options; Data.PaintAll := not SelOnly; Data.PaintColors := poUseColor in APageSetup.Options; PaintLines(Data); end; procedure TKCustomHexEditor.PaintToCanvas(ACanvas: TCanvas); var Data: TKHexEditorPaintData; begin ACanvas.Font := Font; with Data do begin Canvas := ACanvas; PaintRect := ClientRect; LeftChar := FLeftChar; TopLine := FTopLine; CharWidth := FCharWidth; CharHeight := FCharHeight; BottomLine := TopLine + ClientHeight div FCharHeight; CharSpacing := FTotalCharSpacing; Printing := False; PaintSelection := False; CaretShown := elCaretVisible in FStates; end; {$IFDEF FPC} if Data.CaretShown then HideEditorCaret; try {$ENDIF} PaintLines(Data); {$IFDEF FPC} finally if Data.CaretShown then ShowEditorCaret; end; {$ENDIF} end; procedure TKCustomHexEditor.PaintToCanvasEx(ACanvas: TCanvas; ARect: TRect; ALeftChar: Integer; ATopLine: Int64); var Data: TKHexEditorPaintData; Region: HRGN; begin ACanvas.Font := Font; with Data do begin Canvas := ACanvas; PaintRect := ARect; LeftChar := ALeftChar; TopLine := ATopLine; CharWidth := FCharWidth; CharHeight := FCharHeight; BottomLine := TopLine + (ARect.Bottom - ARect.Top) div FCharHeight; CharSpacing := FTotalCharSpacing; Printing := False; PaintSelection := False; end; Region := CreateRectRgnIndirect(ARect); try SelectClipRgn(ACanvas.Handle, Region); try PaintLines(Data); finally SelectClipRgn(ACanvas.Handle, 0); end; finally DeleteObject(Region); end; end; function TKCustomHexEditor.PointToSel(P: TKPoint64; OutOfArea: Boolean; var Area: TKHexEditorArea): TKHexEditorSelection; var Digit, HalfPosWidth, I, X, X1, XMax: Integer; DigitSep: Boolean; AD: TKHexEditorAreaDimensions; Sel: TKHexEditorSelection; begin Result := MakeSelection(cInvalidIndex, 0); P.X := P.X + FLeftChar * FCharWidth; P.Y := P.Y div FCharHeight + FTopLine; AD := GetAreaDimensions; HalfPosWidth := FCharWidth div 2; X := 0; if OutOfArea then P.Y := MinMax(P.Y, 0, LineCount - 1) else Area := eaNone; if P.Y < LineCount then begin if edAddress in FDrawStyles then begin XMax := X + (AD.Address + AD.AddressOut) * FCharWidth; if not OutOfArea or (Area = eaAddress) then if (P.X >= X) and (P.X < XMax) then begin Result := MakeSelection(P.Y * FLineSize, 0); Area := eaAddress; end else if Area = eaAddress then // OutOfArea = True begin Result.Index := P.Y * FLineSize; if P.X >= XMax then Inc(Result.Index, FLineSize); end; X := XMax; end; if (P.X >= X) or OutOfArea then begin if edDigits in FDrawStyles then begin XMax := X + (AD.Digits + AD.DigitsIn + AD.DigitsOut) * FCharWidth; if not OutOfArea or (Area = eaDigits) then if (P.X >= X) and (P.X < XMax) then begin Inc(X, AD.DigitsIn * FCharWidth); for I := 0 to FLineSize - 1 do begin DigitSep := (I < FLineSize - 1) and ((I + 1) mod FDigitGrouping = 0); X1 := X; Inc(X, cHexDigitCount * FCharWidth); if DigitSep then Inc(X, HalfPosWidth) else if I = FLineSize - 1 then Inc(X, AD.DigitsOut * FCharWidth); if P.X < X then begin Digit := (Max(P.X - X1, 0) + HalfPosWidth) div FCharWidth; Sel := MakeSelection(P.Y * FLineSize + I, Digit); if (Digit >= cHexDigitCount) and (Sel.Index < FSize) then // don't split the FSize character box begin Inc(Sel.Index); Sel.Digit := 0; end; if (Sel.Index <= FSize) or OutOfArea then begin Result := Sel; Area := eaDigits; end; Break; end; if DigitSep then Inc(X, HalfPosWidth); end; end else if Area = eaDigits then // OutOfArea = True begin Result.Index := P.Y * FLineSize; if P.X >= XMax then Inc(Result.Index, FLineSize); end; X := XMax; end; if ((P.X >= X) or OutOfArea) and (edText in FDrawStyles) then begin XMax := X + (AD.Text + AD.TextIn) * FCharWidth; if not OutOfArea or (Area = eaText) then if (P.X >= X) and (P.X < XMax) then begin Inc(X, AD.TextIn * FCharWidth); Sel := MakeSelection(P.Y * FLineSize, 0); I := Max(P.X - X, 0) div FCharWidth; if Sel.Index + I = FSize then Sel.Index := FSize // don't split the FSize character box else Inc(Sel.Index, (Max(P.X - X, 0) + HalfPosWidth) div FCharWidth); if (Sel.Index <= FSize) or OutOfArea then begin Result := Sel; Area := eaText; end; end else if Area = eaText then // OutOfArea = True begin Result.Index := P.Y * FLineSize; if P.X >= XMax then Inc(Result.Index, FLineSize); end; end; end; end; ValidateSelection(Result, Area); end; procedure TKCustomHexEditor.SafeSetFocus; var Form: TCustomForm; begin Form := GetParentForm(Self); if (Form <> nil) and Form.Visible and Form.Enabled and not (csDestroying in Form.ComponentState) and Visible and Enabled then Form.ActiveControl := Self; end; procedure TKCustomHexEditor.SaveToFile(const FileName: TFileName); var Stream: TFileStream; begin Stream := TFileStream.Create(FileName, fmCreate); try SaveToStream(Stream); finally Stream.Free; end; end; procedure TKCustomHexEditor.SaveToStream(Stream: TStream); var I, Size: Int64; begin if FBuffer <> nil then begin // unable to write big file at once, so do it stepwise I := 0; Size := FSize; while Size > 0 do begin Stream.Write(FBuffer[I], Min(Size, cIOChunkSize)); Inc(I, cIOChunkSize); Dec(Size, cIOChunkSize); end; end; end; procedure TKCustomHexEditor.ScrollBy(HChars, VChars: Integer; UpdateNeeded: Boolean); begin if HChars <> 0 then ModifyScrollBar(SB_HORZ, cScrollDelta, HChars, UpdateNeeded); if VChars <> 0 then ModifyScrollBar(SB_VERT, cScrollDelta, VChars, UpdateNeeded); end; procedure TKCustomHexEditor.ScrollTo(Point: TKPoint64; Timed, AlwaysScroll: Boolean); var ScrollHorz: Boolean; R: TRect; begin // disable horizontal overscroll when scrolling e.g. with mouse ScrollHorz := AlwaysScroll or (FSelEnd.Index mod FLineSize <> 0) and (FSelEnd.Index < FSize) or (FSelEnd.Digit > 0); R := GetModifiedClientRect; if ScrollHorz then begin if Point.X < R.Left then FScrollDeltaX := DivDown64(Point.X, FCharWidth) else if Point.X >= R.Right then FScrollDeltaX := (Point.X - R.Right) div FCharWidth + 1 else FScrollDeltaX := 0; end else FScrollDeltaX := 0; if Point.Y < R.Top then FScrollDeltaY := DivDown64(Point.Y, FCharHeight) else if Point.Y >= R.Bottom then FScrollDeltaY := (Point.Y - R.Bottom) div FCharHeight + 1 else FScrollDeltaY := 0; if (FScrollDeltaX <> 0) or (FScrollDeltaY <> 0) then if Timed then begin ScrollBy(FScrollDeltaX, FScrollDeltaY, False); FScrollTimer.Enabled := True; end else ScrollBy(FScrollDeltaX, FScrollDeltaY, True); UpdateSelEnd(Point, True); end; procedure TKCustomHexEditor.ScrollTimerHandler(Sender: TObject); var P: TPoint; begin GetCursorPos(P); P := ScreenToClient(P); if (elMouseCapture in FStates) and not (Dragging or PtInRect(GetModifiedClientRect, P)) then ScrollTo(PointToPoint64(P), True, False) else FScrollTimer.Enabled := False; end; function TKCustomHexEditor.SelAvail: Boolean; begin Result := SelLength.Index > 0; end; procedure TKCustomHexEditor.SelectionChanged(StartEqualEnd: Boolean; ScrollToView: Boolean = True); begin ValidateSelection(FSelEnd, FEditArea); if StartEqualEnd then FSelStart := FSelEnd else ValidateSelection(FSelStart, FEditArea); if HasParent then begin if ScrollToView and (FEditArea <> eaNone) then ScrollTo(SelToPoint(FSelEnd, FEditArea), False, True); UpdateEditorCaret; Invalidate; InvalidatePageSetup; end; end; function TKCustomHexEditor.SelectionValid(Value: TKHexEditorSelection; Area: TKHexEditorArea): Boolean; begin Result := (Area <> eaNone) and ( (Value.Index >= 0) and (Value.Index < FSize) or (Value.Index = FSize) and (Value.Digit = 0)) end; function TKCustomHexEditor.SelToPoint(Value: TKHexEditorSelection; Area: TKHexEditorArea): TKPoint64; var AD: TKHexEditorAreaDimensions; begin Result := CreateEmptyPoint64; AD := GetAreaDimensions; ValidateSelection(Value, Area); if (Area = eaDigits) and (edDigits in FDrawStyles) then begin Result.X := ((Value.Index mod FLineSize) div FDigitGrouping * (cHexDigitCount * FDigitGrouping + 1) + (Value.Index mod FLineSize) mod FDigitGrouping * cHexDigitCount + Value.Digit + AD.DigitsIn) end else if (Area = eaText) and (edText in FDrawStyles) then Result.X := (Value.Index mod FLineSize + AD.DigitsIn + AD.Digits + AD.DigitsOut + AD.TextIn) else if Area = eaAddress then begin if edDigits in FDrawStyles then Result.X := AD.DigitsIn else if edText in FDrawStyles then Result.X := AD.TextIn; end; Result.X := (Result.X + AD.Address + AD.AddressOut - FLeftChar) * FCharWidth; Result.Y := (Value.Index div FLineSize - FTopLine) * FCharHeight; end; procedure TKCustomHexEditor.SetAddressCursor(Value: TCursor); begin if Value <> FAddressCursor then begin FAddressCursor := Value; UpdateMouseCursor; end; end; procedure TKCustomHexEditor.SetAddressMode(Value: TKHexEditorAddressMode); begin if Value <> FAddressMode then begin FAddressMode := Value; Invalidate; end; end; procedure TKCustomHexEditor.SetAddressOffset(Value: Integer); begin if Value <> FAddressOffset then begin FAddressOffset := Value; Invalidate; end; end; procedure TKCustomHexEditor.SetAddressPrefix(const Value: string); begin if Value <> FAddressPrefix then begin FAddressPrefix := Value; UpdateScrollRange; end; end; procedure TKCustomHexEditor.SetAddressSize(Value: Integer); begin Value := MinMax(Value, cAddressSizeMin, cAddressSizeMax); if Value <> FAddressSize then begin FAddressSize := Value; UpdateScrollRange; end; end; procedure TKCustomHexEditor.SetAreaSpacing(Value: Integer); begin Value := MinMax(Value, cAreaSpacingMin, cAreaSpacingMax); if Value <> FAreaSpacing then begin FAreaSpacing := Value; UpdateScrollRange; end; end; procedure TKCustomHexEditor.SetCharMapping(Value: TKEditCharMapping); begin if not CompareMem(@Value[0], @FCharMapping[0], cCharMappingSize) then begin Move(Value[0], FCharMapping[0], cCharMappingSize); if edText in FDrawStyles then Invalidate; end; end; procedure TKCustomHexEditor.SetCharSpacing(Value: Integer); begin Value := MinMax(Value, cCharSpacingMin, cCharSpacingMax); if Value <> FCharSpacing then begin FCharSpacing := Value; UpdateCharMetrics; UpdateScrollRange; end; end; procedure TKCustomHexEditor.SetColors(Value: TKHexEditorColors); begin FColors.Assign(Value); end; procedure TKCustomHexEditor.SetCommandKey(Index: TKEditCommand; Value: TKEditKey); begin FKeyMapping.Key[Index] := Value; end; procedure TKCustomHexEditor.SetData(const Value: TDataSize); begin if (Value.Data <> FBuffer) or (Value.Size <> FSize) then begin Clear; if Value.Data <> nil then begin FSize := Value.Size; GetMem(FBuffer, FSize); System.Move(Value.Data^, FBuffer^, FSize); BufferChanged; end; end; end; procedure TKCustomHexEditor.SetDigitGrouping(Value: Integer); begin Value := MinMax(Value, cDigitGroupingMin, Min(FLineSize, cDigitGroupingMax)); if Value <> FDigitGrouping then begin FDigitGrouping := Value; UpdateScrollRange; end; end; procedure TKCustomHexEditor.SetDisabledDrawStyle(Value: TKEditDisabledDrawStyle); begin if Value <> FDisabledDrawStyle then begin FDisabledDrawStyle := Value; if not Enabled then Invalidate; end; end; procedure TKCustomHexEditor.SetDrawStyles(const Value: TKHexEditorDrawStyles); begin if Value <> FDrawStyles then begin FDrawStyles := Value; EditAreaChanged; // must be called first UpdateScrollRange; end; end; procedure TKCustomHexEditor.SetEditArea(Value: TKHexEditorArea); begin if Value <> FEditArea then begin FEditArea := Value; EditAreaChanged; if Value <> FEditArea then Invalidate; end; end; procedure TKCustomHexEditor.SetKeyMapping(const Value: TKEditKeyMapping); begin FKeyMapping.Assign(Value); end; procedure TKCustomHexEditor.SetLineHeightPercent(Value: Integer); begin Value := MinMax(Value, cLineHeightPercentMin, cLineHeightPercentMax); if Value <> FLineHeightPercent then begin FLineHeightPercent := Value; UpdateCharMetrics; UpdateScrollRange; end; end; procedure TKCustomHexEditor.SetLeftChar(Value: Integer); begin Value := MinMax(Value, 0, GetMaxLeftChar); if Value <> FLeftChar then ScrollBy(Value - FLeftChar, 0, True); end; procedure TKCustomHexEditor.SetLines(Index: Int64; const Value: TDataSize); var I, Size: Int64; begin I := Index * FLineSize; if (Value.Data <> nil) and (Value.Size > 0) and (I >= 0) and (I <= FSize) then begin Size := Min(FLineSize, Value.Size); if I + Size > FSize then begin FSize := Size; ReallocMem(FBuffer, FSize); end; System.Move(Value.Data^, FBuffer[I], Size); BufferChanged; end; end; procedure TKCustomHexEditor.SetLineSize(Value: Integer); begin Value := MinMax(Value, cLineSizeMin, cLineSizeMax); if Value <> FLineSize then begin FLineSize := Value; UpdateScrollRange; end; end; procedure TKCustomHexEditor.SetModified(Value: Boolean); begin if Value <> GetModified then begin if Value then Include(FStates, elModified) else begin Exclude(FStates, elModified); if eoUndoAfterSave in FOptions then FUndoList.Modified := False else begin FUndoList.Clear; FRedoList.Clear; end; end; end; end; function TKCustomHexEditor.SetMouseCursor(X, Y: Integer): Boolean; var ACursor: TCursor; P: TKPoint64; Area: TKHexEditorArea; begin P := Point64(X, Y); PointToSel(P, False, Area); if Pt64InRect(ClientRect, P) then begin case Area of eaAddress: ACursor := FAddressCursor; eaDigits: ACursor := crIBeam; eaText: ACursor := crIBeam; else ACursor := crDefault; end; end else ACursor := crDefault; {$IFDEF FPC} FCursor := ACursor; SetTempCursor(ACursor); {$ELSE} Windows.SetCursor(Screen.Cursors[ACursor]); {$ENDIF} Result := True; end; procedure TKCustomHexEditor.SetOptions(const Value: TKEditOptions); {$IFDEF MSWINDOWS} var UpdateDropFiles: Boolean; {$ENDIF} begin if Value <> FOptions then begin {$IFDEF MSWINDOWS} UpdateDropFiles := (eoDropFiles in Value) <> (eoDropFiles in FOptions); FOptions := Value; // (un)register HWND as drop target if UpdateDropFiles and not (csDesigning in ComponentState) and HandleAllocated then DragAcceptFiles(Handle, (eoDropFiles in fOptions)); {$ELSE} FOptions := Value; {$ENDIF} end; end; procedure TKCustomHexEditor.SetReadOnly(Value: Boolean); begin if Value <> GetReadOnly then begin if Value then Include(FStates, elReadOnly) else Exclude(FStates, elReadOnly); end; end; procedure TKCustomHexEditor.SetScrollBars(Value: TScrollStyle); begin if Value <> FScrollBars then begin FScrollBars := Value; {$IFDEF FPC} CallUpdateSize; {$ELSE} RecreateWnd; {$ENDIF} end; end; procedure TKCustomHexEditor.SetScrollSpeed(Value: Cardinal); begin Value := MinMax(Integer(Value), cScrollSpeedMin, cScrollSpeedMax); if Value <> FScrollSpeed then begin FScrollSpeed := Value; FScrollTimer.Enabled := False; FScrollTimer.Interval := FScrollSpeed; end; end; procedure TKCustomHexEditor.SetSelEnd(Value: TKHexEditorSelection); begin if (Value.Index <> FSelEnd.Index) or (Value.Digit <> FSelEnd.Digit) then begin FSelEnd := Value; SelectionChanged(False, False); Invalidate; end; end; procedure TKCustomHexEditor.SetSelLength(Value: TKHexEditorSelection); var X: TKHexEditorSelection; begin X := GetSelLength; if (Value.Index <> X.Index) or (Value.Digit <> X.Digit) then begin FSelEnd.Index := FSelStart.Index + Value.Index; FSelEnd.Digit := FSelStart.Digit + Value.Digit; if FSelEnd.Digit >= cHexDigitCount then Inc(FSelEnd.Index); SelectionChanged(False, False); Invalidate; end; end; procedure TKCustomHexEditor.SetSelStart(Value: TKHexEditorSelection); begin if (Value.Index <> FSelStart.Index) or (Value.Digit <> FSelStart.Digit) then begin FSelStart := Value; SelectionChanged(False, False); Invalidate; end; end; procedure TKCustomHexEditor.SetTopLine(Value: Int64); begin Value := MinMax(Value, 0, GetMaxTopLine); if Value <> FTopLine then ScrollBy(0, Value - FTopLine, True); end; procedure TKCustomHexEditor.SetUndoLimit(Value: Integer); begin Value := MinMax(Value, cUndoLimitMin, cUndoLimitMax); if Value <> FUndoList.Limit then begin FUndoList.Limit := Value; FRedoList.Limit := Value; end; end; procedure TKCustomHexEditor.ShowEditorCaret; var P: TKPoint64; begin P := SelToPoint(FSelEnd, FEditArea); {$IFDEF FPC}SetCaretPosEx(Handle,{$ELSE}SetCaretPos({$ENDIF} P.X, P.Y + 1); ShowCaret(Handle); end; procedure TKCustomHexEditor.UndoChange(Sender: TObject; ItemReason: TKHexEditorChangeReason); begin if (Sender = FUndoList) and (ItemReason <> crCaretPos) then DoChange; end; procedure TKCustomHexEditor.UpdateEditorCaret(Recreate: Boolean = False); var CW, CH: Integer; begin Include(FStates, elCaretUpdate); try if Enabled and Focused and (FEditArea in [eaDigits, eaText]) and not (csDesigning in ComponentState) and not (eoDisableCaret in FOptions) then begin if not (elCaretVisible in FStates) or Recreate then begin if elOverwrite in FStates then CW := FCharWidth else CW := Max(2, (Abs(Font.Height) * 2) div 25); if edHorzLines in FDrawStyles then CH := FCharHeight - Max(1, FCharHeight div 25) else CH := FCharHeight; {$IFDEF FPC} CreateCaret(Handle, 0, CW, CH - 2); {$ELSE} if CreateCaret(Handle, 0, CW, CH - 2) then {$ENDIF} Include(FStates, elCaretVisible); Invalidate; end; if elCaretVisible in FStates then ShowEditorCaret; end else if elCaretVisible in FStates then begin Exclude(FStates, elCaretVisible); HideEditorCaret; {$IFDEF FPC} DestroyCaret(Handle); {$ELSE} DestroyCaret; {$ENDIF} end; finally Exclude(FStates, elCaretUpdate); end; end; procedure TKCustomHexEditor.UpdateCharMetrics; var DC: HDC; TM: TTextMetric; begin DC := GetDC(0); try SelectObject(DC, Font.Handle); GetTextMetrics(DC, TM); FTotalCharSpacing := FCharSpacing * 2; // ensure even char spacing because of PointToSel if TM.tmAveCharWidth and 1 <> 0 then Inc(FTotalCharSpacing); FCharWidth := TM.tmAveCharWidth + FTotalCharSpacing; FCharHeight := TM.tmHeight * FLineHeightPercent div 100; finally ReleaseDC(0, DC); end; end; procedure TKCustomHexEditor.UpdateMouseCursor; var P: TPoint; begin P := ScreenToClient(Mouse.CursorPos); SetMouseCursor(P.X, P.Y); end; procedure TKCustomHexEditor.UpdateScrollRange; var I, CharCount: Integer; AD: TKHexEditorAreaDimensions; SI: TScrollInfo; SBVisible: Boolean; begin if HandleAllocated then begin if FInUpdateScrollRange then begin PostLateUpdate(FillMessage(KM_SCROLL, 0, 0), True); Exit; end; FInUpdateScrollRange := True; try AD := GetAreaDimensions; // update horizontal scroll position I := FLeftChar - GetMaxLeftChar(AD.TotalHorz); if I > 0 then Dec(FLeftChar, I); FLeftChar := Max(FLeftChar, 0); // update vertical scroll position I := FTopLine - GetMaxTopLine(AD.TotalVert); if I > 0 then Dec(FTopLine, I); FTopLine := Max(FTopLine, 0); if FScrollBars in [ssBoth, ssHorizontal, ssVertical] then begin SI.cbSize := SizeOf(TScrollInfo); SI.fMask := SIF_RANGE or SIF_PAGE or SIF_POS {$IFDEF UNIX}or SIF_UPDATEPOLICY{$ENDIF}; SI.nMin := 0; {$IFDEF UNIX} SI.ntrackPos := SB_POLICY_CONTINUOUS; {$ENDIF} if FScrollBars in [ssBoth, ssHorizontal] then begin CharCount := Max(GetClientWidthChars, 1); SBVisible := CharCount < AD.TotalHorz; ShowScrollBar(Handle, SB_HORZ, SBVisible); if SBVisible then begin SI.nMax := AD.TotalHorz{$IFNDEF FPC}- 1{$ENDIF}; SI.nPage := CharCount; SI.nPos := FLeftChar; SetScrollInfo(Handle, SB_HORZ, SI, True); end; end else ShowScrollBar(Handle, SB_HORZ, False); if FScrollBars in [ssBoth, ssVertical] then begin CharCount := Max(GetClientHeightChars, 1); SBVisible := CharCount < AD.TotalVert; ShowScrollBar(Handle, SB_VERT, SBVisible); if SBVisible then begin SI.nMax := AD.TotalVert{$IFNDEF FPC}- 1{$ENDIF}; SI.nPage := CharCount; SI.nPos := FTopLine; SetScrollInfo(Handle, SB_VERT, SI, True); end; end else ShowScrollBar(Handle, SB_VERT, False); end; UpdateEditorCaret(True); Invalidate; InvalidatePageSetup; finally FInUpdateScrollRange := False; end; end; end; procedure TKCustomHexEditor.UpdateSelEnd(Point: TKPoint64; ClipToClient: Boolean); var R: TRect; Sel: TKHexEditorSelection; begin if ClipToClient then begin R := GetModifiedClientRect; Dec(R.Right, FCharWidth); Dec(R.Bottom, FCharHeight); if CanScroll(ecScrollLeft) and (Point.X < R.Left) then Point.X := R.Left else if CanScroll(ecScrollRight) and (Point.X > R.Right) then Point.X := R.Right; if CanScroll(ecScrollUp) and (Point.Y < R.Top) then Point.Y := R.Top else if CanScroll(ecScrollDown) and (Point.Y > R.Bottom) then Point.Y := R.Bottom; end; Sel := PointToSel(Point, True, FEditArea); if (Sel.Index <> cInvalidIndex) and ((Sel.Index <> FSelEnd.Index) or (Sel.Digit <> FSelEnd.Digit)) then begin FSelEnd := Sel; UpdateEditorCaret; Invalidate; InvalidatePageSetup; end; end; procedure TKCustomHexEditor.UpdateSize; begin UpdateScrollRange; end; procedure TKCustomHexEditor.ValidateSelection(var Value: TKHexEditorSelection; Area: TKHexEditorArea); begin if Area <> eaNone then begin Value.Index := MinMax(Value.Index, 0, FSize); if Value.Index = FSize then Value.Digit := 0 else Value.Digit := MinMax(Value.Digit, 0, cHexDigitCount - 1); end else Value := MakeSelection(cInvalidIndex, 0); end; {$IFNDEF FPC} procedure TKCustomHexEditor.WMDropFiles(var Msg: TLMessage); var I, FileCount: Integer; PathName: array[0..260] of Char; Point: TPoint; FilesList: TStringList; begin try if Assigned(FOnDropFiles) then begin FilesList := TStringList.Create; try FileCount := DragQueryFile(THandle(Msg.wParam), Cardinal(-1), nil, 0); DragQueryPoint(THandle(Msg.wParam), Point); for i := 0 to FileCount - 1 do begin DragQueryFile(THandle(Msg.wParam), I, PathName, SizeOf(PathName)); FilesList.Add(PathName); end; FOnDropFiles(Self, Point.X, Point.Y, FilesList); finally FilesList.Free; end; end; finally Msg.Result := 0; DragFinish(THandle(Msg.wParam)); end; end; {$ENDIF} procedure TKCustomHexEditor.WMEraseBkgnd(var Msg: TLMessage); begin Msg.Result := 1; end; procedure TKCustomHexEditor.WMGetDlgCode(var Msg: TLMNoParams); begin Msg.Result := DLGC_WANTARROWS; end; procedure TKCustomHexEditor.WMHScroll(var Msg: TLMHScroll); begin SafeSetFocus; ModifyScrollBar(SB_HORZ, Msg.ScrollCode, Msg.Pos, True); end; procedure TKCustomHexEditor.WMKillFocus(var Msg: TLMKillFocus); begin inherited; ExecuteCommand(ecLostFocus); end; procedure TKCustomHexEditor.WMSetFocus(var Msg: TLMSetFocus); begin inherited; ExecuteCommand(ecGotFocus); end; procedure TKCustomHexEditor.WMVScroll(var Msg: TLMVScroll); begin SafeSetFocus; ModifyScrollBar(SB_VERT, Msg.ScrollCode, Msg.Pos, True); end; end. tomboy-ng_0.34-1/kcontrols/source/kprintsetup.lfm0000644000175000017500000002070014125207534022023 0ustar dbannondbannonobject KPrintSetupForm: TKPrintSetupForm Left = 798 Height = 386 Top = 397 Width = 464 ActiveControl = EDTitle BorderStyle = bsDialog Caption = 'Page setup' ClientHeight = 386 ClientWidth = 464 Font.Height = -11 Font.Name = 'Tahoma' OnCloseQuery = FormCloseQuery OnCreate = FormCreate OnDestroy = FormDestroy OnShow = FormShow Position = poScreenCenter LCLVersion = '1.7' object GBFileToPrint: TGroupBox Left = 8 Height = 45 Top = 8 Width = 449 Caption = 'Title of printed document:' ClientHeight = 27 ClientWidth = 445 TabOrder = 0 object EDTitle: TEdit Left = 8 Height = 21 Top = 2 Width = 432 TabOrder = 0 Text = 'EDTitle' end end object GBPrintOptions: TGroupBox Left = 8 Height = 123 Top = 109 Width = 249 Caption = 'Print options:' ClientHeight = 105 ClientWidth = 245 TabOrder = 1 object Label1: TLabel Left = 162 Height = 13 Top = 4 Width = 29 Caption = 'Scale:' FocusControl = EDPrintScale ParentColor = False end object CBFitToPage: TCheckBox Left = 8 Height = 19 Top = 2 Width = 72 Caption = '&Fit to page' OnClick = EDTopExit TabOrder = 0 end object CBPageNumbers: TCheckBox Left = 8 Height = 19 Top = 21 Width = 88 Caption = 'Pa&ge numbers' OnClick = CBPageNumbersClick TabOrder = 1 end object CBUseColor: TCheckBox Left = 8 Height = 19 Top = 40 Width = 64 Caption = '&Use color' OnClick = CBPageNumbersClick TabOrder = 2 end object EDPrintScale: TEdit Left = 162 Height = 21 Top = 20 Width = 48 OnExit = EDTopExit TabOrder = 3 end object CBPaintSelection: TCheckBox Left = 8 Height = 19 Top = 59 Width = 89 Caption = 'Pa&int selection' OnClick = CBPageNumbersClick TabOrder = 4 end object CBPrintTitle: TCheckBox Left = 8 Height = 19 Top = 78 Width = 63 Caption = 'Print tit&le' OnClick = CBPageNumbersClick TabOrder = 5 end object CBLineNumbers: TCheckBox Left = 134 Height = 19 Top = 59 Width = 83 Caption = '&Line numbers' OnClick = CBPageNumbersClick TabOrder = 6 end object CBWrapLines: TCheckBox Left = 134 Height = 19 Top = 78 Width = 70 Caption = 'Wrap lines' OnClick = CBPageNumbersClick TabOrder = 7 end end object BUPrint: TButton Left = 89 Height = 25 Top = 350 Width = 74 Caption = '&Print' OnClick = BUPrintClick TabOrder = 4 end object BUCancel: TButton Left = 383 Height = 25 Top = 350 Width = 74 Cancel = True Caption = 'Cancel' ModalResult = 2 TabOrder = 5 end object GBMargins: TGroupBox Left = 264 Height = 236 Top = 109 Width = 193 Caption = 'Margins:' ClientHeight = 218 ClientWidth = 189 TabOrder = 3 object LBMarginUnits: TLabel Left = 8 Height = 13 Top = 6 Width = 62 Caption = 'Margin u&nits:' FocusControl = CoBMarginUnits ParentColor = False end object LBLeft: TLabel Left = 8 Height = 13 Top = 67 Width = 23 Caption = 'Left:' FocusControl = EDLeft ParentColor = False end object LBRight: TLabel Left = 102 Height = 13 Top = 67 Width = 29 Caption = 'Right:' FocusControl = EDRight ParentColor = False end object LBTop: TLabel Left = 9 Height = 13 Top = 126 Width = 22 Caption = 'Top:' FocusControl = EDTop ParentColor = False end object LBBottom: TLabel Left = 102 Height = 13 Top = 112 Width = 38 Caption = 'Bottom:' FocusControl = EDBottom ParentColor = False end object LBUnitsLeft: TLabel Left = 58 Height = 13 Top = 86 Width = 7 Caption = 'A' ParentColor = False end object LBUnitsTop: TLabel Left = 58 Height = 13 Top = 131 Width = 7 Caption = 'A' ParentColor = False end object LBUnitsRight: TLabel Left = 152 Height = 13 Top = 86 Width = 7 Caption = 'A' ParentColor = False end object LBUnitsBottom: TLabel Left = 152 Height = 13 Top = 131 Width = 7 Caption = 'A' ParentColor = False end object CoBMarginUnits: TComboBox Left = 8 Height = 21 Top = 22 Width = 176 ItemHeight = 13 Items.Strings = ( 'milimeters' 'centimeters' 'inches' 'hundredths of inches' ) OnChange = CoBMarginUnitsChange Style = csDropDownList TabOrder = 0 end object CBMirrorMargins: TCheckBox Left = 8 Height = 19 Top = 162 Width = 88 Caption = '&Mirror margins' OnClick = CBPageNumbersClick TabOrder = 5 end object EDLeft: TEdit Left = 8 Height = 21 Top = 83 Width = 48 OnExit = EDTopExit TabOrder = 1 end object EDRight: TEdit Left = 102 Height = 21 Top = 83 Width = 48 OnExit = EDTopExit TabOrder = 2 end object EDTop: TEdit Left = 8 Height = 21 Top = 128 Width = 48 OnExit = EDTopExit TabOrder = 3 end object EDBottom: TEdit Left = 102 Height = 21 Top = 128 Width = 48 OnExit = EDTopExit TabOrder = 4 end end object GBPageSelection: TGroupBox Left = 8 Height = 105 Top = 240 Width = 249 Caption = 'Page selection:' ClientHeight = 87 ClientWidth = 245 TabOrder = 2 object LBRangeTo: TLabel Left = 163 Height = 13 Top = 32 Width = 14 Caption = 'to:' ParentColor = False end object LBCopies: TLabel Left = 8 Height = 13 Top = 59 Width = 87 Caption = 'Number of &copies:' FocusControl = EDCopies ParentColor = False end object RBAll: TRadioButton Left = 8 Height = 19 Top = 3 Width = 63 Caption = '&All pages' Checked = True OnClick = RBAllClick TabOrder = 0 TabStop = True end object RBRange: TRadioButton Left = 8 Height = 19 Top = 29 Width = 80 Caption = '&Range from:' OnClick = RBAllClick TabOrder = 1 end object RBSelectedOnly: TRadioButton Left = 128 Height = 19 Top = 3 Width = 84 Caption = 'Selected &only' OnClick = RBAllClick TabOrder = 2 end object EDRangeFrom: TEdit Left = 108 Height = 21 Top = 27 Width = 48 OnExit = EDTopExit TabOrder = 3 end object EDRangeTo: TEdit Left = 193 Height = 21 Top = 27 Width = 48 OnExit = EDTopExit TabOrder = 4 end object EDCopies: TEdit Left = 126 Height = 21 Top = 54 Width = 48 TabOrder = 5 end object CBCollate: TCheckBox Left = 179 Height = 19 Top = 56 Width = 53 Caption = 'Collate' OnClick = CBPageNumbersClick TabOrder = 6 end end object BUPreview: TButton Left = 8 Height = 25 Top = 350 Width = 75 Caption = 'Previe&w...' OnClick = BUPreviewClick TabOrder = 6 end object BUOk: TButton Left = 303 Height = 25 Top = 350 Width = 74 Caption = 'OK' Default = True ModalResult = 1 TabOrder = 7 end object GBPrinter: TGroupBox Left = 8 Height = 50 Top = 56 Width = 449 Caption = 'Printer settings' ClientHeight = 32 ClientWidth = 445 TabOrder = 8 object LBPrinterName: TLabel Left = 8 Height = 13 Top = 6 Width = 65 Caption = 'Printer name:' FocusControl = EDCopies ParentColor = False end object CoBPrinterName: TComboBox Left = 112 Height = 21 Top = 2 Width = 206 ItemHeight = 13 OnChange = EDTopExit TabOrder = 0 Text = 'CoBPrinterName' end object BUConfigure: TButton Left = 328 Height = 25 Top = 1 Width = 113 Caption = 'Configure...' OnClick = BUConfigureClick TabOrder = 1 end end end tomboy-ng_0.34-1/kcontrols/source/kmessagebox.lrs0000644000175000017500000014507014125207534021775 0ustar dbannondbannonLazarusResources.Add('kmessagebox_info','PNG',[ #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0'0'#0#0#0'0'#8#6#0#0#0'W'#2#249#135 +#0#0#12#30'IDATh'#129#189#154'[l'#28#231'y'#134#159#239#159#153#221'%'#151'\' +#158'D'#153#162'D'#157'i1'#128'+'#181#146'P_Dhb'#4'h'#26')'#145']'#164'wN'#17 +#184'F.'#26' 0\'#24#5#218#162#169#218#162'@'#131#198#237'U'#0#247#164#216#17 +'\'#8'E'#11#216#149#27#161#185'q'#4#215#177#19#212#182'd)'#182'%'#138'4u'#160 +'D'#145#20#201'='#159'f'#230#239#197#156'g'#201#165#28#167#253#129#159';;' +#195#157'y'#223#247'{'#191#239#255'fv'#133'O9&'#191#252#242#160'h'#247'1'#141 +'>'#140#200'!'#132'A'#17#227' '#200#0'"'#128'.'#226':W'#16#214#180#214#239'k' +#167'y'#169'Q'#252#248#245#219'o'#254#213'2'#224'~'#218#235#203'/'#12#252#196 +#15#158#2'y"'#147#201#156#28#221'R'#160#208#223#203#240'`'#31'J)'#250#242'=8' +#174#139#235'j'#28'WS*'#215'i'#219#14'k'#165#26#213'Z'#131'R'#165'A'#187']?' +#143#221'87'#253#159'O'#159#6#218#191'('#153'OL`'#242#196#153'g'#17#158#153 +#216#182'e'#215#238#137'Q'#30#218':'#132#237#184#20#171'6'#229#154'K'#189#233 +#210'hi'#154'm'#141#6','#3','#19'L'#165#189'm'#3#180#22#214'JUV'#138'%J'#229 +#210'm'#167'Uy'#225#250'k'#191#247'<'#208#250#164'D'#30#152#192#254#227'/>&' +#202#248#254#190']c'#187#30#153#154' '#155#181'X^'#179#153#191#223'by'#205 +#193'vut'#186#244'Y5xv'#2'%'#208#147#129#222#12'd'#12'h'#181'm'#150'WW('#149 +#214#230#219#149#219#223#156#253#209#179#255#229#19#209#191#20#2#147''''#206 +#12#162#245#169#225#225#254'g'#142#30#220#203#200'p'#129'['#139'M'#174#207'7' +#169#183#2#177'b'#167#137#159'QK'#231#21'b'#239#13'%'#228'-'#143'H'#189'Qgeu' +#137'fm'#229#159#139#183#222'8u'#239#189#127#188#11'8'#155#225'36'#5#143#254 +#241#254#189#219#30'?'#246#235#7'p'#176'xo'#186#198#141'{-l'''#16'('#166'z'#0 +'N'#139#167#184#144'<&'#128#8'Z'#188#227#26'h:'#208'r'#193'2,'#242'='#253'he' +#29'6'#251#183#31#215#174#253#195#250#242#135#21'6'#177#212#134#4#246#31#127 +#241#215'D'#228#149'c'#143'N'#29'z'#228#192'N'#230#22'Z'#188'{'#173#158'R]' +#146#192#227#251#18#192'='#208#226#219#200#223#21'n'#184'"'#180#181#0#138#158 +'L'#30#195#204'm1'#7'v}1'#211#183#237''''#229#249#159'v'#173'V'#235'Z(P'#254 +#216#163#159'9'#180'{'#199'('#23#175'W'#185#189#212'F'#179#142#234#169'S'#245 +#245#26'|'#247#247'ws'#228#225'<'#0#239'\'#171#242#220#223#223#160'Rs'#252 +#127#145#4#199'4'#18#195#159#205'f'#133#202#218#252#213#197'K/'#158'\'#153'~' +'m'#14'//:FG'#4#210#224#223#187'^e'#190'+xI'#236#251#163'''w'#240#249'_-'#132 +#231#27#31#201#144#181#20'o}TAD'#240#221#19#5#203#143#140#4#7#252'h'#25'f'#22 +'e'#245'l'#201#12#238#251'M'#215#174#157#175#223#191'Vb'#157'H'#168#14'JZ' +#159#218#191'g['#168#252#230#224#227'<'#132'm#'#153#142'S'#30#152#200'E'#226 +#251#160#137#131'V'#201#247'Z'#4'W'#20'f'#174#143'l'#223#232#129#145#169#175 +'~'#27#24'XO'#240#4#129#253'''^zlx'#184#240#204#145#131'{'#152#185#211#232 +#180'M'#135#223'c'#1#144#238#5'-RX'#197#192'*DE'#202'Kbz'#159#201#246#13#147 +#27#156'xr'#226's'#223'>'#14#244'&UK'#17#16'Q'#223'?zp'#15#149#186#230#195#27 +#141'N'#240#9#185#215#1'/p'#246#245#251#29#224#207#254'x%'#2#152#0'L,*x'#145 +'HM1'#12#178#253'#'#244#141#31#253#14'0'#4'$B'#28#134'd'#242#196#153'?'#223 +#183'{'#236#241#201#189'c'#188'w=]m'#216'@'#249#164#255'E'#132#27#247#154'L' +#207'7h'#217#154#233#249#6#255't~'#137#11#151#203'!'#240#224'c'#162#136#145 +'R'#145#242'*'#29#9'A'#25#22#2'}'#249#177'#'#238#234#244#15#127#6'4'#241#23 +':3&'#255#215#31#153#154#224#230'b'#139#149#178#253'@'#224#195#181'7'#174'&p' +#225'r'#153#11#151'+!'#169'`M'#8#255#23#194'}'#225'Y'#19'AN'#172#134'h'#129 +'L~'#128#236#208#174''''#129#23#128'*'#208#0#223'B'#147''''#206'<51>'#178'+' +#155#181#152#153'o~'#10#240'1{'#168'X'#221'WDJ+'#255#152#242']'#18#190#15'l' +#163'R6'#242'>cX'#22#217#252#208#216#158'/'#254#237#215#128'|'#128#221#244'1' +'<'#177'k'#199'('#203'kv'#204':'#221'l'#147#4#255#240#142#28#253#189'Fh'#169 +'0'#159'%R'#252#221#217'z$z'#180#17'S'#222#255#155#170#5#26#188#149#29#176'z' +#250#200#14'L|'#1'x'#9#168#0'M'#243#225#175#188''#184#217#160#237'x'#159'}tj'#253'H('#165#252#234#147#172#243'q'#17'$}]' +' '#232#170#181#22#12#192'43d'#11#227'S@'#15'`'#154#136':4<'#216'G'#185#150 +'V'#127'#'#240#222'E'#181#134'F'#219#165#214't'#249#179#151'n'#135#137'8}' +#250'W6 '#16'$v'#144#208'A'#20#131#170#148#140#166#132#208#197''''#160'Q@6' +#147#197#236#25#158#244'#`'#154#192#160'R'#138'z]w'#146#239#24#130#214'P'#171 +';'#212'['#218#183'BTET'#23';)C'#18#192#131'('#144#138'F(T@ XK'#181#160'Dc` ' +#202#234#7','#192'0E'#25#7#243#189'9'#238#172#182'7'#181'N'#163#233'Ri8hM' ,#199#130#163#130'Uv#'#234#202#243'u'#154#4')2'#225#213'}'#6#225'm'#153#159 +#244'=V'#6'37'#176#207''''#160'LA'#6#28#215#187#135']Gp'#0#28'WS'#172'8'#180 +'m'#221#9'$57'#140'@'#16#165'.$'#226#139']8'#180#14'K'#169#136#198#178#4'1' +#172'|'#24#1#16'\W'#199'n@'#147#203'c'#163#229#178'V'#182'A'#240'T'#14#171 +#207':'#179#179#183#141#8#24'Q'#18'G'#249#176'~2''-'#20#229#128#161#4#211#210 +#1'A'#3#16#19#209'E'#199#213#3'V'#186'Q'#21'('#150'm'#170#13'''T'#173#163'cL' +'G'#160'K'#14#196#129#171'@'#253'n$bCk'#13'Z'#200#152'^'#4#208'N58fj'#215#185 +'R'#170#212'?k'#26'V'#248#1'W'#195#234'Z'#155'FK'#163'T'#20#218#180#218'i2' +#170#155#133#140'(OT'#130'tP'#149#136'*R*'#139#181#246#222'd-'#193'vZ8'#173 +#242','#222#13#191'6'#17#214#218'm'#7'SY'#224#175#144'K'#171'mlG'#251#29'$a' +#143#19'F!'#161'\'#146#204#134#4'R'#192#19'6'#138#19#241#241'G'#242'{'#11#159 +#214#154'l'#22#220#6#184'n'#187#130#247'0'#204'QZ'#235#247#215#202'5,'#19'\W' +#179#184#210#162'm'#187#233'T'#232#240'>q'#27'Id'#137'n'#4#2#224'F'#184#250 +'*'#12'Ca'#24#177'}'#166#138#173#200#202#127#239#29#239#205#10#245'F'#27#187 +#182'2'#227#19'pMm7/'#213'jMF'#135#161'Ti{'#149'F'#4'!'#238#251#164']'#136 +#169#31#150#193'`a'#218'`'#4#224#149#161#162#237'T'#254#172#215#158#4#254#23 +#160'7'#167#169'7m'#154#197#155#211'A'#4#204'fq'#238#245'r~'#152'r'#173#141 +#194'['#141#131#19#17'S;'#217'B@2'#169'7'#183#144#164#193#27#221#173#228#161 +#7#141'Fk'#232#207'hL'#19#202#229#22'K'#239#255#235';x'#247#3#182#186#245#230 +'_.'#183#219#245#243#171#197'*'#133#158#164#138#146'z'#141',$'#196#237#244 +#224#22'"'#4#31#183#137'a('#12'3'#176'S'#210'>'#193#190#145'~E'#177#212#164 +'^'#188#243'v'#237#222#149#21#160#14#216#10'p'#181#221''#248#175'=W]'#248#249#28'0'#143#167'~'#251#147 +#232#151#25#158'<'#177#231#161#195#223'xU'#172#161#3#142'*'#160#149#1#29'9' +#16#127'4'#18'o'#210'$L'#200#160#25#11#27'3?I'#3#18#133#188'bb'#196'K'#216 +#139'W'#138#204'\]'#152#253#232#236#239'>W]'#184#210#21''#235#3#14#170'M'#141#7#248#154#245#147#212#16#193#251'r' +#161#15#24#222#251#165#191'{230'#241#133'L'#254#161'c'#134#153#241#158#152'e' +#179'd,'#131'\'#143#133'e),K0-'#133#227'8'#160#160#222'h'#211'h8'#148'*m'#234 +'k'#243'o'#215#150#175#190'9'#243#31#207#156#195'[Y'#215'|'#224#21'~'#153'_t' +#175'3'#20#144#197#139'H'#161'o'#251#209#241#145#3''''#143'e'#10#219#167#172 ,#222#145'I1'#172'~#W'#216#167#12'+'#143#8'Z'#187'U'#183'Y'#158'u'#221'v'#197 +#174#221#159'i'#22'oN/]:'#251'N'#213'k'#137#171'x'#141'Y'#201#223#254#191#251 +#169#193#6'D,'#159'L'#14#239'Ye'#206#223#23#204#160'H8x^'#14'f'#3#175#159'o' +#224#173#170#255#127'?'#246#216'`('#188'U'#221#196#3#173#252#215#224#252#26 +#143#132#235#191#218#254#252#212'?'#183#249'_#'#234'='#139#131#251#19#227#0#0 +#0#0'IEND'#174'B`'#130 ]); LazarusResources.Add('kmessagebox_question','PNG',[ #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0'0'#0#0#0'0'#8#6#0#0#0'W'#2#249#135 +#0#0#14'*IDATh'#129#189#154'yl'#28#215'}'#199'?'#239#189#153#217'{I'#241#144 +'(J'#148'dI'#148#148'B'#149'ZY'#181#11'W@'#171#4'm'#19'+'#150#147#26'H'#154#6 +#134#225#4#249#199'm'#224#6'u['#180'M'#10#27'A'#155#4#169#145#254#211'&E'#28 +#31'5l'#11#142'S'#216#245#21#27'H|'#187'nR['#135'%[2)'#138':(K$E'#238'}'#204 +#245#250#199#204#236#206'.'#151#150#18#167#29#224'qf'#223#206#204'~'#127#223 +#223#247'w'#188#25#10'>'#228'6'#254#201#135#250#133#246#247'j'#244'.'#132#216 +#137#160'_'#8#181#3'D'#31'B'#0#186#136#239#29'EP'#208'Z'#31#209'^'#243'p'#163 +'x'#234#133's'#175#253#195'<'#224#127#216#223#23#191'4'#240'}'#255'~+'#136'O' +'Y'#150#181#127'x(O>'#151'f'#160'?'#139#148#146'l&'#133#231#251#248#158#198 +#211#154'R'#185#142#227'z'#20'J5'#170#181#6#165'J'#3#199#169'?'#139#219'xr' +#226#233'/'#222#11'8'#191#172'1'#191#176#1#227#251#30#252#10#130#219#199'V' +#15#173#223#176'n'#152'U'#195'+p='#159'b'#213#165'\'#243#169'7}'#26#182#166 +#233'h4`*0'#13'0'#164#14#142#21'h-('#148#170','#20'K'#148#202#165's'#158']' +#249#222#228'S_'#184#27#176#127'QC'#174#216#128#205#215#223#191'WHu'#223#166 +#245'#'#235#183'o'#27'#'#145'0'#153'/'#184#204'\'#178#153'/x'#184#190'n'#223 +#174#251#174#26#2'9'#129#20#144#178' m'#129#165#192'v\'#230#23#23'('#149#10 +'3N'#229#220'mS'#207#127#229#185#208#16#253'+1`|'#223#131#253'h}'#231#192'@' +#238#246#221';628'#144#227#236#172#205#228'L'#147#186#29#145#181#28'p'#177't' +'.'#246'YIA'#198#12#12#169'7'#234',,'#206#209#172'-'#252#160'x'#246#149';/' +#30#252#254#251#128'w9|'#234#178#224#209'/n'#222#184#250#198'='#215'l'#197 +#211'&'#7''''#235#156#190'h'#227'z'#17'A='#192'k'#17'0.b'#167#180#134'@'#139 +#224'{'#13'4='#176'}0'#149'I&'#149'CKs'#151#145'[s'#189#246#221'g'#234#243 +#239'V'#184#140#164#150'5`'#243#245#247#255#166#16#226#241'='#215'n'#219#185 +'}'#235':'#166'/'#216#188'5Q'#239'b]'#180#129#1#218#7#207#209#216'M'#15#215 +#241'q'#29#141#235'j'#252#240#18#169'd'#251#202#152'A'#190#16'8Z'#0#146#148 +#149'A'#25#201'!'#163'o'#253#31'Z'#217#213#175#151'g'#254#251#3#179'UO'#9'E' +#204#239#185#246'#;7'#172#29#230#208'd'#149'ss'#14#154#222#172#187#182'O'#179 +#230#147'2'#4#215'l'#207#241#145#13#233#214#153#26'(W]~'#246'N'#133#247#206 +'5'#176'R'#138'D'#218'@'#202#222'HT8'#154#205#10#149#194#204#137#217#195#247 +#239'_'#152'xj'#154' ..o@7'#248#131#147'Uf'#150#1#175'}'#168#151']'#134#243 +'&_'#254#236'('#127#244#209'A'#180#6#173'5Z'#7#240#227#159'g'#230#154'|'#247 +'G'#23'y'#242#245#2#153'~'#19'e'#10'Dx?'#29#227'$'#26'v'#179'J'#173'p'#238 +#196#236#225#251#246'/'#188#247#212')'#130't'#219#177'-'#145#208#224#248#167 +#191#185'y'#227#234#27#183'o'#29#227#208#7#128#247#28'My'#193#225#182#155'V' +#243#175#127#179#153'm'#27#210'='#129'C'#219#128'lJ'#178#247#234''#164#198#174#251'([s'#207#223'o' +#225#211'{'#135'.'#11#188'='#31#28#175#30'4'#185'n{'#134'G~|'#137'd'#198#8'r' +#171'h'#27#17#12#16'B'#160#172'$'#8#181'#'#209#191#225'X'#233#244'K'''#187 +#189#208#161'D!'#228'}'#187'w\E'#165#174'y'#247'tc)'#248'pk'#214'^a'#207#206'<'#131'}F'#15#198#151#178#223'kn'#203#186'$'#15'?' +#191'H2g'#182#153#151#221#158#16'He" '#155#25#185#218'_'#156'x'#230'gq)'#181 +'= '#196'-'#219#183#141'qf'#214'f'#161#236'.'#11#30'@'#26#2#223#146#252#217 +#183#167'(V\'#180#6#223#215#148'*'#30'_'#251#183#179#236#188#249'mv'#221'z' +#140'}'#127#241#30'/'#188'Y'#238#240'R'#220#11'#'#3#6#171#6'L@#$H'#25#17'/b' +#3#132#4'+'#211'Gb'#197#250#207'w{A'#133#236#223':'#182'f'#232#150#13'c+94Y' +#15#139'To'#240'Q'#238#22'JP'#174'yL'#156#174#243#241#223#238#231#248#233':' +#159#253#234#4#19#23#29'2+,R9'#147#134#7'O'#191#188#200#174'-'#25'F'#6#140 +#208#11'D'#228#161'5'#188'r'#164#202#165#154'F'#153'2'#12'`'#217#10#228'h'#8 +#1'R)'#180#175#179#169#161#237#139#133#147#207#29#140#188'`'#4#228#243#169 +#245'k'#135#153'/'#186'1'#233','#15'>:LfM^=Z'#229#207#191'3'#205#155'''j'#232 +#164'A2!'#131'l'#2#24#9'Iz'#133#197'#?Yd'#215#150'TLjm'#25#181#165#18#22#185 +#174#196#30#156#26'L'#154#169','#137#190#177#143#1#15#0#21#160'il'#185#225 +#161'~'#211'4'#246#143#172#236#231#237'S'#245'6'#224#158#224#227'S'#1'3'#233 +'>'#131#151#143'TH'#247#155#24'f'#27'<2'#200#240#210'R'#204#204#217#203#196#4 +#28'>Y'#135#156#137#240#188#16'|'#251#247#194#194#29'd#'#1#202'Haf'#134#247 +'dGw'#143'V'#206#255#207'%'#160')'#209'z'#239#240'`'#30#215#213#204#23#188'8' +#237'='#182#182#5'Q+ '#149' 7'#148'h'#129'w}M'#221#246')'#215'<'#22#202'.' +#151#230#154'l'#24#177':'#244#31#128#215#156#191#228'Ps@'#153#18#169#4'RE{' ,#129#148#2'M0<'#13#182#167#241']'#141'2'#147#12'l'#187'a'#15#144#4#164#161 +#241'w'#229'si'#138'U'#183#221#18#127#128't'#136'R'#158' '#172#162#2'/'#4#237 +'zA'#211'"'#195'l'#162'=MJ'#192'_}ne'#7#240#136#253#167#222'('#147#200#26#237 +#30#169#251'w'#131'3'#195#243#5#10'0'#12#139'D~t'#27#144#2#12#3'!w'#14#244'g' +')'#213#188'+'#4#31#156#163'54'#28#159'Z'#211#15#180','#3#208'q'#240#150#235 +'s'#207'_'#143#145'K'#203'.'#253#195#251#11'.'#143#190'\!'#153'7'#145'R'#180 +#239#29#251'u'#29#195#161#181'F'#2#9'+'#129#145#26#24#15'=`'#24'@'#191#148 +#146'F'#253'J'#214#15#2#173#161'V'#247#168#219'A'#153#147'!'#240'8x44'#138#14 +#255#248#167#163'lYkuH'''#138#129#175'?t'#9#215'R$'#12#217#170#186#241#24'k' +#25#208#234#10#5'Rh'#20#10'!'#205#28'`'#2#202#16'R'#237#200#164#147#156'_t.' +#203'~'#163#233'Sixm'#198#227#197#166'U'#132#160'^r'#184#235#214'U'#236#253 +#141'L'#140#245#182#7#254#249#241#2'G'#207#187'd'#7#173#22#243#162'+'#195'E' +#22#180#237#214#8'!H'#153#22'F'#178'oSh'#128'4'#4#162#207#243#131'5l'#15#194 +#1#240'|M'#177#226#225#184':`Z'#198#170'f'#215'h'#150#28'>'#247'{}'#236#191 +'.'#191#132'u'#128'g~^'#229'?'#222#168#146#27'N '#149'h1'#223#218#19'#-'#4#30 +#165'R!4'#166')'#16#202#204#180'<'#0'"'#232'['#186'Q'#135'44l'#159'B'#217#13 +'2'#142'hg'#31#209'cx'#142#207#166'U&w|fxI'#202#4'xk'#178#201'7'#30'+'#208 +#183'*'#25'P'#23'k'#218':b'#160'CB'#237#24'PR`'#152':2P'#1#194'@'#232#162#231 +#235'>'#179#187#177#22'P,'#187'T'#27'^'#139'q'#186#251#148'.'#246#237#138#195 +'_~i'#205#18#224'ZC'#165#238#243#183#15'\"7'#156'@'#153#161#238#229#7#24'A' +#252'z'#13'Z`'#25#129#7#208'^5'#250#206#208#190'w'#180'T'#169#255#142#161#204 +#214#5#190#134#197#130'C'#195#214#237#12'A;$'#218#21#191'm'#140#246'4['#214 +'X'#236#26'Ov'#20#170'H'#197'?|'#181#130#163#20#217#132#234#8#252#8'|t'#191 +#30'.@'#235#224'C'#194#20#184#158#141'g'#151#167#8#22#252#218'@Pp'#28#15'C' +#154#128#192#215#154#185'E'#7#215#11#244#222#202#247#177#5'G''s'#129'1'#174 +#173#217#189'%'#211#201'Zl{'#229#157'&'#169'>3'#208'}'#20'G'#241'X'#138#12 +#137#169#152'PB:'#188'_"'#1'~'#3'|'#223#169#16#172#11'<'#169#181'>R('#215'0' +#141#160#163#156']'#176'q\'#191';'#20#150'h'#159#184#140#132'@'#132'+'#174 +#168#226#198#229#163'5L]p1'#19#18')'#5'J'#181'+'#175'R'#18#165'bs'#134#12'+r' +'8'#140'`^)I:!'#168'7'#28#220#218'B'#180#176#241#13#237'6'#15#215'jM'#134#7 +#160'Tq'#130'L#'#130#181'j'#139'q'#209')'#23'b'#236#183'3'#136#224#173#201#6 +#247'<[\'#154'Y'#194#239#165#12'@G'#30#232#148#146#232#188'_'#151#254#5#144 +'Nj'#234'M'#151'f'#241#204'D'#228#1#163'Y'#156'~'#161#156#25#160'\u'#144#4 +#213'8'#186#17'1'#182';['#8'b'#134#4#231#155'I'#197';'#23'='#142#207'U'#17'J' +#182#192#201#240'8'#221'ov'#130#191#140#148#8#195'G'#135#9'!gi'#12#3#202'e' +#155#185'#'#143#190#9'4'#0'W'#158'}'#237#235#243#142'S'#127'v'#177'T%'#159#18 +#29')Xt'#237#219#18#18#196#229'$'#132#192'HH'#146'y'#147'd'#222#196'J)'#204 +#164#194'J)R9'#131't'#191'If'#133#25'.ZD'#172'q'#147'm'#25#25#145#156':'#229 +#19#205#13#230'$'#197'R'#147'z'#241#252#27#181#139'G'#23#128':'#224'J'#192 +#215'n'#243#201'Z'#189'F'#210#4'C'#181'%'#210#169'}'#209#10#230#184#23':'#210 +#160#134#234#130#205#136#165#249#196'6'#147'='#235#20#238#162'C'#163#236#133 +'R'#137'y&'#230#137#214'0'#130#24'P'#134#8'F'#24#19#233#164' '#151#22'\'#152 +#171'S'#155';'#241#26'P'#13'='#224'G'#228'&'#182#222#244#216#228#192#138#209 +#181#229#134#193'B-'#214#223#196#220#28#181#185'B'#9#164#148#173#207'Q'#27'\' +'_t'#185#229#163'Y'#190#240#7#249#150#23'+'#13#205#29#247#23#153#245#20#233 +#188#25#3#28']'#223#190'O'#135#132#162'VBkF'#251#192#244#29'~'#250#147#201 +#217#131#255'r'#237'g'#128'3'#192'y'#160#25#173#137#29#223'.'#127#175'V/'#147 +#177#192'2'#218'Z'#143'K''8'#142#2'<'#238#5#240']'#205'U'#195#170#3'<@6)'#184 +#235#143#243'4*^'#144#235'{y '#220'+%PF('#157'p'#159#207'H'#134'r'#130#147 +#167#202'T.'#28'ySc'#242#189#247#167'N?'#255#181'{C'#240#29#236#247'F'#2'jp'#219'M'#27#134 +#127#253'O'#158'V'#230#170#173#154'4M)'#209#29'A'';'#179#137#140#218#2#129']' +#243#176'k'#154']'#155#19'Tm85'#239#147#27#178'H'#229#140#14#137#4#251'@6' ,#173#192'U'#146#225#188'd'#227'J'#201#201#233'*/'#253'tr'#234#248'#7'#223'Q' +#187'xl'#10#152#9#13#232'xk'#211#235#5#135#174#207#191'[I'#175#220'~'#204'Le' +#174#21'29$'#133#209#242'{'#183'~'#187#219'j3'#21#164#203#133'&'#212#165'$' +#179#194#196#176'T'#171'%'#151#177#165#167#140#177'n'#26#130'u'#3#130#209'~' +#193#212't'#149'W^'#156#154':q'#224#230';j'#23#143'M'#19#164#204#2#224'v'#131 +']'#238#13#141'_'#156'~a'#198#183'+?'#206#140'l'#251'}'#169#228#16#194'B'#136 +#232'Q8='#12#232#12'Ne'#180#189#19'\'#22#203#243'1#'#132#128'\J'#176'aP'#144 +'24??'#184#200#161'7'#207'N'#29'?p'#243#29#213#11#199#166'c'#204'/y7'#240'A' +#6#0#248#245#133#137#146#239'T'#159'M'#244#141#14#152#150#181'CK#X'#3'I'#1'a' +#255'.c'#185#189'{'#200#142'~?8'#150'1/&L'#24#237#23#172#233#135'b'#209#230 +#213#255#154'c'#250#216#161'''&'#31#255#242'7'#171#23#142'F'#204'/'#11#30'z' +#199'@'#247'f'#2'}'#235'~'#247#206#235#179'kw'#127#11's'#197#136'od'#17#202 +#192'P'#18'%'#5'('#17#228'p'#213#217'*'#183'>'#27#237#214#217'0%}i'#193'`N' +#146'K'#11#28#199#231#228't'#133#211#211#11#179's'#135#30#190#251#236'K'#223 +#142#178#205''#187'f'#247#232#224#214#253'{'#172#252#154'mfz' +'p\(3'#167#146#249'MR'#153#25#132'@k'#191#234'7'#203'S'#190#239'T'#220#218 +#165#147#205#226#153#137#185#195#7#222#172#6'-q'#21'('#19#244'6U'#254'/'#255 +#213'`'#25'C'#204#208#152'$'#193#179#202'd8'#23#141'(Ix'#4'Z'#142'F'#131#160 +#159'o'#16'<'#231#255#255#251'g'#143'e6'#9#24#225'P'#225'g'#21#187#191'&0' +#194#15#247'n8>'#244#191#219#252'/w'#245';'#226#12#17#214'='#0#0#0#0'IEND' +#174'B`'#130 ]); LazarusResources.Add('kmessagebox_stop','PNG',[ #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0'0'#0#0#0'0'#8#6#0#0#0'W'#2#249#135 +#0#0#15'kIDATh'#129#189#154'}'#140#21#245#185#199'?'#191#153'9'#175'{'#246 +#156'}a'#193#133#8#187#200#202#194#130#8'"'#224'J'#5#19')'#212#164'6ii'#168 +'m-'#194'm'#170'i'#161#186#21#237#31'm*'#181'hZ4'#218'Z['#163'iS'#178'"'#21 +#195'M5%('#132#220#16'^'#196'^T'#16'e'#223#192'ua'#151'}'#129#221'sv'#15'{' +#222'g'#230'w'#255#152#153#179's'#206'.\'#173#222';'#201#147'9/3s'#190#223 +#231#249'>'#207#239#249#253'~G'#240'%'#28#205#205#205#181'B'#136#133#192'B!' +#196#12#160#6#16'RJ'#0'L'#211''#159#239#142#154#154#26'f'#204#152'A8'#28 +#198'4ML'#211'DJY'#240#218'y'#239'&'#20#143#199#233#237#237#165#175#175#143 +'d2y<'#22#139'm{'#228#145'G'#14#2#185#207'K'#228'3'#19'hnn'#174'UU'#245#247 +#165#165#165#247'4440c'#198#140''#186#186#186 +#24#30#30#222#127#238#220#185'-'#219#183'oo'#7#244#207'J'#228'3'#17'x'#245 +#213'W7'#8'!'#158#155'?'#127'~d'#238#220#185'y'#192#217'X'#140#254'7'#223#228 +#210'?'#255#201#229#189'{'#241#148#151#163#250#253'(~?'#200#177#223'7'#211'i' +#204't'#154#220#200#8'e'#171'W'#19'^'#181#138#240#170'U('#165#165#0'H)9'#127 +#254'<]]]W._'#190#252#171#199#30'{'#236'% '#131#149'''_'#140#192#174']'#187 +'vTTT'#172'_'#178'd'#9#145'H'#4#211'4'#201'D'#163'|'#250#252#243't'#191#244 +#18#138#215#139#191#186#26'OY'#25#184#188#142#148'c$'#236#179#148#146#220#208 +#16#217#161'!L]'#167#252#251#223#167'b'#253'z'#148#210'R'#164#148'$'#18#9#206 +#157';'#199#192#192#192#127'n'#218#180'i#'#144#192#202#143#127#143#192#174']' +#187'v\'#127#253#245#235#151',Y'#130#170#170#152#166#201#167#207'?'#207'''' +#191#253'-'#158'H'#132#192#244#233#8'U'#29#3'^l'#206'Q'#244'^J'#137#212'u2}}' +#228#18#9'*'#30'x'#128#200'}'#247'!'#165'D'#215'u:;;9'#127#254#252'?'#30'z' +#232#161#255#0#226#215'"qU'#2#187'v'#237#218'1s'#230#204#245'K'#151'.'#197'0' +#12'2'#209'('#239#175']K'#162#173#141#210#134#6#132#166#129#157#156#227#188 +'='#193'k9AD'#144#18'i'#24'$;;Qg'#205'b'#242's'#207'!B!'#0'>'#253#244'S:;;' +#223'hjj'#218'x-'#18#234#181'<'#223#216#216#136'a'#24#12#159'<'#201#137#187 +#239#134'\'#142#146'Y'#179#16'B\'#219#235#19#1'/'#2'/'#0'!%'#8#129#183#162#2 +'sp'#144#145#221#187#241',Z'#132#168#168' '#18#137'`'#24'F'#253#178'e'#203'f' +#239#223#191#255'm'#174'R'#161#198#17'x'#245#213'W7TVV>'#190'|'#249'r'#132#16 +#12#159'<'#201#127#127#237'k'#4#175#191#30'Oee'#30#140'4'#205'1P'#166'9'#222 +#179'RZ'#0'm'#19'n'#208#246'5'#238#207#180'@'#0'UU'#137#191#254':'#218#173 +#183'By9'#161'P'#136'L&S___'#31'?z'#244#232#169#137'H'#20#16#176'K'#229'?V' +#172'X'#225#15#6#131'd'#162#209'F'#247#237#195#179'z5'#194#235'%'#24#12#146#203#229#150 +'j'#154#246'_'#237#237#237#3#20'II)`'#163#170#191#159'?'#127'~'#196#169'6' +#239'}'#235'[h'#161#208#132#224'k'#127#242#19'n?t'#136#197#187'wSr'#195#13'c' +#223#219'y!l'#160#197'dK'#234#234'X'#252#198#27',=v'#140#218#159#253'l'#220 +#247#170#223#143'O'#211'H'#252#226#23#24#134#129#199#227'a'#202#148')'#161 +#198#198#198''''#128'2@'#155'0'#2';w'#238#188'3'#28#14'?'#181'|'#249'rL'#211 +#164#243#15#127'`'#232#192#1#2#211#167#143#3'_'#247#243#159'3'#229#235'_'#199 +'4M'#8#4#152#188'j'#21#177#227#199#201#13#13#229'=<.a'#129#146#186':'#230#188 +#240#2#131#217','#209'h'#148#202'E'#139'('#157'1'#131#216#161'Ccr'#2#212'@'#0 +#163#167#7'CQ'#16#179'g'#19#12#6'I&'#147'5'#147'''O>s'#242#228#201#179'@v\'#4 +#132#16'['#231#205#155#151#31#160':'#159'y'#134#224#204#153#19#130#159#188'f' +#13#134'a'#160#235':'#185'\'#142#172#162'Pg_?'#206#235#182#198#3'3gR'#251#204 +'3'#244#13#15#147'H$'#200#229'r'#244#246#246#18#190#235'.f='#254'x'#129#236 +#144#18#223#148')'#152#127#255';'#185#225'at]'#167#178#178#146#27'o'#188'q' +#179#29#5'OA'#4#154#155#155'k'#3#129#192#179#203#150'-'#195'4M>'#217#190#157 +#244#249#243'x'#194'a+A]'#178#185#238#158'{0'#12#163#192'r'#185#28#134#16'DV' +#172'`'#244#189#247#208#163'Q'#11#184#13#222'7s&'#211#183'o'''#154'J'#145'N' +#167#11#238#29#30#30'f'#202'-'#183#224'//'''#254#206';'#249'((B L'#147'\&' +#131'lh'#192#235#245'2::Z'#157'J'#165#14'tuu'#245'9QP'#0#20'Ey'#184#182#182 +'6'#239#253#238#191#252#5#127'u'#245#184'R9u'#237#218'q'#224'u]'#207#147#200 +#170'*S'#183'm'#195'W['#155#247#168#183#182#150#234''''#159'd'#200#238'Hs' +#185'\'#222#178#217','#233't'#154#142#142#14'*'#215#174#165#248#240'D"'#168 +#251#246'a'#196#227#24#134'A('#20#226#182#219'n'#219#0#132#28#231';'#4'V:' +#205'Y'#255#155'o'#226#137'D&'#172'8'#153#254'~L'#211#28#7#222'-'#167#140#162 +'0'#229#137''''#240#214#212#224#173#169'a'#242#19'O'#16'K'#167'I'#165'Rd2'#25 ,#210#233'4'#137'D'#130'D"'#145'o'#179#1#204#254'~'#140'h4oz4'#138#153'L'#162 +#1#218#251#239#163#170'*eee'#132'B'#161'['#128'R'#192#11#160'677'#215#250#253 +#254#167#22',X'#128'a'#24'|'#242#228#147#8'!'#242'-'#130#187'<'#198'O'#158'd' +#242#170'U'#232'0'#14#188#243'^'#215'ur@'#201'W'#190#130#239#142';'#24'L$' +#136#199#227#164#211'i2'#153#12#217'l6'#127#159'i'#154#248#253'~'#230'L'#159 +'N'#203#186'ud.\@'#166#211'y3FG!'#151'CQ'#20#148#21'+'#240'z'#189'D'#163#209 +#138#209#209#209#253#221#221#221#189'@F'#17'B,'#172#170#170#202#247#236#209 +'C'#135'P}'#190#9#7#165#209#142#14'>'#222#180#9#153'L'#230';R7p'#199#187#195 +#195#195#12'%'#147#12#218#158#214'u'#29#211'4Q'#20#5#143#199#131#199#227#193 +#231#243'QZZ'#202#172#234'j'#218#190#249'MRg'#206'X@''0'#245#196#9'TUE'#211 +'4B'#161#16#181#181#181#243#0#31#160'('#192'B'#167#238#199'?'#252#16'OY'#217 +#213#251#27')Itt'#208#222#212#132'L&'#243#218'w'#164#144'N'#167#201'f'#179 +#232#186'N*'#149'"'#149'J'#141#3#238#241'x'#240#218#3#212#212'H'#132#174#239 +'~'#151'TK'#203#196#224#133'@Q'#20#132#16'h'#23'.'#160#170'*%%%'#148#151#151 +#215#219#4'TE'#8'1#'#24#12'"'#165'$'#27#139'YMZ'#145't'#4#133#205'X'#178#189 +#157#246#245#235#201#13#15#147#205'f'#201#229'ry'#25#185'MJ'#137#166'i'#5#192 +#189'^/'#129'@'#128#10#175#151#190#13#27#200#182#183#163'^'#205#243#238#215 +#233'4'#154#166'9S'#214#235#28#2#154#148#178'&'#16#8'`'#154'&'#177'#G'#242'}' +#189'[:'#238#136'dz{'#201#14#12' M'#147#204#189#247'2'#189#185#25#132'('#144 +#146#174#235#150#215'4'#13'M'#211'PU5o'#154#166#17'0M'#6#31'x'#0#189#163#195 +#242#176'5'#16#21#180#198#210#145#175'}VZZP'#22'.'#164#164#164#132'`0Xm'#143 +#5#170#130#189'z '#221'@'#243'O'#25#3#174#199#227'\9}'#154'to/'#210'4'#17'B' +#144'im'#165#251#7'?'#192'g'#3'vH'#0'y'#240#197#17#240#233':'#195'?'#254'1' +#198#217#179'c^V'#213'qQ('#254'\U'#148#188#19#20'E'#1#171#165'P4ly'#20#207 +#164#164#235#156#238#233'!}'#241#162'U'#157#24#27#242#133#16#8'!'#144'R'#230 +'+'#139'#'#155#137'LUU'#200'fQ'#132'@'#170#234#216#243#132'p'#186#1#151#239 +#198#218'q'#9#22'x'#247's'#236'~Pq.r'#170#144#219#251'R'#215#185#210#210'b' +#129'w>'#23'"o'#254'9s'#152#182'c'#7'q'#195' '#147#201#228#19#214'-'#151'b' +#243#148#149#17#249#243#159#241#206#158'='#230'U'#247#217#237#237#226'sa'#4#0 +'PL'#211'<'#159'H$'#144'R'#18'nl'#196#24#29#181'<::J'#252#244'i'#140'x<'#15 +#220#237#253#224#220#185#204#216#185#147#184'a'#144#205'f'#173#198#206#241 +#148#13'~"'#18#30#143#7#127'e%'#229'6'#9#197'-'#21#7#224#4#164'<'#139#22#161 +'i'#154'5Xf2'#3'N'#154'('#134'a\H&'#147'H)Q'#195'aL]'#199#24#29#229#202#153 +'3'#152#153#12#249'X'#185#188'_2o'#30#179'v'#239'&n'#151'QgLP'#138't'#234#246 +#154#155#140#215#235'%PUE'#229'K/'#225#159'3g'#236#251#162#179#226#152#162 +#160#149#149#161#170#170#211'~'#12'`-'#189#152'J.'#151';522'#130#148#146'`C' +#3#153'K'#151#136#127#252'1'#210'NF'#28'}'#218#28'Jo'#186#137#134'7'#222'`' +#196'n'#29#28#240'@A'#18':`'#139#137'8'#145'qHL'#254#235'_'#9'8$'#174'&)U' +#181'$'#167#170#164'R)._'#190'|'#22'kvf('#201'd'#242#228#208#208'P>'#145'#+W' +'"u}'#188#231#129#200#130#5',~'#251'mb'#217','#217'l'#150#130#234'e'#19'p' +#202#167'O'#215'QR'#169#177#170'2'#1#9#143#199#131#175#162#130'i'#175#188'B' +#176#161#1#213')'#185'E'#165#215#183'bE'#254#190#145#145#17'Z[[;'#176#214#141 +#12#165#169#169#169'3'#149'J'#157#137#199#227'H))['#189'z'#226#165#10'!X'#180 +'g'#15#151#18#9'2'#182#180#220#4#156#138#228#241'x'#8#9'A|'#211'&F7o'#134'D' +#2'a'#143#168#5'e'#210#5#144#146#18#166#188#240#2#154'-'#31#183#169#170#138 +#215'&'#144'L&I$'#18#157#199#143#31#239#206#19#0'L]'#215#15#247#244#244'X'#17 +#248#234'WQ#'#145#130#196'u'#14#207#180'i'#232'vt'#138#189#15#224#245'z'#169 +#240#249#242'u'#222#248#228#19'F'#127#250'S'#204'+W'#236#199#137#2'2'#5#249 +'R]]'#160#255'|'#180'"'#145'|'#4#6#6#6#136'F'#163#167#129#148'M'#192'T'#0#217 +#211#211#243#199#139#23'/Z2(-e'#210#134#13#133#206#183#173#231#197#23#153'6m' +'ZA'#25's'#200#4#2#1#166'F"'#12#217'#'#172#3#214''#136'/'#151#203#143#222#138#162#144#222#187#151#196'o~3'#14#188#170 +'i'#248'7nD'#13#135'Q'#20#133#174#174'.'#142#30'='#250#138#13'~'#20'{y%'#239 +#198#3#7#14#156#191#235#174#187#150'h'#154'6+'#28#14#227#187#233'&'#18#255 +#250#23'zo'#239#184#144'_'#222#187#151'@U'#21#245#223#248#6'e'#217',-'#235 +#214#229#251'ya'#155#226#214#187'}'#150#177#24#217#227#199#9#223'y'''#158#178 ,'2R'#175#189'F'#226'w'#191#179#170#146']z'#157#156'Pn'#190#25#239'#'#143' ' +#132#160#179#179#147#150#150#150'w'#183'm'#219#246'7`'#0#24'v'#8#184'sT<'#250 +#232#163#13's'#230#204'yg'#241#226#197#165'~'#191#159'l,F'#207#183#191#141 +#209#215'7'#150#128#238#179#11#220'Dm'#176'S'#203#157#17'VS'#20#171#159'q'#13 +'Xn'#207';'#224'eU'#21#202#139'/B(D<'#30#231#200#145'#'#137'g'#159'}'#246#193 +#195#135#15#159#2'.'#216'Q'#144'n'#9#1#200#167#159'~'#186#253#242#229#203#191 +'jkkC'#215'uKJ'#207'>'#155'_'#199#255'w'#15#183#172#10'>sI'#204#137#150#26#14 +#163#254#250#215'('#246#174'O[['#27'''N'#156'x'#249#240#225#195'g'#129'!'#172 +#10#148'/}'#197'k'#163#242#224#193#131#31#222'q'#199#29#245#186#174#207#157 +'4i'#18#162#162#2#239#178'ed'#222'y'#7'i'#215#244#255#205#138#229'#'#138'fX' +#138'Kf'#5'3'#175#235#174'Cl'#219#134'RW'#135#16#130#150#150#22'>'#250#232 +#163#131'['#182'ly'#25#232#7#6'q-jMD'#0#192'|'#235#173#183#222'Z'#186'ti'#189 +#148'rNyy'#185'Eb'#205#26#244#143'?F'#14#12'Xm'#239'g$'#225#206#7'a'#143#212 +'n'#25':'#4#197#130#5#168'O?m'#145#16#130#142#142#14'>'#248#224#131#131#247 +#223#127#255'S'#192'%,'#237#23'x'#255'j'#4'$'#160#239#223#191#127#255#173#183 +#222':['#215#245#250'p8'#140#240#249#240#172'Y'#131#12#6'1Z['#17'v5) '#3#227 +#128#231#189'k'#131'/ '''#4'"'#20'B'#251#225#15'Q'#31'z'#8#225#243'a'#24#6#29 +#29#29#156':u'#234#224'}'#247#221#247#148#13#188#31#171#242#140#219'r'#154'p' +#127#192'&'#145#219#191#127#255#219'K'#150','#153#157'J'#165#234'KJJ'#208'4' +#13'Q_'#143'r'#247#221'HM'#131#206'N'#208#245#2#29'O'#20#129#9'#'#20#10#161 +#221'{/'#218'/'#127#137'z'#243#205#8'!H$'#18#180#181#181#209#210#210#226#6 +#223#199#231#221#224'p'#147'8p'#224#192#219#245#245#245#241't:'#189#20#240 +#134'B!'#11#252#188'y'#152#171'WcTW['#15#234#235#3#155'H1'#248#252'\B'#8#212 +#219'oG'#251#206'w'#240'45'#161'.Y'#130#240'z'#17'Bp'#225#194#5'ZZZ'#18#135 +#14#29#250'SSS'#211#203'X'#178#233#191#22'x'#248'l'#187#148'*Pr'#207'='#247 +#220#220#216#216#248'DEE'#197#138#201#147''';;('#133#171#15#221#221#168#153 +#12'Zkk'#193',J['#184#16'5'#18#193's'#227#141#227#230#8#131#131#131'\'#188'x' +#145#139#23'/'#190#219#220#220#252#167'C'#135#14#157#5'.c%'#236#23#219#228's' +#29#10#214'2F'#217#198#141#27#215#212#213#213'm'#14#133'B'#11'#'#145#8#145'H' +#4#175#215'[0a'#153#232#181#27't&'#147'app'#144#161#161'!'#162#209#232'GG' +#142#28'ye'#199#142#29#239#2'1'#172'R9'#204#151#181#205'Zt'#173#6#4#128#178 +#149'+W'#206']'#182'l'#217#134'P(tK '#16#184'!'#24#12#18#10#133#8#6#131#4#131 +#193#2#224#206'RK:'#157'ftt'#148'D"'#209#25#141'FO'#239#221#187'w'#207#209 +#163'G'#187#176#6#166'a'#219'R|'#217#27#221#19#220#227#1#252'X'#171#196#165 +#141#141#141'u555'#243'&M'#154'T_RRr] '#16#168'vFbEQ'#200'f'#179#3#169'Tj' +#224#210#165'Kg[[[;'#142#29';'#214'm'#3'M0'#214#219#164#249#191#252#171#193 +'U'#238'U'#177'V'#137'}E'#230#193#138#150#243'|'#137#229#213#28#150'4'#220 +#150#229#255#243#207#30#215'x'#142#130'E'#200'1'#165#232#26#19#11#168'c_'#202 +#223'm'#254#7#31'H'#225'?'#143#171#233'e'#0#0#0#0'IEND'#174'B`'#130 ]); LazarusResources.Add('kmessagebox_warning','PNG',[ #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0'0'#0#0#0'0'#8#6#0#0#0'W'#2#249#135 +#0#0#0#4'gAMA'#0#0#177#142'|'#251'Q'#147#0#0#0' cHRM'#0#0'z%'#0#0#128#131#0#0 +#249#255#0#0#128#232#0#0'u0'#0#0#234'`'#0#0':'#151#0#0#23'o'#151#169#153#212 +#0#0#16'SIDATx'#156'b'#252#255#255'?'#195'P'#6#0#1#196'8'#212'='#0#16'@'#140 +#255#255#253#162#178#137'L'#12#255#127'}b`'#248#243#149#235#255#143'g'#201 +#140#255'~'#9'1'#176#139#207'fd'#23'z'#198#192'&'#4'T@'#221#0#3#8' '#160#7'~' +'S'#213'@'#6'F'#22#160#227'?'#242#253'{'#127'v'#213#159#175'o'#221#255#253 +#249#195#192#202#205#127#134#137'_7'#131#145'K'#246','#181'='#0#16'@'#140#255 +#127#189#167#170#129#192#24'`'#250#247#233#234#178'_'#31#30#134#191'z'#200 +#194#240#235#199'?'#6#9#153'O'#12'\'#162'bg'#153'D'#28'M'#129#10#254'S'#211 +#19#0#1#196#248#255#247#23#170#25#198#192#196#194#240#255#199'S'#231#127#239 +#142#237'y'#241#128#149#225#243#155#255#12#255#255#255'c`'#231#252#205' %' +#255#141#129']T'#167#150'Q'#200#172#133#1'(F-'#0#16'@'#140#255#255'~'#167#154 +'a'#192#144#229#254#255#225#248#170'/O'#31'z='#127#192#1#228#255#1#134#247'_' +#134#31'_'#255'3'#8#137'}c'#144'P`'#248#193'$'#19#166#199#200'&p'#155#225#223 +'_'#170#216#8#16'@'#140#255#169#18#26#160'$'#193#200#240#255#227#185#202#223 +'oN'#183'='#190#201#205#240#29#24#177#194#226#223#25'8y'#127'3<'#186#206#204 +#192#204#252#151'AQ'#227#19#3#135#164'a/'#163#128'Q'#9#3'8'#239'Q'#158#148#0 +#2#8#152#137#127'Rl'#8#168#228#1#134'('#215#255#215#27'.'#189'{'#244'Q'#249 +#217']6'#6#14'`'#178#145'Q'#253#202#192#198#254#151#225#254#21#22#134#15#175 +#24#25#248#133'~0'#200#171#255#248#206'"'#19#16#198#196#175#189#133#129#10#5 +#8'@'#0#1#243#192'G*x'#128#145#241#255#231's'#157'?^\*}|'#131#157#225#251'g' +#6#6'i'#213'o'#192'd'#243#11#152#220#255'2|z'#195#0#246#196#223'_'#255#24#148 +'4'#223'1'#8'**'#31'`'#146#137'r'#4#197#26#165#177#0#16'@'#20'Vd'#144#164#195 +#240#251#181#254#191#23#203#207'?'#185#193#200#248#230#9#11#3#23#207#31#6'E' +#189#175#12#204#140#127#128#17#243#151#129#153#233#15#195#147#219#204#12'Oo' +#179#0'c'#225''''#131#138#238#151#127'l'#202'I!'#140#252#186#235')r='#16#0#4 +#16'0'#6#222'R'#162#29'X'#242#176'1'#252#255'pp'#233#215''''#151#163#238'_' +#230#6':'#248#31#131#130#246'W'#6#30#254'_'#192#20#242#23#24#3#127#24#152#128 +'%'#231#143'/'#255#25#174#159'd'#3'f'#232#127#12#178'*'#31#25'd5'#249#158'2+' +#231#154'1'#176#240''#3#203'|P'#12#127#2'::'#194#229#11'C'#132#245'w'#160#131#25#193'y' +#129#153#233#31#195#205#211#172#12#215#206#176'2'#240#240#254'd'#176't|'#197 +' `'#146#222#200'$'#23#222#0#236#12#17#237'$'#128#0'"'#161'1'#7#180#248#223 +'O'#222#255'/'#250#14#188#188'r'#215#232#198'I'#1'`'#217#254#151'A'#223#241 ,'#'#3#159#240'O'#134'?@G3'#128'='#240#15#24#3#127#24'*'#166'q3'#188#251#248 +#23#236#216#143'_'#254'2'#196#184#127'e'#136#178#249#9#245#0'0'#131#255#135 +#196#194#201']'#28#12'o'#158'1'#2#243#194'{'#6'MK'#225#7','#134'}&'#140'\' +#146'o'#137'm'''#1#4#16#176'&~C'#156#251#129#25#247#255#151#179'Q'#127#159 +#205'^zq'#143#0'0#23'#200'i~eP1'#250#4',u'#254#131'K'#23'`y'#9#172#11#254'2|' +#255#255#155#161'l2'#23#195#171#183#160#192#249#203#240#245#251#127#134'4' +#191'/'#12'A'#166'@'#15#128#202#12#160'ZP'#5#199#202#242#15'X'#172'21'#156 +#216#201#14'.'#197#172#29#159'3HX'#199#205'a'#209#173'Me'#0#213'OD4s'#0#2#8 +#152#132#136#201#3'L'#160#246#142#236#255#23#147#247'<<'#247'Z'#237#206#25'n' +'`e'#245#139#193#208#229#29#3'+'#176#181#249#15#234#1'P'#195#13#212#254#249 +#193#240#139#161'l'#10#15#195#227#151#160'x'#3#134#244#175#191#12#197#17#159 +#24'\5'#255'0|'#7#246#13#192#181'3'#16#131#250#10#127#129#153#250#248#14'v' +#134''''#192'ZZ'#30#216#0#180't'#254#246#143#195'n'#133#21#147#136#201'Ip' +#177'K'#160'X'#5#8' "<'#192#8#238#231#254#127#179'r'#210#151';'#235's'#207 +#237#22#5#182'6'#255#129'3'#174#130#238'7p'#11#19'\'#146#129#162#28#152#132 +#152#128#201#234'7'#176'F.'#159#206#195'p'#251#17#3'8'#185#252#7'f'#228#150 +#228#143#12#198#146'@'#15'|'#7#170#253#11'R'#11#245'00'#198#222'>g`8'#176#145 +#11',l'#227#242#130'A'#214'!f9'#155'i_'#28#184#253'A '#22#0#2#136#241#255#143 +#135#4'<'#0#204#184#255#190#137#254#127#214'u'#227#206#241'oB'#183#206'r3' +#136#202'|g0p'#2#182#161#24'A'#25#247#15#164#214#5#213'V'#127#255#131'K'#157 +#191#172#191#24#170#128#153#248#226'-'#144';'#127#2#165#191'2'#204')~'#198 +#160#200#245#135#225#231'w'#144'zh'#183#248'?#'#216'},,'#12#12'G'#183'q2'#220 +#184#192#206' &'#245#155#193#197#247#29#3#159']O*'#139'R'#196#28'B]^'#128#0#2 +#22#163#248'jb&'#144'-'#204#255#159'M'#157#254#254#230#225#212#139#251#5#192 +'=-}'#135#247#12#18#138#192'&'#195#175#127#208#218#21#218'p'#3':'#134#9#152 +#254#255#179'|b'#200#155#192#204'p'#224#244'o'#134#31'?'#190'0'#240'q'#254'd' +#216#213#13#236#7'0'#176'3'#252#254#205#4'v8'#24#255#131'$s'#22'`'#24#189'|' +#194#202'ph+'''#195#247'oL'#12#182#206'o'#25'T'#237','#142#177#185'n'#183#5 +#150'|'#255#24#240#212'U'#0#1#196#248#255#231'k'#28'R@'#147#153#185#24#254 +#127#191'c'#249#239'~'#195#177#139#251'8'#128#237'y'#14#6'a)`'#197#227#242#22 +#156'T'#254#131'C'#30#18#154#160'&'#201#255'_'#159#25#24#127#189'f`d'#251#192 +#144#212#205#205#176#227'8;'#3'++#'#131#134#252#31#134#141'-'#159#24'X'#191 +#177#3'c'#132#17'%'#244'!'#30'a'#4#246#220#254'3\>'#197#206'p'#10'h'#143#152 +#212#31#6'G'#239'O'#12#2#206'S'#147'X'#148'#'#231#255#255#5'j1c'#207#11#0#1#4 +'l'#204#225#242#0'3'#208'Q_'#153#24'^'#204#218#240#242#242'9'#223#243#251#249 +#129#142#254#195'`'#234#254#158#129#15'X'#243#130'K'#30#176#195#191'3'#128#2 +#225#255#175#15#192'T'#244#3#152'1'#255'3'#176'r'#255'e'#200#158#202#205#176 +'n?'''#176'Tb`p4'#254#201#176#160#20'XW|d'#7'F'#20#180#21#11#210#251#31#234 +#25#160#7'@'#234#190'~bb'#216#179#142#139#225#195';&'#6'=`'#221'b'#228'$'#248 +#134#195'i'#133#9#19#159#202'C\'#197'*@'#0#1#251#3'8*'#13'f`'#177#249'vW'#202 +#183#235'='#179#207#238#22'dx'#243#148#137'AA'#235'+'#131#158'-'#180#216#252 +#11#236#176#252'z'#7'q'#252#239'o'#208#16'b'#2'z'#0#24#154#192#142'|'#225',.' +#134#229';9'#193#238#139'r'#255#198'0!'#253';'#195#247'7'#28#144'J'#22'9'#244 +#161#158#0#137#131#242#194#221'k'#172#12''''#246'r'#2'{u'#255#24#156'=^3'#136 +#184'4'#213#179#234#151'7'#225'jb'#0#4#16#208#3#216'2'#9#208#208#191#223#152 +#254#223#171#188#244#224#244'}'#237#11#7#5#128#6#254'f0'#247#252#8'i'#235#255 +'x'#15#196#160#142#212'W'#184#195#25#224#14'b'#0#171')_'#192#193'0g'#19#23'8' +#191#150'F'#127'a'#168#142#252#201#240#249#25''''#196'xP'#218'g'#128#228#1 +#184#7#128'4$n'#24#25#246'm'#230'`x|'#143#133'AE'#227#7#131#149'+'#235'w.' +#231#5#14#204#130#26#167#254#255#197#244#4'@'#0'1'#130#186'|'#152#162#192#228 +#243'|I'#253#199#11#179#26#206#236#21'`'#248#248#134#145'A'#223#238'+'#131 +#162#230#7#134'_'#159#158#3'C'#254'=$'#243#130'39'#3''#253'c'#248#254#147#145'AU'#144#137#225#247#7#14 +#144'W!j'#193#201#8'B'#255#255#135#233#25'P,||'#203#196#176'k#'#7#176#24'fd0' ,'6'#253#196#160'k'#171#240#144#211#127#183'>#'#135#240'GH,@'#244#3#4#16#176 +'-'#244#9#225' `'#177#249#239#221'a'#255#31#23#235'V'#156#217#197#204#241#244 +'.;'#131#164#244's'#6's'#167#219#192'J'#246'?R'#146'A'#3#255#145'iFhFeb'#224 +#230#254#3')]>'#178'0'#252#133#217#137#150'q'#17#201#143#17#137#15#244#4#144 +#186'v'#145#133#225#220#9'6'#6'!'#225#191#12'N'#192'f'#139#128#215#204'tV' +#141#184'Y'#200#173'U'#128#0'b'#252#255#253#25#148#5#138#190#191#140#127'o' +#212#29'|z'#230#140#237#201'='#162#192#162#241#29#131#169#253']'#6')'#197'_' +#192'~.'#22#199#195#210'24d'#255'#'#197#6''''#223'o'#134#215#192#214#230'O`' +#4'K'#242'22'#252#254#194#10','#9#153#161#161#207#128#164#22'5'#255#192#138 +'UFFH'#251'p'#207#22'`k'#245#21#19#131#174#222#23'`'#203'W'#241'.'#151#203',' +'7&>'#185'{'#224#202#19#168#24' '#128#16'I'#8#148't^'#239#13#254'~'#186'p' +#205#241#157#252#12#143#175#255'`'#208#212#187#207'`h'#255#141#225#215'/&'#6 +'F'#140#14'7#j3'#5#230#25#160#185'\'#130#191#24#214#159'gdh'#152#195#11#204#3 +#140#12'%Q_'#24#178#189'~3|~'#194#13#14'ed'#143'b'#203#7#176#216'a'#5'f'#153 +#155'WX'#24'N'#29'e'#3'WtN'#14#175#24'$'#157'3'#230's8LL'#130'F3'#3'@'#0'1' +#254#255#246#20#210'Q'#249#247'S'#240#247#165#194'c'#183#143#220#213'8w'#144 +#131#225#239#215'g'#12#206'a'#31#24#132#196#255'AjO,'#30#128#187#28#158#137 +#129#169#144#229'?'#195'_'#254#239#12#190#21#130#12#151#238#178'0'#176#3#249 +','#172#12#12#139#170'?2'#216'H'#176'1|'#251#10#141#201#255#200#21#26#3#188 +'FF'#196#6'$'#193#130#236'>'#188#23'X|'#134'g7'#223'3'#24'X'#127'`'#208#183#254#9'l'#187 +#16'1J'#0'/'#22#129#161#198#254#143#225#29#235'w'#6#251'la'#134'o'#192#208#7 +#133#226#171#247'L'#12#149#177'_'#24'j'#253#254#1#139'd6D'#0#160#20#161#200 +#177#193#0#175'#@'#149#219#211#199'L'#12#135#246#176#1'['#2#12#12#214'V'#31 +#24#20#28'|7q8'#244#5#254'gb'#249#7#16'@'#192#138#236#27#176#216'|'#162#241 +#243'd'#218#174'K'#251'^'#202'^8'#248#135'AH'#232'3'#131'k'#196'W'#176#230 +#127#136#12#143#195#225'H'#17#1#138#1'`d2'#138'|c'#136'l'#225'e'#216'}'#146 +#131#129#21#200#151#145#248#195#176#176#18'X'#146#240#0'K'#149'oL'#224#252 +#198#0'u$f'#145#138#26' 0'#185#147'GY'#25#238#222'bf'#144#149#251#205'`k'#247 +#147#129'7`'#181#11#139#130#243'^'#128#0#2'w)'#255#156'/'#157#255#234#212#178 +#132#189#27#4#25#190#190#251#204'`'#238#242#141'A'#195#16#17#250#132#221#207 +#8#181#25#146#12'8x'#255'0'#220#250#244#155'a'#9'0'#234#191#0'c!'#194#17'X' +#163#202'33|~'#193#137#208#11#205#172#16#14#154#227'a-U'#168#28#168'X'#253 +#252#145#145'a'#255'n6`'#177#202#192'`'#1',V'#149#157#188#183's'#216#183#135 +#2#4#16#227#223'w'#23#149'~'#31#139#187'pz'#215'g'#222#139'G'#254'2'#168'h' +#127'g'#176#241#250#14#12'y'#228'l'#139#173'S'#129#228'-'#228#250#128#1#146#1 +#217'9'#255'1'#176#3#155#31#224'N'#229'WV`3'#156#133#1'6'#152#141'3'#217' {' +#0'-c'#131'b'#242#204'i'#22#134'k'#151#153#24#248#5#128#25#218#14#216'Z'#181 +'J'#171#0#8' '#198#159#135#194#214#222';|<'#232#216'.v'#160#175#127'0'#184 +#135'}e'#16#151#254#195#240#7#20#250#140'0w'#226#240#0'J'#249#143#164#10#173 +#161#134#226#207#255#140'X'#28#138#234#248#255#176#182#17#146#25#160'T'#247 +#253#27'0C'#31'dax'#254#140#137#193#196#232';'#131#166#185#210'E'#128#0'b' +#252#178'L'#242#235#177'='#28'\'#183'/'#253'e'#224#19#248#195#160#162#243#27 +'4_'#129#176#152#24#15#160#171#192'P'#142#233'Y'#6#168'g'#254'#'#139#161#201 +'!'#2#3'B'#129#154#24#175#128'u'#194#227'GL'#12'""'#255#24#28#236#254'|'#6#8 +' '#198'O'#243#249'~'#30#221#203#205'v'#255'&3'#216#225#191#177#142#177'b' +#203#5#216'<'#133#3#16'Q'#144'1'#18#161#14#236#9'`'#177#12'j'#205#8#240#3#27 +'z6?'#191#1#4#16#227#247#195#25's'#222#157'Z'#144#252#230'5'#27#195#175#159 +#12'h!O'#2#192#22#27#255#209#243#9'j'#168'"+'#254#143#174#30#222#232'D'#196 +#30','#169#177#0#163'B'#136#239#27#131#176#182#221'Q'#128#0#2#22#163#223#153 +#127#158','#169#248#247#250#152')'#19#167'0/0'#22#152'P'#156#131'3'#9#161'Y' +#136#236#30#228'b'#16'Y;,'#189#195'='#129#240#16#182#218#25#226'hF$'#243'@' +#28#214#127#255#190#190#249#193#200#175'z'#147#221',{*@'#0#13#249#197#30#0#1 +'4'#228'='#0#16'`'#0#215#29#169#167#169#214#253#188#0#0#0#0'IEND'#174'B`'#130 ]); tomboy-ng_0.34-1/kcontrols/source/klog.pas0000644000175000017500000002074714125207534020407 0ustar dbannondbannon{ @abstract(This file is part of the KControls component suite for Delphi and Lazarus.) @author(Tomas Krysl) Copyright (c) 2020 Tomas Krysl

License:
This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } unit klog; // lowercase name because of Lazarus/Linux {$include kcontrols.inc} {$WEAKPACKAGEUNIT ON} interface uses StdCtrls, Classes, ComCtrls, ExtCtrls, KFunctions; type TKLogDirection = ( ldAddTop, ldAddBottom ); const cHoverTimeDef = 1000; cLogDirectionDef = ldAddTop; cLogMaskDef = [lgAll]; cStatusPanelDef = -1; // SimpleText property type TKLogMask = set of TKLogType; TKLogEvent = procedure(Sender: TObject; Code: TKLogType; const Text: string) of object; TKLogProc = procedure(Code: TKLogType; const Text: string); TKLogEventObject = class(TObject) private FCode: TKLogType; FText: string; public constructor Create; property Code: TKLogType read FCode write FCode; property Text: string read FText write FText; end; TKLogEventObjects = class(TKObjectList) private function GetItem(Index: Integer): TKLogEventObject; procedure SetItem(Index: Integer; const Value: TKLogEventObject); public property Items[Index: Integer]: TKLogEventObject read GetItem write SetItem; default; end; TKLog = class(TComponent) private FEvents: TKLogEventObjects; FHoverTime: Cardinal; FInternalStorage: Boolean; FListBox: TListBox; FLogDirection: TKLogDirection; FLogMask: TKLogMask; FLogText: string; FStatusBar: TStatusBar; FStatusCode: TKLogType; FStatusPanel: Integer; FStatusTimer: TTimer; FStatusText: string; FOnLog: TKLogEvent; procedure SetStatusText(const Value: string); procedure SetInternalStorage(const Value: Boolean); protected procedure ClearStatusBar; function LogTypeToText(Code: TKLogType): string; procedure SetHoverTime(Value: Cardinal); procedure StatusLogTimer(Sender: TObject); procedure Notification(AComponent: TComponent; Operation: TOperation); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Clear; procedure Log(Code: TKLogType; const Text: string); procedure LogStr(const BracketText, Text: string; Code: TKLogType = lgNone); procedure StatusLog(Code: TKLogType; const Text: string); procedure StatusLogStr(const BracketText, Text: string); published property Events: TKLogEventObjects read FEvents; property HoverTime: Cardinal read FHoverTime write SetHoverTime default cHoverTimeDef; property InternalStorage: Boolean read FInternalStorage write SetInternalStorage; property ListBox: TListBox read FListBox write FListBox; property LogDirection: TKLogDirection read FLogDirection write FLogDirection default cLogDirectionDef; property LogMask: TKLogMask read FLogMask write FLogMask default cLogMaskDef; property LogText: string read FLogText; property StatusBar: TStatusBar read FStatusBar write FStatusBar; property StatusCode: TKLogType read FStatusCode; property StatusPanel: Integer read FStatusPanel write FStatusPanel default cStatusPanelDef; property StatusText: string read FStatusText write SetStatusText; property OnLog: TKLogEvent read FOnLog write FOnLog; end; implementation uses SysUtils, KRes; { TLogEventObject } constructor TKLogEventObject.Create; begin FCode := lgNone; FText := ''; end; { TKLogEventObjects } function TKLogEventObjects.GetItem(Index: Integer): TKLogEventObject; begin Result := TKLogEventObject(inherited GetItem(Index)); end; procedure TKLogEventObjects.SetItem(Index: Integer; const Value: TKLogEventObject); begin inherited SetItem(Index, Value); end; { TKLog } constructor TKLog.Create(AOwner: TComponent); begin inherited; FHoverTime := cHoverTimeDef; FInternalStorage := False; FListBox := nil; FEvents := TKLogEventObjects.Create; FLogDirection := cLogDirectionDef; FLogMask := cLogMaskDef; FLogText := ''; FStatusBar := nil; FStatusPanel := cStatusPanelDef; FStatusTimer := TTimer.Create(Self); FStatusTimer.OnTimer := StatusLogTimer; FStatusText := ''; FStatusCode := lgNone; FOnLog := nil; end; destructor TKLog.Destroy; begin FListBox := nil; FEvents.Free; FStatusBar := nil; FStatusTimer.Free; inherited; end; procedure TKLog.Clear; begin if FListBox <> nil then FListBox.Clear; FStatusText := ''; ClearStatusBar; end; procedure TKLog.ClearStatusBar; begin if FStatusBar <> nil then begin if FStatusPanel < 0 then FStatusBar.SimpleText := '' else if FStatusPanel < FStatusBar.Panels.Count then FStatusBar.Panels[FStatusPanel].Text := ''; end; end; function TKLog.LogTypeToText(Code: TKLogType): string; begin Result := ''; if [Code, lgAll] * FLogMask <> [] then case Code of lgError: Result := sLogError; lgWarning: Result := sLogWarning; lgNote: Result := sLogNote; lgHint: Result := sLogHint; lgInfo: Result := sLogInfo; lgInputError: Result := sLogInputError; lgIOError: Result := sLogIOError; end; end; procedure TKLog.Log(Code: TKLogType; const Text: string); var S: string; begin S := LogTypeToText(Code); if (S <> '') or (Code = lgNone) then LogStr(S, Text, Code); end; procedure TKLog.LogStr(const BracketText, Text: string; Code: TKLogType); var Event: TKLogEventObject; begin if BracketText <> '' then FLogText := Format('%s: [%s] %s', [FormatDateTime('dd.mm.yy hh:nn:ss', Now), BracketText, Text]) else FLogText:= Format('%s: %s', [FormatDateTime('dd.mm.yy hh:nn:ss', Now), Text]); if FListBox <> nil then begin if FLogDirection = ldAddTop then begin FListBox.Items.Insert(0, FLogText); if not FListBox.MultiSelect then FListBox.ItemIndex := 0; end else begin FListBox.Items.Add(FLogText); if not FListBox.MultiSelect then FListBox.ItemIndex := FListBox.Items.Count - 1; end end; if FInternalStorage then begin Event := TKLogEventObject.Create; Event.Code := Code; Event.Text := FLogText; if FLogDirection = ldAddTop then FEvents.Add(Event) else FEvents.Insert(0, Event) end; if Assigned(FOnLog) then FOnLog(Self, Code, FLogText); end; procedure TKLog.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if Operation = opRemove then if AComponent = FListBox then FListBox := nil else if AComponent = FStatusBar then FStatusBar := nil; end; procedure TKLog.SetHoverTime(Value: Cardinal); begin if Value <> FHoverTime then begin FHoverTime := Value; FStatusTimer.Interval := FHoverTime; end; end; procedure TKLog.SetInternalStorage(const Value: Boolean); begin if Value <> FInternalStorage then begin FInternalStorage := Value; FEvents.Clear; end; end; procedure TKLog.SetStatusText(const Value: string); begin if (Value <> FStatusText) and (Value <> '') then begin FStatusText := Value; if FStatusBar <> nil then begin if FStatusPanel < 0 then FStatusBar.SimpleText := FStatusText else if FStatusPanel < FStatusBar.Panels.Count then FStatusBar.Panels[FStatusPanel].Text := FStatusText; end; FStatusTimer.Enabled := False; FStatusTimer.Enabled := True; end; end; procedure TKLog.StatusLog(Code: TKLogType; const Text: string); var S: string; begin S := LogTypeToText(Code); if (S <> '') or (Code = lgNone) then begin FStatusCode := Code; StatusLogStr(S, Text); end; end; procedure TKLog.StatusLogStr(const BracketText, Text: string); begin if BracketText <> '' then FStatusText := Format('[%s] %s', [BracketText, Text]) else FStatusText := Text; if FStatusBar <> nil then begin if FStatusPanel < 0 then FStatusBar.SimpleText := FStatusText else if FStatusPanel < FStatusBar.Panels.Count then FStatusBar.Panels[FStatusPanel].Text := FStatusText; end; FStatusTimer.Enabled := False; FStatusTimer.Enabled := True; end; procedure TKLog.StatusLogTimer(Sender: TObject); begin FStatusTimer.Enabled := False; FStatusText := ''; FStatusCode := lgNone; ClearStatusBar; end; end. tomboy-ng_0.34-1/kcontrols/source/kmemo.pas0000644000175000017500000163074214125207534020566 0ustar dbannondbannon{ @abstract(This file is part of the KControls component suite for Delphi and Lazarus.) @author(Tomas Krysl) Copyright (c) 2020 Tomas Krysl

License:
This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } unit kmemo; // lowercase name because of Lazarus/Linux {$include kcontrols.inc} {$WEAKPACKAGEUNIT ON} interface uses {$IFDEF FPC} LCLType, LCLIntf, LMessages, LCLProc, LResources, {$ELSE} Windows, Messages, {$ENDIF} SysUtils, Classes, Graphics, Controls, Contnrs, Types, ActnList, ExtCtrls, StdCtrls, Forms, KFunctions, KControls, KGraphics, KEditCommon; const { Minimum for the @link(TKCustomMemo.UndoLimit) property. } cUndoLimitMin = 100; { Maximum for the @link(TKCustomMemo.UndoLimit) property. } cUndoLimitMax = 10000; { Default value for the @link(TKCustomMemo.UndoLimit) property. } cUndoLimitDef = 1000; { Minimum for the @link(TKCustomMemo.ScrollPadding) property. } cScrollPaddingMin = 0; { Maximum for the @link(TKCustomMemo.ScrollPadding) property. } cScrollPaddingMax = 1000; { Default value for the @link(TKCustomMemo.ScrollPadding) property. } cScrollPaddingDef = 30; { Minimum for the @link(TKCustomMemo.ScrollSpeed) property. } cScrollSpeedMin = 50; { Maximum for the @link(TKCustomMemo.ScrollSpeed) property. } cScrollSpeedMax = 1000; { Default value for the @link(TKCustomMemo.ScrollSpeed) property. } cScrollSpeedDef = 100; { Default value for the @link(TKMemoColors.BkGnd) color property. } cBkGndDef = clWindow; { Default value for the @link(TKMemoColors.InactiveCaretBkGnd) color property. } cInactiveCaretBkGndDef = clBlack; { Default value for the @link(TKMemoColors.InactiveCaretSelBkGnd) color property. } cInactiveCaretSelBkGndDef = clBlack; { Default value for the @link(TKMemoColors.InactiveCaretSelText) color property. } cInactiveCaretSelTextDef = clYellow; { Default value for the @link(TKMemoColors.InactiveCaretText) color property. } cInactiveCaretTextDef = clYellow; { Default value for the @link(TKMemoColors.SelBkGnd) color property. } cSelBkGndDef = clGrayText; { Default value for the @link(TKMemoColors.SelBkGndFocused) color property. } cSelBkGndFocusedDef = clHighlight; { Default value for the @link(TKMemoColors.SelText) color property. } cSelTextDef = clHighlightText; { Default value for the @link(TKMemoColors.SelTextFocused) color property. } cSelTextFocusedDef = clHighlightText; { Index for the @link(TKMemoColors.BkGnd) color property. } ciBkGnd = TKColorIndex(0); { Index for the @link(TKMemoColors.InactiveCaretBkGnd) color property. } ciInactiveCaretBkGnd = TKColorIndex(1); { Index for the @link(TKMemoColors.InactiveCaretSelBkGnd) color property. } ciInactiveCaretSelBkGnd = TKColorIndex(2); { Index for the @link(TKMemoColors.InactiveCaretSelText) color property. } ciInactiveCaretSelText = TKColorIndex(3); { Index for the @link(TKMemoColors.InactiveCaretText) color property. } ciInactiveCaretText = TKColorIndex(4); { Index for the @link(TKMemoColors.SelBkGnd) color property. } ciSelBkGnd = TKColorIndex(5); { Index for the @link(TKMemoColors.SelBkGndFocused) color property. } ciSelBkGndFocused = TKColorIndex(6); { Index for the @link(TKMemoColors.SelText) color property. } ciSelText = TKColorIndex(7); { Index for the @link(TKMemoColors.SelTextFocused) color property. } ciSelTextFocused = TKColorIndex(8); { Maximum color array index. } ciMemoColorsMax = ciSelTextFocused; { Specifies invalid or unassigned numbering list identifier. } cInvalidListID = -1; { Default step for horizontal scrolling. } cHorzScrollStepDef = 4; { Default step for vertical scrolling. } cVertScrollStepDef = 10; { Threshold for starting a block dragging operation by mouse. } cMouseDragThreshold = 5; { Default value for the @link(TKMemo.Height) property. } cHeight = 200; { Default value for the @link(TKMemo.Width) property. } cWidth = 300; { Default value for the @link(TKMemo.MaxWordLength) property. } cMaxWordLengthDef = 50; { This is the character for paragraph visualisation. } cNewLineChar = #$B6; { This is the character for space visualisation. } cSpaceChar = #$B7; { This is the character for tab visualisation. } cTabChar = #$2192; { These are Bullet Characters. } cTriangleBullet = #$2023; cRoundBullet = #$2022; cArrowTwoBullet = #$21A6; // https://en.wikipedia.org/wiki/Arrows_(Unicode_block) cArrowOneBullet = #$21A3; // https://en.wikipedia.org/wiki/Arrows_(Unicode_block) cCircleBullet = #$2218; // https://en.wikipedia.org/wiki/Mathematical_Operators_(Unicode_block) { Default characters used to break the text words. } cDefaultWordBreaks = [cNULL, cSPACE, '/', '\', ';', ':', '(', ')', '[', ']', '.', ',', '?', '!']; { Format for clipboard operations. } cRichText = 'Rich Text Format'; { Default value for the @link(TKMemo.Options) property. } cKMemoOptionsDef = [eoGroupUndo, eoScrollWindow]; type TKCustomMemo = class; TKMemoLineIndex = type Integer; TKMemoTotalLineIndex = type Integer; TKMemoBlockIndex = type Integer; TKMemoSelectionIndex = type Integer; TKMemoWordIndex = type Integer; TKMemoLinePosition = ( eolInside, eolEnd ); TKMemoBlockPosition = ( { Block is placed in the text. } mbpText, { Block has a position relative to an anchor. } mbpRelative, { Block has absolute position in the document. } mbpAbsolute ); { Declares memo states - possible values for the @link(TKCustomHexEditor.States) property (protected). } TKMemoState = ( { Caret is created. } elCaretCreated, { Caret is visible. } elCaretVisible, { Caret is being updated. } elCaretUpdate, { Ignore following WM_CHAR message. } elIgnoreNextChar, { Buffer modified. } elModified, { Mouse captured. } elMouseCapture, { Mouse captured and dragging a block. } elMouseDrag, { Mouse captured and ready for dragging a block. } elMouseDragInit, { Overwrite mode active. } elOverwrite, { Content is being printed or previewed. } elPrinting, { Read only editor. } elReadOnly ); { Hex editor states can be arbitrary combined. } TKMemoStates = set of TKMemoState; TKMemoUpdateReason = ( { recalculate line info and extent. } muContent, { continue previous line info and extent calculation. } muContentAddOnly, { recalculate extent. } muExtent, { selection changed. } muSelection, { selection changed and scroll operation is required to reflect the change. } muSelectionScroll ); TKMemoUpdateReasons = set of TKMemoUpdateReason; TKMemoIndexObject = class(TKObject) private FIndex: Integer; public constructor Create; override; procedure Assign(ASource: TKObject); override; function EqualProperties(ASource: TKObject): Boolean; override; property Index: Integer read FIndex write FIndex; end; TKMemoIndexObjectList = class(TKObjectList) private function GetItem(Index: Integer): TKMemoIndexObject; procedure SetItem(Index: Integer; const Value: TKMemoIndexObject); public procedure AddItem(AValue: Integer); procedure SetSize(ACount: Integer); virtual; property Items[Index: Integer]: TKMemoIndexObject read GetItem write SetItem; default; end; TKMemoIndexObjectStack = class(TStack) public function Push(AObject: TKMemoIndexObject): TKMemoIndexObject; function Pop: TKMemoIndexObject; function Peek: TKMemoIndexObject; procedure PushValue(Value: Integer); function PopValue: Integer; end; TKMemoDictionaryItem = class(TKObject) private FIndex, FValue: Integer; public constructor Create; override; procedure Assign(ASource: TKObject); override; function EqualProperties(ASource: TKObject): Boolean; override; property Index: Integer read FIndex write FIndex; property Value: Integer read FValue write FValue; end; TKMemoDictionary = class(TKObjectList) private function GetItem(Index: Integer): TKMemoDictionaryItem; procedure SetItem(Index: Integer; const Value: TKMemoDictionaryItem); public procedure AddItem(AIndex, AValue: Integer); function FindItem(AIndex: Integer): TKMemoDictionaryItem; function GetValue(AIndex, ADefault: Integer): Integer; procedure SetValue(AIndex, AValue: Integer); property Items[Index: Integer]: TKMemoDictionaryItem read GetItem write SetItem; default; end; TKMemoParaNumbering = (pnuNone, pnuTriangleBullets, pnuBullets, pnuCircleBullets, pnuArrowOneBullets, pnuArrowTwoBullets, pnuArabic, pnuLetterLo, pnuLetterHi, pnuRomanLo, pnuRomanHi); // punBullets retained for compatibility with previous versions of KMemo TKMemoNumberingFormatItem = class(TKObject) private FLevel: Integer; FText: TKString; public constructor Create; override; procedure Assign(ASource: TKObject); override; property Level: Integer read FLevel write FLevel; property Text: TKString read FText write FText; end; TKMemoNumberingFormat = class(TKObjectList) private function GetItem(Index: Integer): TKMemoNumberingFormatItem; procedure SetItem(Index: Integer; const Value: TKMemoNumberingFormatItem); function GetLevelCount: Integer; public procedure AddItem(ALevel: Integer; const AText: TKString); procedure Defaults(ANumbering: TKMemoParaNumbering; ALevelIndex: Integer); procedure InsertItem(AAt, ALevel: Integer; const AText: TKString); property Items[Index: Integer]: TKMemoNumberingFormatItem read GetItem write SetItem; default; property LevelCount: Integer read GetLevelCount; end; TKMemoListLevels = class; TKMemoListLevel = class(TKObject) private FFirstIndent: Integer; FNumbering: TKMemoParaNumbering; FNumberingFont: TFont; FNumberingFormat: TKMemoNumberingFormat; FNumberStartAt: Integer; FLeftIndent: Integer; FLevelCounter: Integer; procedure SetNumbering(const Value: TKMemoParaNumbering); procedure SetNumberStartAt(const Value: Integer); procedure SetFirstIndent(const Value: Integer); procedure SetLeftPadding(const Value: Integer); protected FNumberingFontChanged: Boolean; procedure FontChanged(Sender: TObject); procedure Changed; virtual; public constructor Create; override; destructor Destroy; override; procedure Assign(ASource: TKObject); override; property LevelCounter: Integer read FLevelCounter write FLevelCounter; property FirstIndent: Integer read FFirstIndent write SetFirstIndent; property LeftIndent: Integer read FLeftIndent write SetLeftPadding; property Numbering: TKMemoParaNumbering read FNumbering write SetNumbering; property NumberingFont: TFont read FNumberingFont; property NumberingFontChanged: Boolean read FNumberingFontChanged; property NumberingFormat: TKMemoNumberingFormat read FNumberingFormat; property NumberStartAt: Integer read FNumberStartAt write SetNumberStartAt; end; TKMemoList = class; TKMemoListLevels = class(TKObjectList) private FParent: TKMemoList; function GetItem(Index: Integer): TKMemoListLevel; procedure SetItem(Index: Integer; const Value: TKMemoListLevel); public constructor Create; override; procedure Changed(ALevel: TKMemoListLevel); virtual; procedure ClearLevelCounters(AFromLevel: Integer); virtual; property Items[Index: Integer]: TKMemoListLevel read GetItem write SetItem; default; property Parent: TKMemoList read FParent write FParent; end; TKMemoListTable = class; TKMemoList = class(TKObject) private FID: Integer; FLevels: TKMemoListLevels; protected procedure ParentChanged; override; public constructor Create; override; destructor Destroy; override; procedure Assign(ASource: TKObject); override; procedure LevelChanged(ALevel: TKMemoListLevel); virtual; property ID: Integer read FID write FID; property Levels: TKMemoListLevels read FLevels; end; TKMemoListChangedEvent = procedure(AList: TKMemoList; ALevel: TKMemoListLevel) of object; TKMemoListTable = class(TKObjectList) private FOnChanged: TKMemoListChangedEvent; function GetItem(Index: Integer): TKMemoList; procedure SetItem(Index: Integer; const Value: TKMemoList); protected FCallUpdate: Boolean; procedure CallAfterUpdate; override; procedure CallBeforeUpdate; override; procedure DoChanged(AList: TKMemoList; ALevel: TKMemoListLevel); virtual; public constructor Create; override; procedure ClearLevelCounters; function FindByID(AListID: Integer): TKMemoList; procedure ListChanged(AList: TKMemoList; ALevel: TKMemoListLevel); virtual; function ListByNumbering(AListID, ALevelIndex: Integer; ANumbering: TKMemoParaNumbering): TKMemoList; virtual; function NextID: Integer; property Items[Index: Integer]: TKMemoList read GetItem write SetItem; default; property OnChanged: TKMemoListChangedEvent read FOnChanged write FOnChanged; end; TKMemoBackground = class(TKPersistent) private FImage: TPicture; FRepeatX: Boolean; FRepeatY: Boolean; FColor: TColor; FOnChanged: TNotifyEvent; procedure SetImage(const Value: TPicture); procedure SetRepeatX(const Value: Boolean); procedure SetRepeatY(const Value: Boolean); procedure SetColor(const Value: TColor); protected procedure ImageChanged(Sender: TObject); procedure Update; override; public constructor Create; override; destructor Destroy; override; procedure Assign(ASource: TPersistent); override; procedure Clear; property OnChanged: TNotifyEvent read FOnChanged write FOnChanged; published property Color: TColor read FColor write SetColor default clNone; property Image: TPicture read FImage write SetImage; property RepeatX: Boolean read FRepeatX write SetRepeatX default True; property RepeatY: Boolean read FRepeatY write SetRepeatY default True; end; TKMemoScriptCapitals = (tcaNone, tcaNormal, tcaSmall); TKMemoScriptPosition = (tpoNormal, tpoSuperscript, tpoSubscript); { TKMemoTextStyle } TKMemoTextStyle = class(TKPersistent) private FAllowBrush: Boolean; FBrush: TBrush; FCapitals: TKMemoScriptCapitals; FChangeable: Boolean; FFont: TFont; FScriptPosition: TKMemoScriptPosition; FStyleChanged: Boolean; FOnChanged: TNotifyEvent; procedure SetAllowBrush(const Value: Boolean); procedure SetBrush(const Value: TBrush); procedure SetCapitals(const Value: TKMemoScriptCapitals); procedure SetFont(const Value: TFont); procedure SetScriptPosition(const Value: TKMemoScriptPosition); protected FBrushChanged: Boolean; FFontChanged: Boolean; procedure BrushChanged(Sender: TObject); procedure FontChanged(Sender: TObject); procedure PropsChanged; virtual; procedure Update; override; public constructor Create; override; destructor Destroy; override; procedure Assign(ASource: TPersistent); override; procedure Defaults; virtual; function EqualProperties(ASource: TKMemoTextStyle): Boolean; virtual; procedure NotifyChange(AValue: TKMemoTextStyle); virtual; property AllowBrush: Boolean read FAllowBrush write SetAllowBrush; property Capitals: TKMemoScriptCapitals read FCapitals write SetCapitals; property Changeable: Boolean read FChangeable write FChangeable; property Brush: TBrush read FBrush write SetBrush; property Font: TFont read FFont write SetFont; property ScriptPosition: TKMemoScriptPosition read FScriptPosition write SetScriptPosition; property StyleChanged: Boolean read FStyleChanged write FStyleChanged; property OnChanged: TNotifyEvent read FOnChanged write FOnChanged; end; TKMemoBlockWrapMode = ( { Text wraps around block bounding rectangle on both sides. } wrAround, { Text wraps around block bounding rectangle only on left side. } wrAroundLeft, { Text wraps around block bounding rectangle only on right side. } wrAroundRight, { Text wraps tightly around block. } wrTight, { Text wraps tightly around block only on left side. } wrTightLeft, { Text wraps tightly around block only on right side. } wrTightRight, { Text does not wrap around block on left or right side. } wrTopBottom, { Text wraps as block was not present. } wrNone, { Text wrap not specified. } wrUnknown ); TKMemoBlockStyleChangedEvent = procedure(Sender: TObject; AReasons: TKMemoUpdateReasons) of object; { TKMemoBlockStyle } TKMemoBlockStyle = class(TKPersistent) private FBrush: TBrush; FBorderRadius: Integer; FBorderColor: TColor; FBorderWidth: Integer; FBorderWidths: TKRect; FChangeable: Boolean; FStyleChanged: Boolean; FContentMargin: TKRect; FContentPadding: TKRect; FFillBlip: TGraphic; FHAlign: TKHAlign; FWrapMode: TKMemoBlockWrapMode; FOnChanged: TKMemoBlockStyleChangedEvent; function GetBottomPadding: Integer; function GetLeftPadding: Integer; function GetRightPadding: Integer; function GetTopPadding: Integer; procedure SetBottomPadding(const Value: Integer); procedure SetBorderColor(const Value: TColor); procedure SetBorderRadius(const Value: Integer); procedure SetBorderWidth(const Value: Integer); procedure SetBorderWidths(const Value: TKRect); procedure SetBrush(const Value: TBrush); procedure SetContentPadding(const Value: TKRect); procedure SetFillBlip(const Value: TGraphic); procedure SetHAlign(const Value: TKHAlign); procedure SetLeftPadding(const Value: Integer); procedure SetRightPadding(const Value: Integer); procedure SetTopPadding(const Value: Integer); procedure SetWrapMode(const Value: TKMemoBlockWrapMode); procedure SetContentMargin(const Value: TKRect); function GetBottomMargin: Integer; function GetLeftMargin: Integer; function GetRightMargin: Integer; function GetTopMargin: Integer; procedure SetBottomMargin(const Value: Integer); procedure SetLeftMargin(const Value: Integer); procedure SetRightMargin(const Value: Integer); procedure SetTopMargin(const Value: Integer); function GetBottomBorderWidth: Integer; function GetLeftBorderWidth: Integer; function GetRightBorderWidth: Integer; function GetTopBorderWidth: Integer; function GetAllPaddingsBottom: Integer; function GetAllPaddingsLeft: Integer; function GetAllPaddingsRight: Integer; function GetAllPaddingsTop: Integer; protected FUpdateReasons: TKMemoUpdateReasons; procedure BrushChanged(Sender: TObject); procedure PropsChanged(AReasons: TKMemoUpdateReasons); virtual; procedure Update; override; public constructor Create; override; destructor Destroy; override; procedure Assign(ASource: TPersistent); override; function BorderRect(const ARect: TRect): TRect; virtual; function InteriorRect(const ARect: TRect): TRect; virtual; procedure Defaults; virtual; function MarginRect(const ARect: TRect): TRect; virtual; procedure NotifyChange(AValue: TKMemoBlockStyle); virtual; procedure PaintBox(ACanvas: TCanvas; const ARect: TRect); virtual; property AllPaddingsBottom: Integer read GetAllPaddingsBottom; property AllPaddingsLeft: Integer read GetAllPaddingsLeft; property AllPaddingsRight: Integer read GetAllPaddingsRight; property AllPaddingsTop: Integer read GetAllPaddingsTop; property BottomBorderWidth: Integer read GetBottomBorderWidth; property BottomMargin: Integer read GetBottomMargin write SetBottomMargin; property BottomPadding: Integer read GetBottomPadding write SetBottomPadding; property BorderRadius: Integer read FBorderRadius write SetBorderRadius; property BorderColor: TColor read FBorderColor write SetBorderColor; property BorderWidth: Integer read FBorderWidth write SetBorderWidth; property BorderWidths: TKRect read FBorderWidths write SetBorderWidths; property Brush: TBrush read FBrush write SetBrush; property Changeable: Boolean read FChangeable write FChangeable; property ContentMargin: TKRect read FContentMargin write SetContentMargin; property ContentPadding: TKRect read FContentPadding write SetContentPadding; property FillBlip: TGraphic read FFillBlip write SetFillBlip; property HAlign: TKHAlign read FHAlign write SetHAlign; property LeftBorderWidth: Integer read GetLeftBorderWidth; property LeftMargin: Integer read GetLeftMargin write SetLeftMargin; property LeftPadding: Integer read GetLeftPadding write SetLeftPadding; property RightBorderWidth: Integer read GetRightBorderWidth; property RightMargin: Integer read GetRightMargin write SetRightMargin; property RightPadding: Integer read GetRightPadding write SetRightPadding; property StyleChanged: Boolean read FStyleChanged write FStyleChanged; property TopBorderWidth: Integer read GetTopBorderWidth; property TopMargin: Integer read GetTopMargin write SetTopMargin; property TopPadding: Integer read GetTopPadding write SetTopPadding; property WrapMode: TKMemoBlockWrapMode read FWrapMode write SetWrapMode; property OnChanged: TKMemoBlockStyleChangedEvent read FOnChanged write FOnChanged; end; TKMemoLineSpacingMode = (lsmFactor, lsmValue); TKMemoParaStyle = class(TKMemoBlockStyle) private FFirstIndent: Integer; FLineSpacingFactor: Double; FLineSpacingMode: TKMemoLineSpacingMode; FLineSpacingValue: Integer; FNumberingList: Integer; FNumberingListLevel: Integer; FNumberStartAt: Integer; FWordWrap: Boolean; procedure SetFirstIndent(const Value: Integer); procedure SetLineSpacingFactor(const Value: Double); procedure SetLineSpacingMode(const Value: TKMemoLineSpacingMode); procedure SetLineSpacingValue(const Value: Integer); procedure SetNumberingList(const Value: Integer); procedure SetNumberingListLevel(const Value: Integer); procedure SetNumberStartAt(const Value: Integer); procedure SetWordWrap(const Value: Boolean); public procedure Assign(ASource: TPersistent); override; procedure Defaults; override; procedure SetNumberingListAndLevel(AListID, ALevelIndex: Integer); virtual; property FirstIndent: Integer read FFirstIndent write SetFirstIndent; property LineSpacingFactor: Double read FLineSpacingFactor write SetLineSpacingFactor; property LineSpacingMode: TKMemoLineSpacingMode read FLineSpacingMode write SetLineSpacingMode; property LineSpacingValue: Integer read FLineSpacingValue write SetLineSpacingValue; property NumberingList: Integer read FNumberingList write SetNumberingList; property NumberingListLevel: Integer read FNumberingListLevel write SetNumberingListLevel; property NumberStartAt: Integer read FNumberStartAt write SetNumberStartAt; property WordWrap: Boolean read FWordWrap write SetWordWrap; end; { This class represents one line in the memo. } TKMemoLine = class(TObject) private FEndBlock: TKMemoBlockIndex; FEndIndex: TKMemoSelectionIndex; FEndWord: TKMemoWordIndex; FExtent: TPoint; FPosition: TPoint; FStartBlock: TKMemoBlockIndex; FStartIndex: TKMemoSelectionIndex; FStartWord: TKMemoWordIndex; function GetLineRect: TRect; public constructor Create; property EndBlock: TKMemoBlockIndex read FEndBlock write FEndBlock; property EndIndex: TKMemoSelectionIndex read FEndIndex write FEndIndex; property EndWord: TKMemoWordIndex read FEndWord write FEndWord; property Extent: TPoint read FExtent write FExtent; property LineRect: TRect read GetLineRect; property Position: TPoint read FPosition write FPosition; property StartBlock: TKMemoBlockIndex read FStartBlock write FStartBlock; property StartIndex: TKMemoSelectionIndex read FStartIndex write FStartIndex; property StartWord: TKMemoWordIndex read FStartWord write FStartWord; end; TKMemoLines = class(TObjectList) private function GetItem(Index: TKMemoLineIndex): TKMemoLine; procedure SetItem(Index: TKMemoLineIndex; const Value: TKMemoLine); public property Items[Index: TKMemoLineIndex]: TKMemoLine read GetItem write SetItem; default; end; { This class represents one single word or part of a word (sometimes even a single letter). } TKMemoWord = class(TObject) private FBaseLine: Integer; FBottomPadding: Integer; FClipped: Boolean; FExtent: TPoint; FEndIndex: TKMemoSelectionIndex; FPosition: TPoint; FStartIndex: TKMemoSelectionIndex; FTopPadding: Integer; public constructor Create; procedure Clear; property BaseLine: Integer read FBaseLine write FBaseLine; property BottomPadding: Integer read FBottomPadding write FBottomPadding; property Clipped: Boolean read FClipped write FClipped; property EndIndex: TKMemoSelectionIndex read FEndIndex write FEndIndex; property Extent: TPoint read FExtent write FExtent; property Position: TPoint read FPosition write FPosition; property StartIndex: TKMemoSelectionIndex read FStartIndex write FStartIndex; property TopPadding: Integer read FTopPadding write FTopPadding; end; TKMemoWordList = class(TObjectList) private function GetItem(Index: TKMemoWordIndex): TKMemoWord; procedure SetItem(Index: TKMemoWordIndex; const Value: TKMemoWord); public property Items[Index: TKMemoWordIndex]: TKMemoWord read GetItem write SetItem; default; end; TKMemoBlock = class; TKMemoBlocks = class; IKMemoNotifier = interface(IInterface) function BlockClick(ABlock: TKMemoBlock): Boolean; function BlockDblClick(ABlock: TKMemoBlock): Boolean; procedure BlockFreeNotification(ABlock: TKMemoBlock); procedure BlocksFreeNotification(ABlocks: TKMemoBlocks); function EditBlock(ABlock: TKMemoBlock): Boolean; function GetActiveBlocks: TKMemoBlocks; function GetDefaultTextStyle: TKMemoTextStyle; function GetDefaultParaStyle: TKMemoParaStyle; function GetDrawSingleChars: Boolean; function GetLinePosition: TKMemoLinePosition; function GetListTable: TKMemoListTable; function GetMemo: TKCustomMemo; function GetMaxWordLength: TKMemoSelectionIndex; function GetPaintSelection: Boolean; function GetPixelsPerInchX: Integer; function GetPixelsPerInchY: Integer; function GetPrinting: Boolean; function GetReadOnly: Boolean; procedure GetSelColors(out Foreground, Background: TColor); function GetSelectedBlock: TKMemoBlock; function GetShowFormatting: Boolean; function GetWordBreaks: TKSysCharSet; function GetWrapSingleChars: Boolean; function HasFocus: Boolean; function SelectBlock(ABlock: TKMemoBlock; APosition: TKSizingGripPosition): Boolean; procedure SetReqMouseCursor(ACursor: TCursor); end; TKMemoMouseAction = (maMove, maLeftDown, maLeftUp, maRightDown, maRightUp, maMidDown, maMidUp); TKMemoDoubleClickState = (mdblNone, mdblClicked, mdblClickedAndHandled); TKMemoBlockClass = class of TKMemoBlock; TKMemoBlock = class(TKObject) private FClickOnMouseUp: Boolean; FOffset: TPoint; FPosition: TKMemoBlockPosition; FOnClick: TNotifyEvent; FOnDblClick: TNotifyEvent; function GetBoundsRect: TRect; function GetMemoNotifier: IKMemoNotifier; function GetPaintSelection: Boolean; function GetParentBlocks: TKMemoBlocks; function GetPrinting: Boolean; function GetReadOnly: Boolean; procedure SetPosition(const Value: TKMemoBlockPosition); protected FDoubleClickState: TKMemoDoubleClickState; FMouseCaptureWord: TKMemoWordIndex; function Click: Boolean; virtual; function DblClick: Boolean; virtual; procedure CallAfterUpdate; override; procedure CallBeforeUpdate; override; procedure SizingGripsDraw(ACanvas: TCanvas; const ARect: TRect); virtual; function SizingGripsCursor(const ARect: TRect; const APoint: TPoint): TCursor; virtual; function SizingGripsPosition(const ARect: TRect; const APoint: TPoint): TKSizingGripPosition; virtual; function ContentLength: TKMemoSelectionIndex; virtual; function GetBottomPadding: Integer; virtual; function GetCanAddText: Boolean; virtual; function GetWrapMode: TKMemoBlockWrapMode; virtual; function GetDefaultTextStyle: TKMemoTextStyle; virtual; function GetDefaultParaStyle: TKMemoParaStyle; virtual; function GetHeight: Integer; virtual; function GetLeft: Integer; virtual; function GetParaStyle: TKMemoParaStyle; virtual; function GetParentRootBlocks: TKMemoBlocks; virtual; function GetResizable: Boolean; virtual; procedure GetSelColors(out Foreground, Background: TColor); virtual; function GetSelEnd: TKMemoSelectionIndex; virtual; function GetSelLength: TKMemoSelectionIndex; virtual; function GetSelStart: TKMemoSelectionIndex; virtual; function GetSelText: TKString; virtual; function GetShowFormatting: Boolean; virtual; function GetSizingRect: TRect; virtual; function GetText: TKString; virtual; function GetTop: Integer; virtual; function GetTopPadding: Integer; virtual; function GetWidth: Integer; virtual; function GetWordBaseLine(Index: TKMemoWordIndex): Integer; virtual; function GetWordBottomPadding(Index: TKMemoWordIndex): Integer; virtual; function GetWordBoundsRect(Index: TKMemoWordIndex): TRect; virtual; function GetWordBreakable(Index: TKMemoWordIndex): Boolean; virtual; function GetWordClipped(Index: TKMemoWordIndex): Boolean; virtual; function GetWordCount: Integer; virtual; function GetWordHeight(Index: TKMemoWordIndex): Integer; virtual; function GetWordLeft(Index: TKMemoWordIndex): Integer; virtual; function GetWordLength(Index: TKMemoWordIndex): TKMemoSelectionIndex; virtual; function GetWordLengthWOWS(Index: TKMemoWordIndex): TKMemoSelectionIndex; virtual; function GetWordRect(Index: TKMemoWordIndex): TRect; virtual; function GetWords(Index: TKMemoWordIndex): TKString; virtual; function GetWordTop(Index: TKMemoWordIndex): Integer; virtual; function GetWordTopPadding(Index: TKMemoWordIndex): Integer; virtual; function GetWordWidth(Index: TKMemoWordIndex): Integer; virtual; function PixelsPerInchX: Integer; virtual; function PixelsPerInchY: Integer; virtual; procedure SetResizable(const Value: Boolean); virtual; procedure SetLeftOffset(const Value: Integer); virtual; procedure SetTopOffset(const Value: Integer); virtual; procedure SetWordBaseLine(Index: TKMemoWordIndex; const Value: Integer); virtual; procedure SetWordBottomPadding(Index: TKMemoWordIndex; const Value: Integer); virtual; procedure SetWordClipped(Index: TKMemoWordIndex; const Value: Boolean); virtual; procedure SetWordHeight(Index: TKMemoWordIndex; const Value: Integer); virtual; procedure SetWordLeft(Index: TKMemoWordIndex; const Value: Integer); virtual; procedure SetWordTop(Index: TKMemoWordIndex; const Value: Integer); virtual; procedure SetWordTopPadding(Index: TKMemoWordIndex; const Value: Integer); virtual; procedure SetWordWidth(Index: TKMemoWordIndex; const Value: Integer); virtual; procedure Update(AReasons: TKMemoUpdateReasons); virtual; public constructor Create; override; destructor Destroy; override; function ActiveBlocks: TKMemoBlocks; virtual; procedure Assign(ASource: TKObject); override; procedure AssignAttributes(ABlock: TKMemoBlock); virtual; function CalcAscent(ACanvas: TCanvas): Integer; virtual; function CanAdd(ABlock: TKMemoBlock): Boolean; virtual; procedure ClearSelection(ATextOnly: Boolean); virtual; function Concat(ABlock: TKMemoBlock): Boolean; virtual; function EqualProperties(ASource: TKObject): Boolean; override; procedure GetWordIndexes(AIndex: TKMemoSelectionIndex; out ASt, AEn: TKMemoSelectionIndex); virtual; function IndexToRect(ACanvas: TCanvas; AIndex: TKMemoSelectionIndex; ACaret: Boolean): TRect; virtual; function InsertParagraph(AIndex: TKMemoSelectionIndex): Boolean; virtual; function InsertString(const AText: TKString; At: TKMemoSelectionIndex = -1): Boolean; virtual; function MeasureExtent(ACanvas: TCanvas; ARequiredWidth: Integer): TPoint; virtual; procedure NotifyDefaultTextChange; virtual; procedure NotifyDefaultParaChange; virtual; procedure NotifyOptionsChange; virtual; procedure NotifyPrintBegin; virtual; procedure NotifyPrintEnd; virtual; procedure PaintToCanvas(ACanvas: TCanvas; ALeft, ATop: Integer); virtual; function PointToIndex(ACanvas: TCanvas; const APoint: TPoint; AOutOfArea, ASelectionExpanding: Boolean; out APosition: TKMemoLinePosition): TKMemoSelectionIndex; virtual; function RealLeftOffset: Integer; function RealTopOffset: Integer; procedure Resize(ANewWidth, ANewHeight: Integer); virtual; procedure RestoreUpdateState(AValue: TKMemoUpdateReasons); virtual; function SaveUpdateState: TKMemoUpdateReasons; virtual; procedure SelectAll; virtual; function Select(ASelStart, ASelLength: TKMemoSelectionIndex; ADoScroll: Boolean): Boolean; virtual; function SelectableLength(ALocalCalc: Boolean = False): TKMemoSelectionIndex; virtual; function SelectedBlock: TKMemoBlock; virtual; function Split(At: TKMemoSelectionIndex; AllowEmpty: Boolean = False): TKMemoBlock; virtual; function WordIndexToRect(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AIndex: TKMemoSelectionIndex; ACaret: Boolean): TRect; virtual; function WordMeasureExtent(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ARequiredWidth: Integer): TPoint; virtual; function WordMouseAction(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AAction: TKMemoMouseAction; const APoint: TPoint; AShift: TShiftState): Boolean; virtual; procedure WordPaintToCanvas(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ALeft, ATop: Integer); virtual; function WordPointToIndex(ACanvas: TCanvas; const APoint: TPoint; AWordIndex: TKMemoWordIndex; AOutOfArea, ASelectionExpanding: Boolean; out APosition: TKMemoLinePosition): TKMemoSelectionIndex; virtual; property BoundsRect: TRect read GetBoundsRect; property BottomPadding: Integer read GetBottomPadding; property CanAddText: Boolean read GetCanAddText; property ClickOnMouseUp: Boolean read FClickOnMouseUp write FClickOnMouseUp; property DefaultTextStyle: TKMemoTextStyle read GetDefaultTextStyle; property DefaultParaStyle: TKMemoParaStyle read GetDefaultParaStyle; property Height: Integer read GetHeight; property Left: Integer read GetLeft; property LeftOffset: Integer read FOffset.X write SetLeftOffset; property MemoNotifier: IKMemoNotifier read GetMemoNotifier; property PaintSelection: Boolean read GetPaintSelection; property ParaStyle: TKMemoParaStyle read GetParaStyle; property ParentBlocks: TKMemoBlocks read GetParentBlocks; property ParentRootBlocks: TKMemoBlocks read GetParentRootBlocks; property Position: TKMemoBlockPosition read FPosition write SetPosition; property Printing: Boolean read GetPrinting; property ReadOnly: Boolean read GetReadOnly; property Resizable: Boolean read GetResizable write SetResizable; property SelEnd: TKMemoSelectionIndex read GetSelEnd; property SelLength: TKMemoSelectionIndex read GetSelLength; property SelStart: TKMemoSelectionIndex read GetSelStart; property SelText: TKString read GetSelText; property ShowFormatting: Boolean read GetShowFormatting; property SizingRect: TRect read GetSizingRect; property Text: TKString read GetText; property Top: Integer read GetTop; property TopOffset: Integer read FOffset.Y write SetTopOffset; property TopPadding: Integer read GetTopPadding; property Width: Integer read GetWidth; property WordCount: Integer read GetWordCount; property WordBaseLine[Index: TKMemoWordIndex]: Integer read GetWordBaseLine write SetWordBaseLine; property WordBreakable[Index: TKMemoWordIndex]: Boolean read GetWordBreakable; property WordBottomPadding[Index: TKMemoWordIndex]: Integer read GetWordBottomPadding write SetWordBottomPadding; property WordBoundsRect[Index: TKMemoWordIndex]: TRect read GetWordBoundsRect; property WordClipped[Index: TKMemoWordIndex]: Boolean read GetWordClipped write SetWordClipped; property WordHeight[Index: TKMemoWordIndex]: Integer read GetWordHeight write SetWordHeight; property WordLeft[Index: TKMemoWordIndex]: Integer read GetWordLeft write SetWordLeft; property WordLength[Index: TKMemoWordIndex]: TKMemoSelectionIndex read GetWordLength; property WordLengthWOWS[Index: TKMemoWordIndex]: TKMemoSelectionIndex read GetWordLengthWOWS; property WordRect[Index: TKMemoWordIndex]: TRect read GetWordRect; property Words[Index: TKMemoWordIndex]: TKString read GetWords; property WordTop[Index: TKMemoWordIndex]: Integer read GetWordTop write SetWordTop; property WordTopPadding[Index: TKMemoWordIndex]: Integer read GetWordTopPadding write SetWordTopPadding; property WordWidth[Index: TKMemoWordIndex]: Integer read GetWordWidth write SetWordWidth; property WrapMode: TKMemoBlockWrapMode read GetWrapMode; property OnClick: TNotifyEvent read FOnClick write FOnClick; property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick; end; TKMemoSingleton = class(TKMemoBlock) private FSelEnd: TKMemoSelectionIndex; FSelStart: TKMemoSelectionIndex; protected function GetSelLength: TKMemoSelectionIndex; override; function GetSelStart: TKMemoSelectionIndex; override; public constructor Create; override; function Select(ASelStart, ASelLength: TKMemoSelectionIndex; ADoScroll: Boolean): Boolean; override; end; TKMemoWordBreakStyle = (wbsLastWordChar, wbsFirstWordChar, wbsEveryWord, wbsEveryChar); TKMemoTextBlock = class(TKMemoSingleton) private FText: TKString; FTextStyle: TKMemoTextStyle; FWordBreakStyle: TKMemoWordBreakStyle; function GetWordBreaks: TKSysCharSet; procedure SetWordBreakStyle(const Value: TKMemoWordBreakStyle); protected FScriptVertOffset: Integer; FScriptFontHeight: Integer; FTextLength: Integer; FWordCount: Integer; FWords: TKMemoWordList; function ApplyFormatting(const AText: TKString): TKString; procedure ApplyTextStyle(ACanvas: TCanvas); virtual; function ContentLength: TKMemoSelectionIndex; override; function SingleCharWords: Boolean; virtual; function GetCanAddText: Boolean; override; function GetKerningDistance(ACanvas: TCanvas; const AChar1, AChar2: TKChar): Integer; function GetSelText: TKString; override; function GetText: TKString; override; function GetWordBaseLine(Index: TKMemoWordIndex): Integer; override; function GetWordBottomPadding(Index: TKMemoWordIndex): Integer; override; function GetWordBoundsRect(Index: TKMemoWordIndex): TRect; override; function GetWordBreakable(Index: TKMemoWordIndex): Boolean; override; function GetWordClipped(Index: TKMemoWordIndex): Boolean; override; function GetWordCount: Integer; override; function GetWordHeight(Index: TKMemoWordIndex): Integer; override; function GetWordLeft(Index: TKMemoWordIndex): Integer; override; function GetWordLength(Index: TKMemoWordIndex): TKMemoSelectionIndex; override; function GetWordLengthWOWS(Index: TKMemoWordIndex): TKMemoSelectionIndex; override; function GetWords(Index: TKMemoWordIndex): TKString; override; function GetWordTop(Index: TKMemoWordIndex): Integer; override; function GetWordTopPadding(Index: TKMemoWordIndex): Integer; override; function GetWordWidth(Index: TKMemoWordIndex): Integer; override; function IndexToTextIndex(const AText: TKString; AIndex: Integer): Integer; virtual; function InternalTextExtent(ACanvas: TCanvas; const AText: TKString): TSize; virtual; procedure InternalTextOutput(ACanvas: TCanvas; ALeft, ATop: Integer; const AText: TKString); virtual; function ModifiedTextExtent(ACanvas: TCanvas; const AText: TKString): TPoint; virtual; procedure ParentChanged; override; procedure SetText(const Value: TKString); virtual; procedure SetWordBaseLine(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordBottomPadding(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordClipped(Index: TKMemoWordIndex; const Value: Boolean); override; procedure SetWordHeight(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordLeft(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordTop(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordTopPadding(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordWidth(Index: TKMemoWordIndex; const Value: Integer); override; class procedure SplitText(const ASource: TKString; At: Integer; out APart1, APart2: TKString); function TextIndexToIndex(var AText: TKString; ATextIndex: Integer): Integer; virtual; procedure TextStyleChanged(Sender: TObject); procedure UpdateWords; virtual; public constructor Create; override; destructor Destroy; override; procedure Assign(ASource: TKObject); override; procedure AssignAttributes(ABlock: TKMemoBlock); override; function CalcAscent(ACanvas: TCanvas): Integer; override; function CalcDescent(ACanvas: TCanvas): Integer; virtual; procedure ClearSelection(ATextOnly: Boolean); override; function Concat(ABlock: TKMemoBlock): Boolean; override; function EqualProperties(ASource: TKObject): Boolean; override; procedure GetWordIndexes(AIndex: TKMemoSelectionIndex; out ASt, AEn: TKMemoSelectionIndex); override; function InsertString(const AText: TKString; At: TKMemoSelectionIndex = -1): Boolean; override; procedure NotifyDefaultTextChange; override; procedure NotifyOptionsChange; override; procedure NotifyPrintBegin; override; procedure NotifyPrintEnd; override; function Split(At: TKMemoSelectionIndex; AllowEmpty: Boolean = False): TKMemoBlock; override; function WordIndexToRect(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AIndex: TKMemoSelectionIndex; ACaret: Boolean): TRect; override; function WordMeasureExtent(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ARequiredWidth: Integer): TPoint; override; function WordMouseAction(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AAction: TKMemoMouseAction; const APoint: TPoint; AShift: TShiftState): Boolean; override; procedure WordPaintToCanvas(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ALeft, ATop: Integer); override; function WordPointToIndex(ACanvas: TCanvas; const APoint: TPoint; AWordIndex: TKMemoWordIndex; AOutOfArea, ASelectionExpanding: Boolean; out APosition: TKMemoLinePosition): TKMemoSelectionIndex; override; property Text: TKString read GetText write SetText; property TextStyle: TKMemoTextStyle read FTextStyle; property WordBreaks: TKSysCharSet read GetWordBreaks; property WordBreakStyle: TKMemoWordBreakStyle read FWordBreakStyle write SetWordBreakStyle; end; { TKMemoHyperlink } TKMemoHyperlink = class(TKMemoTextBlock) private FURL: TKString; protected function Click: Boolean; override; public constructor Create; override; procedure Assign(ASource: TKObject); override; procedure DefaultStyle; virtual; function WordMouseAction(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AAction: TKMemoMouseAction; const APoint: TPoint; AShift: TShiftState): Boolean; override; property URL: TKString read FURL write FURL; end; TKMemoParagraph = class(TKMemoTextBlock) private FExtent: TPoint; FOrigin: TPoint; FParaStyle: TKMemoParaStyle; protected FNumberBlock: TKMemoTextBlock; function GetCanAddText: Boolean; override; function GetNumberBlock: TKMemoTextBlock; virtual; function GetNumbering: TKMemoParaNumbering; virtual; function GetNumberingList: TKMemoList; virtual; function GetNumberingListLevel: TKMemoListLevel; virtual; function GetParaStyle: TKMemoParaStyle; override; function GetWordBreakable(Index: TKMemoWordIndex): Boolean; override; procedure ParaStyleChanged(Sender: TObject; AReasons: TKMemoUpdateReasons); procedure SetNumbering(const Value: TKMemoParaNumbering); virtual; public constructor Create; override; destructor Destroy; override; procedure AssignAttributes(ABlock: TKMemoBlock); override; function Concat(ABlock: TKMemoBlock): Boolean; override; procedure NotifyDefaultParaChange; override; function Split(At: TKMemoSelectionIndex; AllowEmpty: Boolean = False): TKMemoBlock; override; procedure WordPaintToCanvas(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ALeft, ATop: Integer); override; property Height: Integer read FExtent.Y write FExtent.Y; property Left: Integer read FOrigin.X write FOrigin.X; property Numbering: TKMemoParaNumbering read GetNumbering write SetNumbering; property NumberingList: TKMemoList read GetNumberingList; property NumberingListLevel: TKMemoListLevel read GetNumberingListLevel; property NumberBlock: TKMemoTextBlock read GetNumberBlock; property Top: Integer read FOrigin.Y write FOrigin.Y; property Width: Integer read FExtent.X write FExtent.X; end; TKMemoImageBlock = class(TKMemoSingleton) private FBaseLine: Integer; FCrop: TKRect; FCroppedImage: TKAlphaBitmap; FImageDPI: TPoint; FExtent: TPoint; // extent given by word processor FExplicitExtent: TPoint; // explicit extent FImage: TGraphic; FImageStyle: TKMemoBlockStyle; FOrigin: TPoint; FResizable: Boolean; FScale: TPoint; // scaled extent FWordBottomPadding: Integer; FWordTopPadding: Integer; function GetLogScaleX: Integer; function GetLogScaleY: Integer; procedure SetCrop(const Value: TKRect); procedure SetImage(const Value: TGraphic); procedure SetScaleHeight(const Value: Integer); procedure SetScaleWidth(const Value: Integer); procedure SetExplicitHeight(const Value: Integer); procedure SetExplicitWidth(const Value: Integer); procedure SetScaleX(const Value: Integer); procedure SetScaleY(const Value: Integer); procedure SetLogScaleX(const Value: Integer); procedure SetLogScaleY(const Value: Integer); protected FCalcBaseLine: Integer; FCreatingCroppedImage: Boolean; FMouseCapture: Boolean; FScaledRect: TRect; function ContentLength: TKMemoSelectionIndex; override; procedure CropChanged(Sender: TObject); function GetWrapMode: TKMemoBlockWrapMode; override; function GetImageHeight: Integer; virtual; function GetImageWidth: Integer; virtual; function GetNativeOrExplicitHeight: Integer; virtual; function GetNativeOrExplicitWidth: Integer; virtual; function GetResizable: Boolean; override; function GetScaleHeight: Integer; virtual; function GetScaleWidth: Integer; virtual; function GetSizingRect: TRect; override; function GetWordBottomPadding(Index: TKMemoWordIndex): Integer; override; function GetWordBoundsRect(Index: TKMemoWordIndex): TRect; override; function GetWordCount: Integer; override; function GetWordHeight(Index: TKMemoWordIndex): Integer; override; function GetWordLeft(Index: TKMemoWordIndex): Integer; override; function GetWordLength(Index: TKMemoWordIndex): TKMemoSelectionIndex; override; function GetWords(Index: TKMemoWordIndex): TKString; override; function GetWordTop(Index: TKMemoWordIndex): Integer; override; function GetWordTopPadding(Index: TKMemoWordIndex): Integer; override; function GetWordWidth(Index: TKMemoWordIndex): Integer; override; procedure ImageChanged(Sender: TObject); procedure ImageStyleChanged(Sender: TObject; AReasons: TKMemoUpdateReasons); function CroppedImage: TKAlphaBitmap; virtual; procedure SetResizable(const Value: Boolean); override; procedure SetWordBaseLine(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordBottomPadding(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordHeight(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordLeft(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordTop(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordTopPadding(Index: TKMemoWordIndex; const Value: Integer); override; public constructor Create; override; destructor Destroy; override; procedure Assign(ASource: TKObject); override; procedure AssignAttributes(ABlock: TKMemoBlock); override; procedure AssignImage(ASource: TGraphic); virtual; function CalcAscent(ACanvas: TCanvas): Integer; override; function OuterRect(ACaret: Boolean): TRect; virtual; procedure LoadFromFile(const APath: string); virtual; procedure Resize(ANewWidth, ANewHeight: Integer); override; function WordIndexToRect(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AIndex: TKMemoSelectionIndex; ACaret: Boolean): TRect; override; function WordMeasureExtent(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ARequiredWidth: Integer): TPoint; override; function WordMouseAction(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AAction: TKMemoMouseAction; const APoint: TPoint; AShift: TShiftState): Boolean; override; function WordPointToIndex(ACanvas: TCanvas; const APoint: TPoint; AWordIndex: TKMemoWordIndex; AOutOfArea, ASelectionExpanding: Boolean; out APosition: TKMemoLinePosition): TKMemoSelectionIndex; override; procedure WordPaintToCanvas(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ALeft, ATop: Integer); override; property Crop: TKRect read FCrop write SetCrop; property Image: TGraphic read FImage write SetImage; property ImageDPIX: Integer read FImageDPI.X; property ImageDPIY: Integer read FImageDPI.Y; property ImageStyle: TKMemoBlockStyle read FImageStyle; property ImageHeight: Integer read GetImageHeight; property ImageWidth: Integer read GetImageWidth; property ExplicitHeight: Integer read FExplicitExtent.Y write SetExplicitHeight; property ExplicitWidth: Integer read FExplicitExtent.X write SetExplicitWidth; property NativeOrExplicitHeight: Integer read GetNativeOrExplicitHeight; property NativeOrExplicitWidth: Integer read GetNativeOrExplicitWidth; property LogScaleX: Integer read GetLogScaleX write SetLogScaleX; property LogScaleY: Integer read GetLogScaleY write SetLogScaleY; property ScaleHeight: Integer read GetScaleHeight write SetScaleHeight; property ScaleWidth: Integer read GetScaleWidth write SetScaleWidth; property ScaleX: Integer read FScale.X write SetScaleX; property ScaleY: Integer read FScale.Y write SetScaleY; end; { TKMemoContainer } TKMemoContainer = class(TKMemoBlock) private FBlocks: TKMemoBlocks; FBlockStyle: TKMemoBlockStyle; FClip: Boolean; FCurrentRequiredWidth: Integer; FCurrentRequiredHeight: Integer; FFixedHeight: Boolean; FFixedWidth: Boolean; FOrigin: TPoint; FRequiredHeight: Integer; FRequiredWidth: Integer; FResizable: Boolean; FWordBottomPadding: Integer; FWordTopPadding: Integer; procedure SetFixedHeight(const Value: Boolean); procedure SetFixedWidth(const Value: Boolean); procedure SetRequiredHeight(const Value: Integer); procedure SetRequiredWidth(const Value: Integer); procedure SetClip(const Value: Boolean); protected function AddRectOffset(const ARect: TRect): TRect; virtual; procedure AddSingleLine; virtual; procedure AddBlockLine(AStartBlock, AStartIndex, AEndBlock, AEndIndex, ALeft, ATop, AWidth, AHeight: Integer); virtual; procedure BlockStyleChanged(Sender: TObject; AReasons: TKMemoUpdateReasons); procedure ClearLines; virtual; function ContentLength: TKMemoSelectionIndex; override; procedure FixedHeightChanged; virtual; procedure FixedWidthChanged; virtual; function GetBottomPadding: Integer; override; function GetWrapMode: TKMemoBlockWrapMode; override; function GetCanAddText: Boolean; override; function GetResizable: Boolean; override; function GetSelLength: TKMemoSelectionIndex; override; function GetSelStart: TKMemoSelectionIndex; override; function GetSelText: TKString; override; function GetText: TKString; override; function GetTopPadding: Integer; override; function GetTotalLineCount: Integer; virtual; function GetTotalLineRect(Index: TKMemoTotalLineIndex): TRect; virtual; function GetWordBottomPadding(Index: TKMemoWordIndex): Integer; override; function GetWordBoundsRect(Index: TKMemoWordIndex): TRect; override; function GetWordCount: Integer; override; function GetWordHeight(Index: TKMemoWordIndex): Integer; override; function GetWordLeft(Index: TKMemoWordIndex): Integer; override; function GetWordLength(Index: TKMemoWordIndex): TKMemoSelectionIndex; override; function GetWords(Index: TKMemoWordIndex): TKString; override; function GetWordTop(Index: TKMemoWordIndex): Integer; override; function GetWordTopPadding(Index: TKMemoWordIndex): Integer; override; function GetWordWidth(Index: TKMemoWordIndex): Integer; override; procedure ParentChanged; override; procedure RequiredHeightChanged; virtual; procedure RequiredWidthChanged; virtual; procedure SetResizable(const Value: Boolean); override; procedure SetWordBottomPadding(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordHeight(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordLeft(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordTop(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordTopPadding(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordWidth(Index: TKMemoWordIndex; const Value: Integer); override; public constructor Create; override; destructor Destroy; override; procedure Assign(ASource: TKObject); override; procedure AssignAttributes(ABlock: TKMemoBlock); override; function CalcAscent(ACanvas: TCanvas): Integer; override; function CanAdd(ABlock: TKMemoBlock): Boolean; override; procedure ClearSelection(ATextOnly: Boolean); override; function InsertParagraph(AIndex: TKMemoSelectionIndex): Boolean; override; function InsertString(const AText: TKString; At: TKMemoSelectionIndex = -1): Boolean; override; procedure NotifyDefaultParaChange; override; procedure NotifyDefaultTextChange; override; procedure NotifyPrintBegin; override; procedure NotifyPrintEnd; override; procedure Resize(ANewWidth, ANewHeight: Integer); override; function Select(ASelStart, ASelLength: TKMemoSelectionIndex; ADoScroll: Boolean): Boolean; override; procedure SetBlockExtent(AWidth, AHeight: Integer); virtual; procedure UpdateAttributes; virtual; function WordIndexToRect(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AIndex: TKMemoSelectionIndex; ACaret: Boolean): TRect; override; function WordMeasureExtent(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ARequiredWidth: Integer): TPoint; override; function WordMouseAction(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AAction: TKMemoMouseAction; const APoint: TPoint; AShift: TShiftState): Boolean; override; function WordPointToIndex(ACanvas: TCanvas; const APoint: TPoint; AWordIndex: TKMemoWordIndex; AOutOfArea, ASelectionExpanding: Boolean; out APosition: TKMemoLinePosition): TKMemoSelectionIndex; override; procedure WordPaintToCanvas(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ALeft, ATop: Integer); override; property Blocks: TKMemoBlocks read FBlocks; property BlockStyle: TKMemoBlockStyle read FBlockStyle; property Clip: Boolean read FClip write SetClip; property CurrentRequiredHeight: Integer read FCurrentRequiredHeight; property CurrentRequiredWidth: Integer read FCurrentRequiredWidth; property FixedHeight: Boolean read FFixedHeight write SetFixedHeight; property FixedWidth: Boolean read FFixedWidth write SetFixedWidth; property RequiredHeight: Integer read FRequiredHeight write SetRequiredHeight; property RequiredWidth: Integer read FRequiredWidth write SetRequiredWidth; property TotalLineCount: Integer read GetTotalLineCount; property TotalLineRect[Index: TKMemoTotalLineIndex]: TRect read GetTotalLineRect; end; TKMemoTable = class; TKMemoTableRow = class; { TKMemoTableCell } TKMemoTableCell = class(TKMemoContainer) private FParaStyle: TKMemoParaStyle; FRequiredBorderWidths: TKRect; FSpan: TKCellSpan; function GetColIndex: Integer; function GetParentRow: TKMemoTableRow; function GetParentTable: TKMemoTable; function GetRowIndex: Integer; protected function ContentLength: TKMemoSelectionIndex; override; function GetParaStyle: TKMemoParaStyle; override; procedure ParaStyleChanged(Sender: TObject; AReasons: TKMemoUpdateReasons); procedure RequiredBorderWidthsChanged(Sender: TObject); procedure SetColSpan(Value: Integer); virtual; procedure SetRowSpan(Value: Integer); virtual; procedure SetSpan(const Value: TKCellSpan); virtual; public constructor Create; override; destructor Destroy; override; procedure Assign(ASource: TKObject); override; function PointToIndex(ACanvas: TCanvas; const APoint: TPoint; AFirstRow, ALastRow, AOutOfArea, ASelectionExpanding: Boolean; out APosition: TKMemoLinePosition): TKMemoSelectionIndex; reintroduce; virtual; function WordMeasureExtent(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ARequiredWidth: Integer): TPoint; override; procedure WordPaintToCanvas(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ALeft, ATop: Integer); override; property ParentRow: TKMemoTableRow read GetParentRow; property ParentTable: TKMemoTable read GetParentTable; property RequiredBorderWidths: TKRect read FRequiredBorderWidths; property Span: TKCellSpan read FSpan write SetSpan; property ColIndex: Integer read GetColIndex; property ColSpan: Integer read FSpan.ColSpan write SetColSpan; property RowIndex: Integer read GetRowIndex; property RowSpan: Integer read FSpan.RowSpan write SetRowSpan; end; { TKMemoTableRow } TKMemoTableRow = class(TKMemoContainer) private function GetCells(Index: Integer): TKMemoTableCell; function GetCellCount: Integer; function GetParentTable: TKMemoTable; protected procedure FixedHeightChanged; override; function GetTotalLineCount: Integer; override; function GetTotalLineRect(Index: TKMemoTotalLineIndex): TRect; override; procedure RequiredHeightChanged; override; procedure SetCellCount(const Value: Integer); virtual; public constructor Create; override; destructor Destroy; override; function CanAdd(ABlock: TKMemoBlock): Boolean; override; property CellCount: Integer read GetCellCount write SetCellCount; property Cells[Index: Integer]: TKMemoTableCell read GetCells; property ParentTable: TKMemoTable read GetParentTable; end; TKMemoTable = class(TKMemoContainer) private FCellStyle: TKMemoBlockStyle; FColCount: Integer; FColWidths: TKMemoIndexObjectList; function GetCells(ACol, ARow: Integer): TKMemoTableCell; function GetCellSpan(ACol, ARow: Integer): TKCellSpan; function GetColWidths(Index: Integer): Integer; function GetRows(Index: Integer): TKMemoTableRow; function GetRowCount: Integer; function GetRowHeights(Index: Integer): Integer; procedure SetColCount(const Value: Integer); procedure SetRowCount(const Value: Integer); protected procedure InternalSetCellSpan(ACol, ARow: Integer; const Value: TKCellSpan); virtual; procedure SetCellSpan(ACol, ARow: Integer; Value: TKCellSpan); virtual; procedure SetColWidths(Index: Integer; const Value: Integer); virtual; procedure SetRowHeights(Index: Integer; const Value: Integer); virtual; procedure SetSize(AColCount, ARowCount: Integer); virtual; public constructor Create; override; destructor Destroy; override; procedure ApplyDefaultCellStyle; virtual; procedure Assign(ASource: TKObject); override; procedure AssignAttributes(ABlock: TKMemoBlock); override; function CanAdd(ABlock: TKMemoBlock): Boolean; override; function CalcTotalCellWidth(ACol, ARow: Integer): Integer; virtual; function CellValid(ACol, ARow: Integer): Boolean; virtual; function CellVisible(ACol, ARow: Integer): Boolean; virtual; function ColValid(ACol: Integer): Boolean; virtual; procedure FindBaseCell(ACol, ARow: Integer; out BaseCol, BaseRow: Integer); virtual; function FindCell(ACell: TKMemoTableCell; out ACol, ARow: Integer): Boolean; virtual; procedure FixupBorders; virtual; procedure FixupCellSpan; virtual; procedure FixupCellSpanFromRTF; virtual; function RowValid(ARow: Integer): Boolean; virtual; function WordMeasureExtent(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ARequiredWidth: Integer): TPoint; override; function WordMouseAction(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AAction: TKMemoMouseAction; const APoint: TPoint; AShift: TShiftState): Boolean; override; function WordPointToIndex(ACanvas: TCanvas; const APoint: TPoint; AWordIndex: TKMemoWordIndex; AOutOfArea, ASelectionExpanding: Boolean; out APosition: TKMemoLinePosition): TKMemoSelectionIndex; override; property Cells[ACol, ARow: Integer]: TKMemoTableCell read GetCells; property CellSpan[ACol, ARow: Integer]: TKCellSpan read GetCellSpan write SetCellSpan; property CellStyle: TKMemoBlockStyle read FCellStyle; property ColCount: Integer read FColCount write SetColCount; property ColWidths[Index: Integer]: Integer read GetColWidths write SetColWidths; property RowCount: Integer read GetRowCount write SetRowCount; property RowHeights[Index: Integer]: Integer read GetRowHeights write SetRowHeights; property Rows[Index: Integer]: TKMemoTableRow read GetRows; end; TKMemoMeasState = class(TObject) public CurBlockIndex, LastBlockIndex: TKMemoBlockIndex; CurWordIndex, LastWordIndex: TKMemoWordIndex; CurIndex, LastIndex: TKMemoSelectionIndex; CurTotalWord, LastTotalWord: TKMemoWordIndex; PosX, PosY, RightX, LineHeight, ParaWidth, ParaPosY, RequiredWidth: Integer; IsBreakable, IsParagraph: Boolean; CurParaStyle: TKMemoParaStyle; CurParagraph: TKMemoParagraph; procedure Clear; procedure Assign(AState: TKMemoMeasState); function Initialized: Boolean; end; TKMemoUpdateEvent = procedure(Reasons: TKMemoUpdateReasons) of object; TKMemoBlocks = class(TKObjectList) private FExtent: TPoint; FIgnoreParaMark: Boolean; FMemoNotifier: IKMemoNotifier; FParent: TKMemoBlock; FSelectableLength: TKMemoSelectionIndex; FSelEnd: TKMemoSelectionIndex; FSelStart: TKMemoSelectionIndex; FOnUpdate: TKMemoUpdateEvent; function GetBoundsRect: TRect; function GetEmpty: Boolean; function GetFirstBlock: TKMemoBlock; function GetItem(Index: TKMemoBlockIndex): TKMemoBlock; function GetLastBlock: TKMemoBlock; function GetLineCount: Integer; function GetParentBlocks: TKMemoBlocks; function GetParentMemo: TKCustomMemo; function GetRealSelEnd: TKMemoSelectionIndex; function GetRealSelLength: TKMemoSelectionIndex; function GetRealSelStart: TKMemoSelectionIndex; function GetSelLength: TKMemoSelectionIndex; procedure SetIgnoreParaMark(const Value: Boolean); procedure SetItem(Index: TKMemoBlockIndex; const Value: TKMemoBlock); procedure SetMemoNotifier(const Value: IKMemoNotifier); function IndexToInnerBlock(AIndex: TKMemoSelectionIndex): TKMemoBlock; protected FLines: TKMemoLines; FRelPos: TKMemoIndexObjectList; FState, FBackState: TKMemoMeasState; FUpdateReasons: TKMemoUpdateReasons; procedure CallBeforeUpdate; override; procedure CallAfterUpdate; override; procedure DoUpdate(AReasons: TKMemoUpdateReasons); function EOLToNormal(var AIndex: TKMemoSelectionIndex): Boolean; virtual; function GetDefaultTextStyle: TKMemoTextStyle; virtual; function GetDefaultParaStyle: TKMemoParaStyle; virtual; function GetLineBottom(ALineIndex: TKMemoLineIndex): Integer; virtual; function GetLineEndIndex(ALineIndex: TKMemoLineIndex): TKMemoSelectionIndex; virtual; function GetLineFloat(ALineIndex: TKMemoLineIndex): Boolean; virtual; function GetLineHeight(ALineIndex: TKMemoLineIndex): Integer; virtual; function GetLineInfo(ALineIndex: TKMemoLineIndex): TKMemoLine; function GetLineLeft(ALineIndex: TKMemoLineIndex): Integer; virtual; function GetLinePosition: TKMemoLinePosition; virtual; function GetLineRect(ALineIndex: TKMemoLineIndex): TRect; virtual; function GetLineRight(ALineIndex: TKMemoLineIndex): Integer; virtual; function GetLineText(ALineIndex: TKMemoLineIndex): TKString; virtual; function GetLineSize(ALineIndex: TKMemoLineIndex): Integer; virtual; function GetLineStartIndex(ALineIndex: TKMemoLineIndex): TKMemoSelectionIndex; virtual; function GetLineTop(ALineIndex: TKMemoLineIndex): Integer; virtual; function GetLineWidth(ALineIndex: TKMemoLineIndex): Integer; virtual; function GetMaxWordLength: TKMemoSelectionIndex; virtual; function GetSelectionHasPara: Boolean; virtual; function GetSelectionParaStyle: TKMemoParaStyle; virtual; function GetSelectionTextStyle: TKMemoTextStyle; virtual; function GetSelText: TKString; virtual; function GetShowFormatting: Boolean; virtual; function GetText: TKString; virtual; function GetTotalLeftOffset: Integer; virtual; function GetTotalLineCount: Integer; virtual; function GetTotalLineRect(Index: TKMemoTotalLineIndex): TRect; virtual; function GetTotalTopOffset: Integer; virtual; procedure GetWordIndexes(ABlockIndex: TKMemoBlockIndex; ALineIndex: TKMemoLineIndex; out AStart, AEnd: TKMemoWordIndex); virtual; function LineToRect(ACanvas: TCanvas; AIndex: TKMemoSelectionIndex; ALineIndex: TKMemoLineIndex; ACaret: Boolean): TRect; virtual; function NormalToEOL(var AIndex: TKMemoSelectionIndex): Boolean; virtual; procedure Notify(Ptr: Pointer; Action: TListNotification); override; procedure PaintLineBackground(ACanvas: TCanvas; ALineIndex: TKMemoLineIndex; ALeft, ATop: Integer); virtual; procedure PaintLineInfo(ACanvas: TCanvas; ALineIndex: TKMemoLineIndex; ALeft, ATop: Integer); virtual; function Select(ASelStart, ASelLength: TKMemoSelectionIndex; ADoScroll: Boolean = True; ATextOnly: Boolean = False): Boolean; virtual; procedure SetLineText(ALineIndex: TKMemoLineIndex; const AValue: TKString); virtual; procedure SetSelectionParaStyle(const Value: TKMemoParaStyle); virtual; procedure SetSelectionTextStyle(const Value: TKMemoTextStyle); virtual; procedure SetText(const AValue: TKString); procedure Update(AReasons: TKMemoUpdateReasons); virtual; public constructor Create; override; destructor Destroy; override; function AddAt(AObject: TKMemoBlock; At: TKMemoBlockIndex = -1): TKMemoBlockIndex; virtual; function AddContainer(At: TKMemoBlockIndex = -1): TKMemoContainer; function AddHyperlink(const AText, AURL: TKString; At: TKMemoBlockIndex = -1): TKMemoHyperlink; overload; function AddHyperlink(ABlock: TKMemoHyperlink; At: TKMemoBlockIndex = -1): TKMemoHyperlink; overload; function AddImageBlock(AImage: TPicture; At: TKMemoBlockIndex = -1): TKMemoImageBlock; overload; function AddImageBlock(const APath: TKString; At: TKMemoBlockIndex = -1): TKMemoImageBlock; overload; function AddParagraph(At: TKMemoBlockIndex = -1): TKMemoParagraph; function AddTable(At: TKMemoBlockIndex = -1): TKMemoTable; function AddTextBlock(const AText: TKString; At: TKMemoBlockIndex = -1): TKMemoTextBlock; procedure Assign(ASource: TKObjectList); override; function BlockIndexToBlock(ABlockIndex: TKMemoBlockIndex): TKMemoBlock; function BlockToIndex(ABlock: TKMemoBlock): TKMemoSelectionIndex; virtual; procedure Clear; override; procedure ClearSelection(ATextOnly: Boolean = True); virtual; procedure ConcatEqualBlocks; virtual; procedure DeleteBOL(At: TKMemoSelectionIndex); virtual; procedure DeleteChar(At: TKMemoSelectionIndex); virtual; procedure DeleteEOL(At: TKMemoSelectionIndex); virtual; procedure DeleteLastChar(At: TKMemoSelectionIndex); virtual; procedure DeleteLine(At: TKMemoSelectionIndex); virtual; procedure FixEmptyBlocks; virtual; procedure FixEOL(AIndex: TKMemoSelectionIndex; AAdjust: Boolean; var ALinePos: TKMemoLinePosition); virtual; function GetLastBlockByClass(ABlockIndex: TKMemoBlockIndex; AClass: TKMemoBlockClass): TKMemoBlock; virtual; function GetNearestAnchorBlockIndex(ABlockIndex: TKMemoBlockIndex): TKMemoBlockIndex; virtual; function GetNearestParagraphBlockIndex(ABlockIndex: TKMemoBlockIndex): TKMemoBlockIndex; function GetNearestParagraphBlock(ABlockIndex: TKMemoBlockIndex): TKMemoParagraph; function GetNearestWordIndexes(AIndex: TKMemoSelectionIndex; AAdjust: Boolean; AIncludeWhiteSpaces: Boolean; out AStart, AEnd: TKMemoSelectionIndex): Boolean; virtual; function GetNextBlockByClass(ABlockIndex: TKMemoBlockIndex; AClass: TKMemoBlockClass): TKMemoBlock; virtual; function GetPageCount(APageHeight: Integer): Integer; virtual; procedure GetPageData(APageHeight, APage: Integer; out AOffset, AHeight: Integer); virtual; function GetParentBlocksForBlock(ABlock: TKMemoBlock): TKMemoBlocks; virtual; procedure GetSelColors(out TextColor, Background: TColor); virtual; function IndexAboveLastLine(AIndex: TKMemoSelectionIndex; AAdjust: Boolean): Boolean; virtual; function IndexAtBeginningOfContainer(AIndex: TKMemoSelectionIndex; AAdjust: Boolean): Boolean; virtual; function IndexAtEndOfContainer(AIndex: TKMemoSelectionIndex; AAdjust: Boolean): Boolean; virtual; function IndexBelowFirstLine(AIndex: TKMemoSelectionIndex; AAdjust: Boolean): Boolean; virtual; function IndexToBlockIndex(AIndex: TKMemoSelectionIndex; out ALocalIndex: TKMemoSelectionIndex): TKMemoBlockIndex; virtual; function IndexToBlocks(AIndex: TKMemoSelectionIndex; out ALocalIndex: TKMemoSelectionIndex): TKMemoBlocks; virtual; function IndexToBlock(AIndex: TKMemoSelectionIndex; out ALocalIndex: TKMemoSelectionIndex): TKMemoBlock; virtual; function IndexToLineIndex(AIndex: TKMemoSelectionIndex): TKMemoLineIndex; virtual; function IndexToRect(ACanvas: TCanvas; AIndex: TKMemoSelectionIndex; ACaret, AAdjust: Boolean): TRect; virtual; function InsideOfTable: Boolean; virtual; procedure InsertChar(At: TKMemoSelectionIndex; const AValue: TKChar; AOverWrite: Boolean; ATextStyle: TKMemoTextStyle = nil); virtual; procedure InsertNewLine(At: TKMemoSelectionIndex); virtual; procedure InsertPlainText(AIndex: TKMemoSelectionIndex; const AValue: TKString); virtual; function InsertParagraph(AIndex: TKMemoSelectionIndex; AAdjust: Boolean): Boolean; virtual; function InsertString(AIndex: TKMemoSelectionIndex; AAdjust: Boolean; const AValue: TKString; ATextStyle: TKMemoTextStyle = nil): Boolean; virtual; function LastTextStyle(ABlockIndex: TKMemoBlockIndex): TKMemoTextStyle; virtual; function LineEndIndexByIndex(AIndex: TKMemoSelectionIndex; AAdjust, ASelectionExpanding: Boolean; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; virtual; function LineStartIndexByIndex(AIndex: TKMemoSelectionIndex; AAdjust: Boolean; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; virtual; procedure ListChanged(AList: TKMemoList; ALevel: TKMemoListLevel); virtual; procedure LoadFromRTFStream(AStream: TStream; AtIndex: TKMemoSelectionIndex = -1); virtual; procedure MeasureExtent(ACanvas: TCanvas; ARequiredWidth: Integer); virtual; function MouseAction(AAction: TKMemoMouseAction; ACanvas: TCanvas; const APoint: TPoint; AShift: TShiftState): Boolean; virtual; procedure NotifyDefaultParaChange; virtual; procedure NotifyDefaultTextChange; virtual; procedure NotifyOptionsChange; virtual; procedure NotifyPrintBegin; virtual; procedure NotifyPrintEnd; virtual; function NextIndexByCharCount(AIndex: TKMemoSelectionIndex; ACharCount: Integer): TKMemoSelectionIndex; function NextIndexByHorzExtent(ACanvas: TCanvas; AIndex: TKMemoSelectionIndex; AWidth: Integer; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; virtual; function NextIndexByRowDelta(ACanvas: TCanvas; AIndex: TKMemoSelectionIndex; ARowDelta, ALeftPos: Integer; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; virtual; function NextIndexByVertExtent(ACanvas: TCanvas; AIndex: TKMemoSelectionIndex; AHeight, ALeftPos: Integer; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; virtual; function NextIndexByVertValue(ACanvas: TCanvas; AValue, ALeftPos: Integer; ADirection: Boolean; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; virtual; function PointToBlocks(const APoint: TPoint): TKMemoBlocks; virtual; procedure PaintToCanvas(ACanvas: TCanvas; ALeft, ATop: Integer; const ARect: TRect); virtual; function PointToIndex(ACanvas: TCanvas; const APoint: TPoint; AOutOfArea, ASelectionExpanding: Boolean; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; virtual; function PointToIndexOnLine(ACanvas: TCanvas; ALineIndex: TKMemoLineIndex; const APoint: TPoint; AOutOfArea, ASelectionExpanding: Boolean; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; virtual; function PointToRelativeBlock(const APoint: TPoint): TKMemoBlock; virtual; procedure RestoreUpdateState(AValue: TKMemoUpdateReasons); virtual; procedure SaveToRTFStream(AStream: TStream; ASelectedOnly: Boolean = False); virtual; function SaveUpdateState: TKMemoUpdateReasons; virtual; procedure SetExtent(AWidth, AHeight: Integer); virtual; procedure SetRangeParaStyle(AFrom, ATo: TKMemoSelectionIndex; AStyle: TKMemoParaStyle); virtual; procedure SetRangeTextStyle(AFrom, ATo: TKMemoSelectionIndex; AStyle: TKMemoTextStyle); virtual; function SplitForInsert(AAtIndex: TKMemoSelectionIndex; out ABlockIndex: TKMemoBlockIndex): TKMemoBlocks; virtual; procedure UpdateAttributes; virtual; property BoundsRect: TRect read GetBoundsRect; property DefaultTextStyle: TKMemoTextStyle read GetDefaultTextStyle; property DefaultParaStyle: TKMemoParaStyle read GetDefaultParaStyle; property Empty: Boolean read GetEmpty; property FirstBlock: TKMemoBlock read GetFirstBlock; property Height: Integer read FExtent.Y; property IgnoreParaMark: Boolean read FIgnoreParaMark write SetIgnoreParaMark; property Items[Index: TKMemoBlockIndex]: TKMemoBlock read GetItem write SetItem; default; property LastBlock: TKMemoBlock read GetLastBlock; property LineBottom[ALineIndex: TKMemoLineIndex]: Integer read GetLineBottom; property LineCount: Integer read GetLineCount; property LineEndIndex[ALineIndex: TKMemoLineIndex]: TKMemoSelectionIndex read GetLineEndIndex; property LineFloat[ALineIndex: TKMemoLineIndex]: Boolean read GetLineFloat; property LineInfo[ALineIndex: TKMemoLineIndex]: TKMemoLine read GetLineInfo; property LineHeight[ALineIndex: TKMemoLineIndex]: Integer read GetLineHeight; property LineLeft[ALineIndex: TKMemoLineIndex]: Integer read GetLineLeft; property LineRight[ALineIndex: TKMemoLineIndex]: Integer read GetLineRight; property LineTop[ALineIndex: TKMemoLineIndex]: Integer read GetLineTop; property LineRect[ALineIndex: TKMemoLineIndex]: TRect read GetLineRect; property LineText[ALineIndex: TKMemoLineIndex]: TKString read GetLineText write SetLineText; property Lines: TKMemoLines read FLines; property LineSize[ALineIndex: TKMemoLineIndex]: Integer read GetLineSize; property LineStartIndex[ALineIndex: TKMemoLineIndex]: TKMemoSelectionIndex read GetLineStartIndex; property LineWidth[ALineIndex: TKMemoLineIndex]: Integer read GetLineWidth; property MemoNotifier: IKMemoNotifier read FMemoNotifier write SetMemoNotifier; property Parent: TKMemoBlock read FParent write FParent; property ParentBlocks: TKMemoBlocks read GetParentBlocks; property ParentMemo: TKCustomMemo read GetParentMemo; property RealSelEnd: TKMemoSelectionIndex read GetRealSelEnd; property RealSelLength: TKMemoSelectionIndex read GetRealSelLength; property RealSelStart: TKMemoSelectionIndex read GetRealSelStart; property SelectableLength: TKMemoSelectionIndex read FSelectableLength; property SelectionHasPara: Boolean read GetSelectionHasPara; property SelectionParaStyle: TKMemoParaStyle read GetSelectionParaStyle write SetSelectionParaStyle; property SelectionTextStyle: TKMemoTextStyle read GetSelectionTextStyle write SetSelectionTextStyle; property SelEnd: TKMemoSelectionIndex read FSelEnd; property SelLength: TKMemoSelectionIndex read GetSelLength; property SelStart: TKMemoSelectionIndex read FSelStart; property SelText: TKString read GetSelText; property ShowFormatting: Boolean read GetShowFormatting; property Text: TKString read GetText write SetText; property TotalLeftOffset: Integer read GetTotalLeftOffset; property TotalLineCount: Integer read GetTotalLineCount; property TotalLineRect[Index: TKMemoTotalLineIndex]: TRect read GetTotalLineRect; property TotalTopOffset: Integer read GetTotalTopOffset; property Width: Integer read FExtent.X; property OnUpdate: TKMemoUpdateEvent read FOnUpdate write FOnUpdate; end; { @abstract(Container for all colors used by @link(TKCustomMemo) class) This container allows to group many colors into one item in object inspector. Colors are accessible via published properties or several public Color* properties. } TKMemoColors = class(TKCustomColors) private protected { Returns the specific color according to ColorScheme. } function InternalGetColor(Index: TKColorIndex): TColor; override; { Returns color specification structure for given index. } function GetColorSpec(Index: TKColorIndex): TKColorSpec; override; { Returns maximum color index. } function GetMaxIndex: Integer; override; published { Hex editor client area background. } property BkGnd: TColor index ciBkGnd read GetColor write SetColor default cBkGndDef; { Inactive (memo without focus) caret background color - caret mark is not part of a selection. } property InactiveCaretBkGnd: TColor index ciInactiveCaretBkGnd read GetColor write SetColor default cInactiveCaretBkGndDef; { Inactive (memo without focus) caret background color - caret mark is part of a selection. } property InactiveCaretSelBkGnd: TColor index ciInactiveCaretSelBkGnd read GetColor write SetColor default cInactiveCaretSelBkGndDef; { Inactive (memo without focus) caret text color - caret mark is part of a selection. } property InactiveCaretSelText: TColor index ciInactiveCaretSelText read GetColor write SetColor default cInactiveCaretSelTextDef; { Inactive (memo without focus) caret text color - caret mark is not part of a selection. } property InactiveCaretText: TColor index ciInactiveCaretText read GetColor write SetColor default cInactiveCaretTextDef; { Selection background - inactive edit area. } property SelBkGnd: TColor index ciSelBkGnd read GetColor write SetColor default cSelBkGndDef; { Selection background - active edit area. } property SelBkGndFocused: TColor index ciSelBkGndFocused read GetColor write SetColor default cSelBkGndFocusedDef; { Selection text - inactive edit area. } property SelText: TColor index ciSelText read GetColor write SetColor default cSelTextDef; { Selection text - active edit area. } property SelTextFocused: TColor index ciSelTextFocused read GetColor write SetColor default cSelTextFocusedDef; end; { Declares possible values for the ItemKind member of the @link(TKMemoChangeItem) structure. } TKMemoChangeKind = ( { Save caret position only. } ckCaretPos, { Save inserted data to be able to delete it. } ckDelete, { Save deleted data to be able to insert it. } ckInsert ); { @abstract(Declares @link(TKMemoChangeList.OnChange) event handler)
    Parameters:
  • Sender - identifies the event caller
  • ItemReason - specifies the undo/redo reason
} TKMemoUndoChangeEvent = procedure(Sender: TObject; ItemReason: TKMemoChangeKind) of object; { @abstract(Declares the undo/redo item description structure used by the @link(TKMemoChangeList) class)
    Members:
  • Data - string needed to execute this item
  • EditArea - active edit area at the time this item was recorded
  • Group - identifies the undo/redo group. Some editor modifications produce a sequence of 2 or more undo items. This sequence is called undo/redo group and is always interpreted as a single undo/redo item. Moreover, if there is @link(eoGroupUndo) among @link(TKCustomMemo.Options), a single ecUndo or ecRedo command manipulates all following undo groups of the same kind as if they were a single undo/redo item.
  • GroupKind - kind of this undo group
  • ItemKind - kind of this item
  • SelEnd - end of the selection at the time this item was recorded
  • SelStart - start of the selection at the time this item was recorded
} TKMemoChangeItem = record Blocks: TKMemoBlocks; Group: Cardinal; GroupKind: TKMemoChangeKind; Inserted: Boolean; ItemKind: TKMemoChangeKind; Position: Integer; end; { Pointer to @link(TKMemoChangeItem). } PKMemoChangeItem = ^TKMemoChangeItem; { @abstract(Change (undo/redo item) list manager). } TKMemoChangeList = class(TList) private FEditor: TKCustomMemo; FGroup: Cardinal; FGroupUseLock: Integer; FGroupKind: TKMemoChangeKind; FIndex: Integer; FModifiedIndex: Integer; FLimit: Integer; FRedoList: TKMemoChangeList; FOnChange: TKMemoUndoChangeEvent; function GetModified: Boolean; procedure SetLimit(Value: Integer); procedure SetModified(Value: Boolean); protected { Redefined to properly destroy the items. } procedure Notify(Ptr: Pointer; Action: TListNotification); override; public { Performs necessary initializations
    Parameters:
  • AEditor - identifies the undo/redo list owner
  • RedoList - when this instance is used as undo list, specify a redo list to allow clear it at each valid AddChange call
} constructor Create(AEditor: TKCustomMemo; RedoList: TKMemoChangeList); { Inserts a undo/redo item
    Parameters:
  • ItemKind - specifies the undo/redo item reason. The change list doesn't allow to insert succesive crCaretPos items unless Inserted is True
  • Data - specifies the item data. Some items (crCaretPos) don't need to supply any data
  • Inserted - for the urInsert* items, specifies whether the item was recorded with @link(TKCustomMemo.InsertMode) on (True) or off (False). See ItemKind for crCaretPos behavior.
} procedure AddChange(ItemKind: TKMemoChangeKind; Inserted: Boolean = True); virtual; { Tells the undo list a new undo/redo group is about to be created. Each BeginGroup call must have a corresponding EndGroup call (use try-finally). BeginGroup calls may be nested, however, only the first call will create an undo/redo group. Use the GroupKind parameter to specify the reason of this group. } procedure BeginGroup(GroupKind: TKMemoChangeKind); virtual; { Informs whether there are any undo/redo items available - i.e. CanUndo/CanRedo. } function CanPeek: Boolean; { Clears the entire list - overriden to execute some adjustments. } procedure Clear; override; { Completes the undo/redo group. See @link(TKMemoChangeList.BeginGroup) for details. } procedure EndGroup; virtual; { Returns the topmost item to handle or inspect it. } function PeekItem: PKMemoChangeItem; { If there is no reason to handle an item returned by PeekItem, it has to be poked back with this function to become active for next undo/redo command. } procedure PokeItem; { For redo list only - each undo command creates a redo command with the same group information - see source. } procedure SetGroupData(Group: Integer; GroupKind: TKMemoChangeKind); { Specifies maximum number of items - not groups. } property Limit: Integer read FLimit write SetLimit; { For undo list only - returns True if undo list contains some items with regard to the @link(eoUndoAfterSave) option. } property Modified: Boolean read GetModified write SetModified; { Allows to call TKCustomMemo.@link(TKCustomMemo.OnChange) event. } property OnChange: TKMemoUndoChangeEvent read FOnChange write FOnChange; end; TKMemoRTFString = type string; TKMemoBlockNotifyEvent = procedure(Sender: TObject; ABlock: TKMemoBlock; var Result: Boolean) of object; { @abstract(Multi line text editor base component). } { TKCustomMemo } TKCustomMemo = class(TKCustomControl, IKMemoNotifier) private FActiveBlocks: TKMemoBlocks; FBackground: TKMemoBackground; FBlocks: TKMemoBlocks; FColors: TKMemoColors; FContentPadding: TKRect; FDisabledDrawStyle: TKEditDisabledDrawStyle; FKeyMapping: TKEditKeyMapping; FLeftPos: Integer; FListTable: TKMemoListTable; FMaxWordLength: TKMemoSelectionIndex; FMouseWheelAccumulator: Integer; FNewTextStyle: TKMemoTextStyle; FOptions: TKEditOptions; FParaStyle: TKMemoParaStyle; FRedoList: TKMemoChangeList; FRequiredContentWidth: Integer; FScrollBars: TScrollStyle; FScrollPadding: Integer; FScrollSpeed: Cardinal; FScrollTimer: TTimer; FStates: TKMemoStates; FTextStyle: TKMemoTextStyle; FTopPos: Integer; FUndoList: TKMemoChangeList; FWordBreaks: TKSysCharSet; FOnBlockClick: TKMemoBlockNotifyEvent; FOnBlockDblClick: TKMemoBlockNotifyEvent; FOnBlockEdit: TKMemoBlockNotifyEvent; FOnChange: TNotifyEvent; FOnDropFiles: TKEditDropFilesEvent; FOnReplaceText: TKEditReplaceTextEvent; function GetActiveBlock: TKMemoBlock; function GetActiveInnerBlock: TKMemoBlock; function GetActiveInnerBlocks: TKMemoBlocks; function GetCaretRect: TRect; function GetCaretVisible: Boolean; function GetContentHeight: Integer; function GetContentLeft: Integer; function GetContentRect: TRect; function GetContentTop: Integer; function GetContentWidth: Integer; function GetEmpty: Boolean; function GetInsertMode: Boolean; function GetModified: Boolean; function GetRelativeSelected: Boolean; function GetRequiredContentWidth: Integer; function GetRTF: TKMemoRTFString; function GetSelAvail: Boolean; function GetSelectableLength: TKMemoSelectionIndex; function GetSelectionHasPara: Boolean; function GetSelectionParaStyle: TKMemoParaStyle; function GetSelectionTextStyle: TKMemoTextStyle; function GetSelEnd: TKMemoSelectionIndex; function GetSelLength: TKMemoSelectionIndex; function GetSelStart: TKMemoSelectionIndex; function GetSelText: TKString; function GetText: TKString; function GetUndoLimit: Integer; function IsOptionsStored: Boolean; procedure ScrollTimerHandler(Sender: TObject); procedure SetActiveBlocks(const Value: TKMemoBlocks); procedure SetBackground(const Value: TKMemoBackground); procedure SetColors(Value: TKMemoColors); procedure SetContentPadding(const Value: TKRect); procedure SetDisabledDrawStyle(Value: TKEditDisabledDrawStyle); procedure SetLeftPos(Value: Integer); procedure SetMaxWordLength(const Value: TKMemoSelectionIndex); procedure SetModified(Value: Boolean); procedure SetNewTextStyle(const Value: TKMemoTextStyle); procedure SetOptions(const Value: TKEditOptions); procedure SetReadOnly(Value: Boolean); procedure SetRequiredContentWidth(const Value: Integer); procedure SetRTF(const Value: TKMemoRTFString); procedure SetScrollBars(Value: TScrollStyle); procedure SetScrollPadding(Value: Integer); procedure SetScrollSpeed(Value: Cardinal); procedure SetSelectionParaStyle(const Value: TKMemoParaStyle); procedure SetSelectionTextStyle(const Value: TKMemoTextStyle); procedure SetSelEnd(Value: TKMemoSelectionIndex); procedure SetSelLength(Value: TKMemoSelectionIndex); procedure SetSelStart(Value: TKMemoSelectionIndex); procedure SetText(const Value: TKString); procedure SetTopPos(Value: Integer); procedure SetUndoLimit(Value: Integer); procedure SetWordBreaks(const Value: TKSysCharSet); procedure CMEnabledChanged(var Msg: TLMessage); message CM_ENABLEDCHANGED; procedure CMSysColorChange(var Msg: TLMessage); message CM_SYSCOLORCHANGE; {$IFNDEF FPC} procedure EMGetSel(var Msg: TLMessage); message EM_GETSEL; procedure EMSetSel(var Msg: TLMessage); message EM_SETSEL; {$ENDIF} procedure WMClear(var Msg: TLMessage); message LM_CLEAR; procedure WMCopy(var Msg: TLMessage); message LM_COPY; procedure WMCut(var Msg: TLMessage); message LM_CUT; {$IFNDEF FPC} // no way to get filenames in Lazarus inside control (why??) procedure WMDropFiles(var Msg: TLMessage); message LM_DROPFILES; {$ENDIF} procedure WMEraseBkgnd(var Msg: TLMessage); message LM_ERASEBKGND; procedure WMGetDlgCode(var Msg: TLMNoParams); message LM_GETDLGCODE; procedure WMHScroll(var Msg: TLMHScroll); message LM_HSCROLL; procedure WMKillFocus(var Msg: TLMKillFocus); message LM_KILLFOCUS; procedure WMPaste(var Msg: TLMessage); message LM_PASTE; procedure WMSetFocus(var Msg: TLMSetFocus); message LM_SETFOCUS; procedure WMVScroll(var Msg: TLMVScroll); message LM_VSCROLL; protected FCaretRect: TRect; FDragCurPos: TPoint; FDragMode: TKSizingGripPosition; FDragOrigRect: TRect; FDragRect: TRect; FHorzExtent: Integer; FHorzScrollExtent: Integer; FHorzScrollStep: Integer; FInUpdateScrollRange: Boolean; FLinePosition: TKMemoLinePosition; FNewTextStyleValid: Boolean; FOldCaretRect: TRect; { Method pointer to the private TControl.FontChanged. } FOldFontChanged: TNotifyEvent; FPreferredCaretPos: Integer; FRequiredMouseCursor: TCursor; FSelectedBlock: TKMemoBlock; FVertExtent: Integer; FVertScrollExtent: Integer; FVertScrollStep: Integer; { Inserts a single crCaretPos item into undo list. Unless Force is set to True, this change will be inserted only if previous undo item is not crCaretPos. } procedure AddUndoCaretPos(Force: Boolean = True); virtual; { Inserts a single character change into undo list.
    Parameters:
  • AItemKind - specifies the undo/redo item reason - most likely crInsertChar or crDeleteChar.
  • AData - specifies the character needed to restore the original text state
  • AInserted - for the urInsert* items, specifies the current @link(TKCustomMemo.InsertMode) status.
} procedure AddUndoChar(AItemKind: TKMemoChangeKind; AData: TKChar; AInserted: Boolean = True); virtual; { Inserts a string change into undo list.
    Parameters:
  • AItemKind - specifies the undo/redo item reason - crInsert* or crDelete*.
  • AData - specifies the text string needed to restore the original text state
  • AInserted - for the urInsert* items, specifies the current @link(TKCustomMemo.InsertMode) status.
} procedure AddUndoString(AItemKind: TKMemoChangeKind; const AData: TKString; AInserted: Boolean = True); virtual; { Notify control about main window background changes. } procedure BackgroundChanged(Sender: TObject); virtual; { Begins a new undo group. Use the GroupKind parameter to label it. } procedure BeginUndoGroup(AGroupKind: TKMemoChangeKind); { Converts a rectangle relative to active blocks to a rectangle relative to TKMemo. } function BlockRectToRect(const ARect: TRect): TRect; virtual; { IKMemoNotifier implementation. } function BlockClick(ABlock: TKMemoBlock): Boolean; { IKMemoNotifier implementation. } function BlockDblClick(ABlock: TKMemoBlock): Boolean; { IKMemoNotifier implementation. } procedure BlockFreeNotification(ABlock: TKMemoBlock); { IKMemoNotifier implementation. } procedure BlocksFreeNotification(ABlocks: TKMemoBlocks); { Update the editor after block changes. } procedure BlocksChanged(Reasons: TKMemoUpdateReasons); { Cancel block dragging. } procedure CancelDrag; { Determines whether an ecScroll* command can be executed. } function CanScroll(ACommand: TKEditCommand): Boolean; virtual; { Called by ContentPadding class to update the memo control. } procedure ContentPaddingChanged(Sender: TObject); virtual; { Overriden method - window handle has been created. } procedure CreateHandle; override; { Overriden method - defines additional styles for the memo window (scrollbars etc.). } procedure CreateParams(var Params: TCreateParams); override; { Overriden method - adjusts file drag&drop functionality. } procedure CreateWnd; override; { Overriden method - adjusts file drag&drop functionality. } procedure DestroyWnd; override; { Calls the @link(TKCustomMemo.OnChange) event. } procedure DoChange; virtual; { Performs the Copy command. } function DoCopy: Boolean; virtual; { Overriden method - handles mouse wheel messages. } function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override; { Performs the Paste command. } function DoPaste: Boolean; virtual; { Performs the Redo command. } function DoRedo: Boolean; virtual; { Perforns the Search or Replace command. } function DoSearchReplace(AReplace: Boolean): Boolean; virtual; { Performs the Undo command. } function DoUndo: Boolean; virtual; { Performs block dragging. } procedure DragBlock; { IKMemoNotifier implementation. } function EditBlock(ABlock: TKMemoBlock): Boolean; { Closes the undo group created by @link(TKCustomMemo.BeginUndoGroup). } procedure EndUndoGroup; { Notify blocks about memo font change. } procedure FontChange(Sender: TObject); virtual; { IKMemoNotifier implementation. } function GetActiveBlocks: TKMemoBlocks; { IKMemoNotifier implementation. } function GetDefaultTextStyle: TKMemoTextStyle; { IKMemoNotifier implementation. } function GetDefaultParaStyle: TKMemoParaStyle; { IKMemoNotifier implementation. } function GetDrawSingleChars: Boolean; { Returns actual scroll padding in horizontal direction. } function GetHorzScrollPadding: Integer; virtual; { IKMemoNotifier implementation. } function GetLinePosition: TKMemoLinePosition; { IKMemoNotifier implementation. } function GetListTable: TKMemoListTable; { IKMemoNotifier implementation. } function GetMemo: TKCustomMemo; { IKMemoNotifier implementation. } function GetMaxWordLength: TKMemoSelectionIndex; { Return nearest paragraph. } function GetNearestParagraph: TKMemoParagraph; virtual; { Return block index of nearest paragraph. } function GetNearestParagraphIndex: TKMemoBlockIndex; virtual; { IKMemoNotifier implementation. } function GetPixelsPerInchX: Integer; { IKMemoNotifier implementation. } function GetPixelsPerInchY: Integer; { IKMemoNotifier implementation. } function GetPaintSelection: Boolean; { IKMemoNotifier implementation. } function GetPrinting: Boolean; { IKMemoNotifier implementation. } function GetReadOnly: Boolean; { IKMemoNotifier implementation. } procedure GetSelColors(out Foreground, Background: TColor); { IKMemoNotifier implementation. } function GetSelectedBlock: TKMemoBlock; { IKMemoNotifier implementation. } function GetShowFormatting: Boolean; { Returns "real" selection end - with always higher index value than selection start value. } function GetRealSelEnd: TKMemoSelectionIndex; virtual; { Returns "real" selection length - always non-negative number. } function GetRealSelLength: TKMemoSelectionIndex; { Returns "real" selection start - with always lower index value than selection end value. } function GetRealSelStart: TKMemoSelectionIndex; virtual; { Returns actual scroll padding in vertical direction. } function GetVertScrollPadding: Integer; virtual; { Specific implementation of the standard Visible property. } function GetVisible: Boolean; reintroduce; virtual; { Specific implementation of the standard Visible property. } procedure SetVisible(Value: Boolean); reintroduce; virtual; { IKMemoNotifier implementation. } function GetWordBreaks: TKSysCharSet; { IKMemoNotifier implementation. } function GetWrapSingleChars: Boolean; { IKMemoNotifier implementation. } function HasFocus: Boolean; { Hides the caret. } procedure HideEditorCaret; virtual; { Overriden method - processes virtual key strokes according to current @link(TKCustomMemo.KeyMapping). } procedure KeyDown(var Key: Word; Shift: TShiftState); override; {$IFDEF FPC} { Overriden method - processes character key strokes - data editing. } procedure UTF8KeyPress(var Key: TUTF8Char); override; {$ELSE} { Overriden method - processes character key strokes - data editing. } procedure KeyPress(var Key: Char); override; {$ENDIF} { Overriden method - processes virtual key strokes. } procedure KeyUp(var Key: Word; Shift: TShiftState); override; { Responds to PostLateUpdate. } procedure LateUpdate(var Msg: TLMessage); override; { Update the editor after list table changes. } procedure ListChanged(AList: TKMemoList; ALevel: TKMemoListLevel); virtual; { Updates information about printed shape. } procedure MeasurePages(var Info: TKPrintMeasureInfo); override; { Overriden method - updates caret position/selection. } procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; { Overriden method - updates caret position/selection and initializes scrolling when needed. } procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; { Overriden method - releases mouse capture acquired by MouseDown. } procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; { Ends block dragging. } procedure MoveBlock; { Paints the document to specified canvas. } procedure PaintContent(ACanvas: TCanvas; const ARect: TRect; ALeftOfs, ATopOfs: Integer); { Paints a page to a printer/preview canvas. } procedure PaintPage; override; { Overriden method - calls PaintContent to paint the document into window client area. } procedure PaintToCanvas(ACanvas: TCanvas); override; { Reacts on default paragraph style changes and notifies all paragraph blocks. } procedure ParaStyleChanged(Sender: TObject; AReasons: TKMemoUpdateReasons); virtual; { Converts a point relative to TKMemo to a point relative to active blocks. } function PointToBlockPoint(const APoint: TPoint; ACalcActive: Boolean = True): TPoint; virtual; { Make the blocks ready for normal work. } procedure PrepareToPaint(ACanvas: TCanvas); virtual; { Make the blocks ready for preview or printing. } procedure PrepareToPrint(AScale: Double); virtual; { Overriden method - calls MeasureExtent to update document metrics for printing. } procedure PrintPaintBegin; override; { Overriden method - calls necessary functions to update document metrics for normal painting. } procedure PrintPaintEnd; override; { Grants the input focus to the control when possible and the control has had none before. } procedure SafeSetFocus; { Scrolls the text either horizontally by DeltaHorz scroll units or vertically by DeltaVert scroll units (lines) or in both directions. CodeHorz and CodeVert are the codes coming from WM_HSCROLL or WM_VSCROLL messages. } function Scroll(CodeHorz, CodeVert, DeltaHorz, DeltaVert: Integer; ACallScrollWindow: Boolean): Boolean; { Determines if a cell specified by ACol and ARow should be scrolled, i.e. is not fully visible. } function ScrollNeeded(AMousePos: PPoint; out DeltaCol, DeltaRow: Integer): Boolean; virtual; { Scrolls the memo so that caret will be in the center of client area. } procedure ScrollToClientAreaCenter; { Expands the current selection and performs all necessary adjustments. } procedure SelectionExpand(ASelEnd: TKMemoSelectionIndex; ADoScroll: Boolean = True; APosition: TKMemoLinePosition = eolInside); overload; virtual; { Expands the current selection and performs all necessary adjustments. } procedure SelectionExpand(const APoint: TPoint; ADoScroll: Boolean = True); overload; virtual; { Initializes the current selection and performs all necessary adjustments. } procedure SelectionInit(ASelStart: TKMemoSelectionIndex; ADoScroll: Boolean = True; APosition: TKMemoLinePosition = eolInside); overload; virtual; { Initializes the current selection and performs all necessary adjustments. } procedure SelectionInit(const APoint: TPoint; ADoScroll: Boolean = True); overload; virtual; { IKMemoNotifier implementation. } function SelectBlock(ABlock: TKMemoBlock; APosition: TKSizingGripPosition): Boolean; { IKMemoNotifier implementation. } procedure SetReqMouseCursor(ACursor: TCursor); { Updates mouse cursor according to the state determined from current mouse position. Returns True if cursor has been changed. } function SetMouseCursor(X, Y: Integer): Boolean; override; { Shows the caret. } procedure ShowEditorCaret; virtual; { Returns the rectangle for dragging/resizing a block, in coordinates relative to the memo. } function SizingRect(ABlock: TKMemoBlock): TRect; { Reacts on default text style changes and notifies all text blocks. } procedure TextStyleChanged(Sender: TObject); virtual; { Calls the @link(TKCustomMemo.DoChange) method. } procedure UndoChange(Sender: TObject; ItemKind: TKMemoChangeKind); { Updates caret position, shows/hides caret according to the input focus
    Parameters:
  • AShow - set to True to show the caret
} procedure UpdateEditorCaret(AShow: Boolean = True); virtual; { Update the mouse cursor. } procedure UpdateMouseCursor; virtual; { Update the preferred caret horizontal position. } procedure UpdatePreferredCaretPos; virtual; { Updates the scrolling range. } procedure UpdateScrollRange(CallInvalidate: Boolean); virtual; { Updates the grid size. } procedure UpdateSize; override; { Redo list manager - made accessible for descendant classes. } property RedoList: TKMemoChangeList read FRedoList; { States of this class - made accessible for descendant classes. } property States: TKMemoStates read FStates write FStates; { Undo list manager - made accessible for descendant classes. } property UndoList: TKMemoChangeList read FUndoList; public { Performs necessary initializations - default values to properties, create undo/redo list managers. } constructor Create(AOwner: TComponent); override; { Destroy instance, undo/redo list managers, dispose buffer... } destructor Destroy; override; { Takes property values from another TKCustomMemo class. } procedure Assign(Source: TPersistent); override; { Returns innermost block at given position. } function BlockAt(APos: TPoint): TKMemoBlock; { Returns block bounding rectangle in coordinates relative to the memo. } function BlockRect(ABlock: TKMemoBlock): TRect; { Determines whether the caret is visible. } function CaretInView: Boolean; virtual; { Forces the caret position to become visible. } function ClampInView(AMousePos: PPoint; ACallScrollWindow: Boolean): Boolean; virtual; { Clears all blocks. Unlike @link(ecClearAll) clears everything inclusive undo a redo lists. } procedure Clear(AKeepOnePara: Boolean = True); { Deletes blocks or parts of blocks corresponding to the active selection.
    Parameters:
  • ATextOnly - don't clear containers if True
} procedure ClearSelection(ATextOnly: Boolean = True); virtual; { Clears undo (and redo) list. } procedure ClearUndo; { Determines whether given command can be executed at this time. Use this function in TAction.OnUpdate events.
    Parameters:
  • Command - specifies the command to inspect
} function CommandEnabled(Command: TKEditCommand): Boolean; virtual; { Delete all characters from beginning of line to position given by At. } procedure DeleteBOL(At: TKMemoSelectionIndex); { Delete character at position At (Delete key). } procedure DeleteChar(At: TKMemoSelectionIndex); virtual; { Delete all characters from position given by At to the end of line. } procedure DeleteEOL(At: TKMemoSelectionIndex); { Delete character before position At (Backspace key). } procedure DeleteLastChar(At: TKMemoSelectionIndex); virtual; { Delete whole line at position At. } procedure DeleteLine(At: TKMemoSelectionIndex); { Delete block previously selected with @link(TKCustomMemo.SelectBlock), if any. } procedure DeleteSelectedBlock; virtual; { Executes given command. This function first calls CommandEnabled to assure given command can be executed.
    Parameters:
  • Command - specifies the command to execute
  • Data - specifies the data needed for the command
} function ExecuteCommand(Command: TKEditCommand; Data: Pointer = nil): Boolean; virtual; { Returns current maximum value for the @link(TKCustomMemo.LeftPos) property. } function GetMaxLeftPos: Integer; virtual; { Returns current maximum value for the @link(TKCustomMemo.TopPos) property. } function GetMaxTopPos: Integer; virtual; { Returns indexes corresponding to the word at position AIndex. } function GetNearestWordIndexes(AIndex: TKMemoSelectionIndex; AIncludeWhiteSpaces: Boolean; out AStartIndex, AEndIndex: TKMemoSelectionIndex): Boolean; { Converts a text buffer index into client area rectangle.
    Parameters:
  • AValue - index to convert
  • ACaret - return caret rectangle
} function IndexToRect(AValue: TKMemoSelectionIndex; ACaret: Boolean): TRect; virtual; { Inserts a character at specified position.
    Parameters:
  • At - position where the character should be inserted.
  • AValue - character
} procedure InsertChar(At: TKMemoSelectionIndex; const AValue: TKChar); virtual; { Inserts new line at specified position.
    Parameters:
  • At - position where the new line should be inserted.
} procedure InsertNewLine(At: TKMemoSelectionIndex); virtual; { Inserts a string at specified position.
    Parameters:
  • At - position where the string should be inserted.
  • AValue - inserted string
} procedure InsertString(At: TKMemoSelectionIndex; const AValue: TKString); virtual; { Load contents from a file. Chooses format automatically by extension. Text file is default format. } procedure LoadFromFile(const AFileName: TKString); virtual; { Load contents from a RTF file. } procedure LoadFromRTF(const AFileName: TKString); virtual; { Load contents from a RTF stream. } procedure LoadFromRTFStream(AStream: TStream; AtIndex: TKMemoSelectionIndex = -1); virtual; { Load contents from a plain text file. } procedure LoadFromTXT(const AFileName: TKString); virtual; { Load contents from a plain text stream. } procedure LoadFromTXTStream(AStream: TStream); virtual; { Moves the caret nearest to current mouse position. } procedure MoveCaretToMouseCursor(AIfOutsideOfSelection: Boolean); { Converts client area coordinates into a text buffer index.
    Parameters:
  • APoint - window client area coordinates
  • AOutOfArea - set to True to compute selection even if the the supplied coordinates are outside of the text space
} function PointToIndex(APoint: TPoint; AOutOfArea, ASelectionExpanding: Boolean; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; virtual; { Converts horizontal pixels to points. } function Px2PtX(AValue: Integer): Double; virtual; { Converts vertical pixels to points. } function Px2PtY(AValue: Integer): Double; virtual; { Converts points to horizontal pixels. } function Pt2PxX(AValue: Double): Integer; virtual; { Converts points to vertical pixels. } function Pt2PxY(AValue: Double): Integer; virtual; { Save contents to a file. Chooses format automatically by extension. Text file is default format. } procedure SaveToFile(const AFileName: TKString; ASelectedOnly: Boolean = False); virtual; { Save contents to a RTF file. } procedure SaveToRTF(const AFileName: TKString; ASelectedOnly: Boolean = False; AReadableOutput: Boolean = False); virtual; { Save contents to a RTF stream. } procedure SaveToRTFStream(AStream: TStream; ASelectedOnly: Boolean = False; AReadableOutput: Boolean = False); virtual; { Save contents to a plain text file. } procedure SaveToTXT(const AFileName: TKString; ASelectedOnly: Boolean = False); virtual; { Scrolls the memo window horizontaly by DeltaHorz scroll units and/or vertically by DeltaVert scroll units (lines). } function ScrollBy(DeltaHorz, DeltaVert: Integer; ACallScrollWindow: Boolean): Boolean; reintroduce; virtual; { Specifies the current selection. This is faster than combination of SelStart and SelLength. } procedure Select(ASelStart, ASelLength: TKMemoSelectionIndex; ADoScroll: Boolean = True); virtual; { Activates relative or absolute positioned container nearest to APoint. The container blocks will be accessible through ActiveBlocks. } procedure SetActiveBlocksForPoint(const APoint: TPoint); virtual; { Specifies paragraph style for given range. Does not select the range. } procedure SetRangeParaStyle(AFrom, ATo: TKMemoSelectionIndex; AStyle: TKMemoParaStyle); virtual; { Specifies text style for given range. Does not select the range. } procedure SetRangeTextStyle(AFrom, ATo: TKMemoSelectionIndex; AStyle: TKMemoTextStyle); virtual; { Prepare to insert a new block at given position. Returns requested block index. } function SplitAt(AIndex: TKMemoSelectionIndex): TKMemoBlockIndex; virtual; { Gives access to active memo block (the outermost block at caret position within ActiveBlocks). } property ActiveBlock: TKMemoBlock read GetActiveBlock; { Gives access to innermost active memo block (the innermost block at caret position within ActiveBlocks). } property ActiveInnerBlock: TKMemoBlock read GetActiveInnerBlock; { Gives access to active memo blocks - containers of texts, images etc.. ActiveBlocks might be different from Blocks when editing the embedded text box etc. } property ActiveBlocks: TKMemoBlocks read FActiveBlocks write SetActiveBlocks; { Gives access to innermost active memo blocks - containers of texts, images etc.. ActiveInnerBlocks might be different from ActiveBlocks when inside of a table etc. } property ActiveInnerBlocks: TKMemoBlocks read GetActiveInnerBlocks; { Gives access to memo blocks - containers of texts, images etc.. } property Blocks: TKMemoBlocks read FBlocks; { Main window background. } property Background: TKMemoBackground read FBackground write SetBackground; { Returns current caret position = selection end. } property CaretPos: TKMemoSelectionIndex read GetSelEnd; { Returns caret rectangle in pixels. } property CaretRect: TRect read GetCaretRect; { Returns True if caret is visible. } property CaretVisible: Boolean read GetCaretVisible; { Makes it possible to take all color properties from another TKCustomMemo class. } property Colors: TKMemoColors read FColors write SetColors; { Specifies the padding around the memo contents. } property ContentPadding: TKRect read FContentPadding write SetContentPadding; { Returns height of the memo contents. } property ContentHeight: Integer read GetContentHeight; { Returns the left position of the memo contents. } property ContentLeft: Integer read GetContentLeft; { Returns the bounding rectangle of the memo contents. } property ContentRect: TRect read GetContentRect; { Returns the top position of the memo contents. } property ContentTop: Integer read GetContentTop; { Returns width of the memo contents. } property ContentWidth: Integer read GetContentWidth; { Specifies the style how the outline is drawn when editor is disabled. } property DisabledDrawStyle: TKEditDisabledDrawStyle read FDisabledDrawStyle write SetDisabledDrawStyle default cEditDisabledDrawStyleDef; { Returns True if text buffer is empty. } property Empty: Boolean read GetEmpty; { Returns horizontal scroll padding - relative to client width. } property HorzScrollPadding: Integer read GetHorzScrollPadding; { Returns True if insert mode is on. } property InsertMode: Boolean read GetInsertMode; { Specifies the current key stroke mapping scheme. } property KeyMapping: TKEditKeyMapping read FKeyMapping; { Specifies the horizontal scroll position. } property LeftPos: Integer read FLeftPos write SetLeftPos; { Returns the numbering list table. } property ListTable: TKMemoListTable read FListTable; { Specifies the maximum allowed nonbreakable word length. } property MaxWordLength: TKMemoSelectionIndex read FMaxWordLength write SetMaxWordLength default cMaxWordLengthDef; { Returns True if the buffer was modified - @link(eoUndoAfterSave) taken into account. } property Modified: Boolean read GetModified write SetModified; { Returns nearest paragraph to caret location. } property NearestParagraph: TKMemoParagraph read GetNearestParagraph; { Returns block index of nearest paragraph to caret location. } property NearestParagraphIndex: TKMemoBlockIndex read GetNearestParagraphIndex; { Specifies text style for newly entered character. } property NewTextStyle: TKMemoTextStyle read FNewTextStyle write SetNewTextStyle; { Indicates that style for newly entered text is valid and will be used for next character. } property NewTextStyleValid: Boolean read FNewTextStyleValid; { Specifies the editor options that do not affect painting. } property Options: TKEditOptions read FOptions write SetOptions stored IsOptionsStored; { Specifies default style for paragraphs. } property ParaStyle: TKMemoParaStyle read FParaStyle; { Specifies whether the editor has to be read only editor. } property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False; { Returns "real" selection end - with always higher index value than selection start value. } property RealSelEnd: TKMemoSelectionIndex read GetRealSelEnd; { Returns "real" selection lenth - always non-negative number. } property RealSelLength: TKMemoSelectionIndex read GetRealSelLength; { Returns "real" selection start - with always lower index value than selection end value. } property RealSelStart: TKMemoSelectionIndex read GetRealSelStart; { Returns true when a relative or absolute positioned block is selected. } property RelativeSelected: Boolean read GetRelativeSelected; { Specifies the required content width. } property RequiredContentWidth: Integer read GetRequiredContentWidth write SetRequiredContentWidth; { Allows to save and load the memo contents to/from RTF string.} property RTF: TKMemoRTFString read GetRTF write SetRTF; { Defines visible scrollbars - horizontal, vertical or both. } property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssBoth; { Specifies how fast the scrolling by timer should be. } property ScrollSpeed: Cardinal read FScrollSpeed write SetScrollSpeed default cScrollSpeedDef; { Specifies the padding in pixels to overscroll to show caret position or selection end. } property ScrollPadding: Integer read FScrollPadding write SetScrollPadding default cScrollPaddingDef; { Determines whether a selection is available. } property SelAvail: Boolean read GetSelAvail; { Returns selectable length. } property SelectableLength: TKMemoSelectionIndex read GetSelectableLength; { Returns block previously selected with @link(TKCustomMemo.SelectBlock). } property SelectedBlock: TKMemoBlock read FSelectedBlock; { Determines whether a selection contains a paragraph. } property SelectionHasPara: Boolean read GetSelectionHasPara; { Specifies paragraph style for active selection. } property SelectionParaStyle: TKMemoParaStyle read GetSelectionParaStyle write SetSelectionParaStyle; { Specifies text style for active selection. } property SelectionTextStyle: TKMemoTextStyle read GetSelectionTextStyle write SetSelectionTextStyle; { Specifies the current selection end. } property SelEnd: TKMemoSelectionIndex read GetSelEnd write SetSelEnd; { Specifies the current selection length. SelStart remains unchanged, SelEnd will be updated accordingly. To mark a selection, either set both SelStart and SelEnd properties or both SelStart and SelLength properties. } property SelLength: TKMemoSelectionIndex read GetSelLength write SetSelLength; { Specifies the current selection start. } property SelStart: TKMemoSelectionIndex read GetSelStart write SetSelStart; { Returns selected text. } property SelText: TKString read GetSelText; { If read, returns the textual part of the contents as a whole. If written, replace previous contents by a new one. } property Text: TKString read GetText write SetText; { Specifies default style for text. } property TextStyle: TKMemoTextStyle read FTextStyle; { Specifies the vertical scroll position. } property TopPos: Integer read FTopPos write SetTopPos; { Specifies the maximum number of undo items. Please note this value affects the undo item limit, not undo group limit. } property UndoLimit: Integer read GetUndoLimit write SetUndoLimit default cUndoLimitDef; { Returns vertical scroll padding - relative to client height. } property VertScrollPadding: Integer read GetVertScrollPadding; { Inherited property - see Delphi help. } property Visible: Boolean read GetVisible write SetVisible; { Defines the characters that will be used to split text to breakable words. } property WordBreaks: TKSysCharSet read FWordBreaks write SetWordBreaks; { When assigned, this event will be invoked at each change made to the text buffer either by the user or programmatically by public functions. } property OnChange: TNotifyEvent read FOnChange write FOnChange; { When assigned, this event will be invoked when the user drops any files onto the window. } property OnDropFiles: TKEditDropFilesEvent read FOnDropFiles write FOnDropFiles; { When assigned, this event will be invoked if a block has been clicked with left mouse button in KMemo. Click is called upon releasing the left mouse button for first time. } property OnBlockClick: TKMemoBlockNotifyEvent read FOnBlockClick write FOnBlockClick; { When assigned, this event will be invoked if a block has been double clicked with left mouse button in KMemo. Double click is called upon pressing the left mouse button for second time. } property OnBlockDblClick: TKMemoBlockNotifyEvent read FOnBlockDblClick write FOnBlockDblClick; { When assigned, this event will be invoked if some internal event in KMemo needs to edit a block externally. } property OnBlockEdit: TKMemoBlockNotifyEvent read FOnBlockEdit write FOnBlockEdit; { When assigned, this event will be invoked at each prompt-forced search match. } property OnReplaceText: TKEditReplaceTextEvent read FOnReplaceText write FOnReplaceText; end; { @abstract(Memo design-time component) } TKMemo = class(TKCustomMemo) published { Inherited property - see Delphi help. } property Align; { Inherited property - see Delphi help. } property Anchors; { See TKCustomMemo.@link(TKCustomMemo.Background) for details. } property Background; { See TKCustomControl.@link(TKCustomControl.BorderStyle) for details. } property BorderStyle; { Inherited property - see Delphi help. } property BorderWidth; { See TKCustomMemo.@link(TKCustomMemo.Colors) for details. } property Colors; { Inherited property - see Delphi help. } property Constraints; { See TKCustomMemo.@link(TKCustomMemo.ContentPadding) for details. } property ContentPadding; {$IFNDEF FPC} { Inherited property - see Delphi help. } property Ctl3D; {$ENDIF} { See TKCustomMemo.@link(TKCustomMemo.DisabledDrawStyle) for details. } property DisabledDrawStyle; { Inherited property - see Delphi help. } property DragCursor; { Inherited property - see Delphi help. } property DragKind; { Inherited property - see Delphi help. } property DragMode; { Inherited property - see Delphi help. } property Enabled; { Inherited property - see Delphi help. Font pitch must always remain fpFixed - specify fixed fonts only. Font.Size will also be trimmed if too small or big. } property Font; { Inherited property - see Delphi help. } property Height default cHeight; { See TKCustomMemo.@link(TKCustomMemo.Options) for details. } property Options; { Inherited property - see Delphi help. } property ParentFont; { Inherited property - see Delphi help. } property ParentShowHint; { Inherited property - see Delphi help. } property PopupMenu; { See TKCustomMemo.@link(TKCustomMemo.ReadOnly) for details. } property ReadOnly; { See TKCustomMemo.@link(TKCustomMemo.ScrollBars) for details. } property ScrollBars; { See TKCustomMemo.@link(TKCustomMemo.ScrollPadding) for details. } property ScrollPadding; { See TKCustomMemo.@link(TKCustomMemo.ScrollSpeed) for details. } property ScrollSpeed; { Inherited property - see Delphi help. } property ShowHint; { Inherited property - see Delphi help. } property TabOrder; { Inherited property - see Delphi help. } property TabStop default True; { See TKCustomMemo.@link(TKCustomMemo.UndoLimit) for details. } property UndoLimit; { Inherited property - see Delphi help. } property Visible; { Inherited property - see Delphi help. } property Width default cWidth; { See TKCustomMemo.@link(TKCustomMemo.OnChange) for details. } property OnChange; { See TKCustomMemo.@link(TKCustomMemo.OnBlockClick) for details. } property OnBlockClick; { See TKCustomMemo.@link(TKCustomMemo.OnBlockDblClick) for details. } property OnBlockDblClick; { See TKCustomMemo.@link(TKCustomMemo.OnBlockEdit) for details. } property OnBlockEdit; { Inherited property - see Delphi help. } property OnClick; { Inherited property - see Delphi help. } property OnContextPopup; { Inherited property - see Delphi help. } property OnDblClick; { Inherited property - see Delphi help. } property OnDockDrop; { Inherited property - see Delphi help. } property OnDockOver; { Inherited property - see Delphi help. } property OnDragDrop; { Inherited property - see Delphi help. } property OnDragOver; { See TKCustomMemo.@link(TKCustomMemo.OnDropFiles) for details. } property OnDropFiles; { Inherited property - see Delphi help. } property OnEndDock; { Inherited property - see Delphi help. } property OnEndDrag; { Inherited property - see Delphi help. } property OnEnter; { Inherited property - see Delphi help. } property OnExit; { Inherited property - see Delphi help. } property OnGetSiteInfo; { Inherited property - see Delphi help. } property OnKeyDown; { Inherited property - see Delphi help. } property OnKeyPress; { Inherited property - see Delphi help. } property OnKeyUp; { Inherited property - see Delphi help. } property OnMouseDown; {$IFDEF COMPILER9_UP} { Inherited property - see Delphi help. } property OnMouseEnter; { Inherited property - see Delphi help. } property OnMouseLeave; {$ENDIF} { Inherited property - see Delphi help. } property OnMouseMove; { Inherited property - see Delphi help. } property OnMouseUp; { Inherited property - see Delphi help. } property OnMouseWheel; { Inherited property - see Delphi help. } property OnMouseWheelDown; { Inherited property - see Delphi help. } property OnMouseWheelUp; { See TKCustomMemo.@link(TKCustomMemo.OnReplaceText) for details. } property OnReplaceText; { Inherited property - see Delphi help. } property OnResize; { Inherited property - see Delphi help. } property OnStartDock; { Inherited property - see Delphi help. } property OnStartDrag; { Inherited property - see Delphi help. } property OnUnDock; end; { Base class for standard actions targeting TKMemo. } TKMemoEditAction = class(TAction) protected function GetEditCommand: TKEditCommand; virtual; abstract; public function HandlesTarget(Target: TObject): Boolean; override; procedure UpdateTarget(Target: TObject); override; procedure ExecuteTarget(Target: TObject); override; end; TKMemoEditCopyAction = class(TKMemoEditAction) protected function GetEditCommand: TKEditCommand; override; end; TKMemoEditCutAction = class(TKMemoEditAction) protected function GetEditCommand: TKEditCommand; override; end; TKMemoEditPasteAction = class(TKMemoEditAction) protected function GetEditCommand: TKEditCommand; override; end; TKMemoEditSelectAllAction = class(TKMemoEditAction) protected function GetEditCommand: TKEditCommand; override; end; function NewLineChar: TKString; function SpaceChar: TKString; function TabChar: TKString; implementation uses {$IFDEF MSWINDOWS} ShellApi, {$ENDIF} ClipBrd, Printers, {$IFDEF USE_THEMES} Themes, {$ENDIF} Math, KMemoRTF; {$IFDEF MSWINDOWS} // this is better declaration of GetKerningPairs than in Windows.pas type TKerningPair = packed record wFirst: Word; wSecond: Word; iKernAmount: Integer; end; TKerningPairs = array[0..MaxInt div SizeOf(TKerningPair) - 1] of TKerningPair; PKerningPairs = ^TKerningPairs; function GetKerningPairs(DC: HDC; Count: DWORD; KerningPairs: PKerningPairs): DWORD; stdcall; external 'gdi32.dll' name 'GetKerningPairs'; {$ENDIF} procedure DefaultsToBrush(ABrush: TBrush); begin ABrush.Color := clWindow; ABrush.Style := bsClear; end; procedure DefaultsToFont(AFont: TFont); begin AFont.Name := 'Arial'; AFont.Charset := DEFAULT_CHARSET; AFont.Color := clWindowText; AFont.Size := 10; AFont.Style := []; end; function OppositeKind(ItemKind: TKMemoChangeKind): TKMemoChangeKind; begin case ItemKind of ckDelete: Result := ckInsert; ckInsert: Result := ckDelete; else Result := ItemKind; end; end; function NewLineChar: TKString; begin Result := UnicodeToNativeUTF(cNewlineChar); end; function SpaceChar: TKString; begin Result := UnicodeToNativeUTF(cSpaceChar); end; function TabChar: TKString; begin Result := UnicodeToNativeUTF(cTabChar); end; { TKMemoIndexObject } procedure TKMemoIndexObject.Assign(ASource: TKObject); begin if ASource is TKMemoIndexObject then FIndex := TKMemoIndexObject(ASource).Index; end; constructor TKMemoIndexObject.Create; begin inherited; FIndex := 0; end; function TKMemoIndexObject.EqualProperties(ASource: TKObject): Boolean; begin if ASource is TKMemoIndexObject then Result := (FIndex = TKMemoIndexObject(ASource).Index) else Result := False; end; { TKMemoIndexObjectList } procedure TKMemoIndexObjectList.AddItem(AValue: Integer); var Item: TKMemoIndexObject; begin Item := TKMemoIndexObject.Create; Item.Index := AValue; Add(Item); end; function TKMemoIndexObjectList.GetItem(Index: Integer): TKMemoIndexObject; begin Result := TKMemoIndexObject(inherited GetItem(Index)); end; procedure TKMemoIndexObjectList.SetItem(Index: Integer; const Value: TKMemoIndexObject); begin inherited SetItem(Index, Value); end; procedure TKMemoIndexObjectList.SetSize(ACount: Integer); var I: Integer; begin if ACount <> Count then begin if ACount > Count then begin for I := Count to ACount - 1 do AddItem(0); end else begin for I := ACount to Count - 1 do Delete(ACount); end; end; end; { TKMemoIndexObjectStack } function TKMemoIndexObjectStack.Peek: TKMemoIndexObject; begin Result := TKMemoIndexObject(inherited Peek); end; function TKMemoIndexObjectStack.Pop: TKMemoIndexObject; begin Result := TKMemoIndexObject(inherited Pop); end; function TKMemoIndexObjectStack.PopValue: Integer; var Item: TKMemoIndexObject; begin if Peek <> nil then begin Item := Pop; Result := Item.Index; Item.Free; end else Result := 0; end; function TKMemoIndexObjectStack.Push(AObject: TKMemoIndexObject): TKMemoIndexObject; begin Result := TKMemoIndexObject(inherited Push(AObject)); end; procedure TKMemoIndexObjectStack.PushValue(Value: Integer); var Item: TKMemoIndexObject; begin Item := TKMemoIndexObject.Create; Item.Index := Value; Push(Item); end; { TKMemoDictionaryItem } constructor TKMemoDictionaryItem.Create; begin inherited; FIndex := 0; FValue := 0; end; procedure TKMemoDictionaryItem.Assign(ASource: TKObject); begin if ASource is TKMemoDictionaryItem then begin FIndex := TKMemoDictionaryItem(ASource).Index; FValue := TKMemoDictionaryItem(ASource).Value; end; end; function TKMemoDictionaryItem.EqualProperties(ASource: TKObject): Boolean; begin if ASource is TKMemoDictionaryItem then Result := (FIndex = TKMemoDictionaryItem(ASource).Index) and (FValue = TKMemoDictionaryItem(ASource).Value) else Result := False; end; { TKMemoDictionary } procedure TKMemoDictionary.AddItem(AIndex, AValue: Integer); var Item: TKMemoDictionaryItem; begin Item := TKMemoDictionaryItem.Create; Item.Index := AIndex; Item.Value := AValue; Add(Item); end; function TKMemoDictionary.FindItem(AIndex: Integer): TKMemoDictionaryItem; var I: Integer; begin // this is slow index based search but we don't need fast hash table here Result := nil; for I := 0 to Count - 1 do if Items[I].Index = AIndex then begin Result := Items[I]; Break; end; end; function TKMemoDictionary.GetValue(AIndex, ADefault: Integer): Integer; var Item: TKMemoDictionaryItem; begin Item := FindItem(AIndex); if Item <> nil then Result := Item.Value else Result := ADefault; end; function TKMemoDictionary.GetItem(Index: Integer): TKMemoDictionaryItem; begin Result := TKMemoDictionaryItem(inherited GetItem(Index)); end; procedure TKMemoDictionary.SetItem(Index: Integer; const Value: TKMemoDictionaryItem); begin inherited SetItem(Index, Value); end; procedure TKMemoDictionary.SetValue(AIndex, AValue: Integer); var Item: TKMemoDictionaryItem; begin Item := FindItem(AIndex); if Item <> nil then Item.Value := AValue else AddItem(AIndex, AValue); end; { TKMemoNumberingFormatItem } procedure TKMemoNumberingFormatItem.Assign(ASource: TKObject); begin if ASource is TKMemoNumberingFormatItem then begin FLevel := TKMemoNumberingFormatItem(ASource).Level; FText := TKMemoNumberingFormatItem(ASource).Text; end; end; constructor TKMemoNumberingFormatItem.Create; begin inherited; FLevel := -1; FText := ''; end; { TKMemoNumberingFormat } procedure TKMemoNumberingFormat.AddItem(ALevel: Integer; const AText: TKString); var Item: TKMemoNumberingFormatItem; begin Item := TKMemoNumberingFormatItem.Create; Item.Level := ALevel; Item.Text := AText; Add(Item); end; procedure TKMemoNumberingFormat.Defaults(ANumbering: TKMemoParaNumbering; ALevelIndex: Integer); var I: Integer; begin Clear; case ANumbering of pnuBullets: begin AddItem(-1, UnicodeToNativeUTF(cRoundBullet)); end; pnuArrowTwoBullets: begin AddItem(-1, UnicodeToNativeUTF(cArrowTwoBullet)); end; pnuArrowOneBullets: begin AddItem(-1, UnicodeToNativeUTF(cArrowOneBullet)); end; pnuCircleBullets: begin AddItem(-1, UnicodeToNativeUTF(cCircleBullet)); end; pnuTriangleBullets: begin AddItem(-1, UnicodeToNativeUTF(cTriangleBullet)); end; pnuArabic, pnuLetterLo, pnuLetterHi, pnuRomanLo, pnuRomanHi: begin for I := 0 to ALevelIndex do begin AddItem(I, ''); AddItem(-1, '.'); end; end; end; end; function TKMemoNumberingFormat.GetItem(Index: Integer): TKMemoNumberingFormatItem; begin Result := TKMemoNumberingFormatItem(inherited GetItem(Index)); end; function TKMemoNumberingFormat.GetLevelCount: Integer; var I: Integer; begin Result := 0; for I := 0 to Count - 1 do if (Items[I].Level >= 0) and (Items[I].Text = '') then Inc(Result); end; procedure TKMemoNumberingFormat.InsertItem(AAt, ALevel: Integer; const AText: TKString); var Item: TKMemoNumberingFormatItem; begin Item := TKMemoNumberingFormatItem.Create; Item.Level := ALevel; Item.Text := AText; Insert(AAt, Item); end; procedure TKMemoNumberingFormat.SetItem(Index: Integer; const Value: TKMemoNumberingFormatItem); begin inherited SetItem(Index, Value); end; { TKMemoListLevel } constructor TKMemoListLevel.Create; begin inherited; FFirstIndent := 0; FLeftIndent := 0; FNumberingFont := TFont.Create; DefaultsToFont(FNumberingFont); FNumberingFont.OnChange := FontChanged; FNumberingFontChanged := False; FNumberingFormat := TKMemoNumberingFormat.Create; FNumberingFormat.Defaults(pnuNone, 0); FNumberStartAt := 1; FLevelCounter := FNumberStartAt - 1; end; destructor TKMemoListLevel.Destroy; begin FNumberingFont.Free; FNumberingFormat.Free; inherited; end; procedure TKMemoListLevel.Assign(ASource: TKObject); begin if ASource is TKMemoListLevel then begin FirstIndent := TKMemoListLevel(ASource).FirstIndent; LeftIndent := TKMemoListLevel(ASource).LeftIndent; Numbering := TKMemoListLevel(ASource).Numbering; NumberingFont.Assign(TKMemoListLevel(ASource).NumberingFont); FNumberingFontChanged := TKMemoListLevel(ASource).NumberingFontChanged; NumberingFormat.Assign(TKMemoListLevel(ASource).NumberingFormat); NumberStartAt := TKMemoListLevel(ASource).NumberStartAt; end; end; procedure TKMemoListLevel.Changed; begin if Parent <> nil then TKMemoListLevels(Parent).Changed(Self); end; procedure TKMemoListLevel.FontChanged(Sender: TObject); begin FNumberingFontChanged := True; end; procedure TKMemoListLevel.SetFirstIndent(const Value: Integer); begin if Value <> FFirstIndent then begin FFirstIndent := Value; Changed; end; end; procedure TKMemoListLevel.SetLeftPadding(const Value: Integer); begin if Value <> FLeftIndent then begin FLeftIndent := Value; Changed; end; end; procedure TKMemoListLevel.SetNumbering(const Value: TKMemoParaNumbering); var LevelIndex: Integer; begin if Value <> FNumbering then begin FNumbering := Value; if Parent <> nil then LevelIndex := Parent.IndexOf(Self) else Levelindex := 0; FNumberingFormat.Defaults(Value, LevelIndex); Changed; end; end; procedure TKMemoListLevel.SetNumberStartAt(const Value: Integer); begin if Value <> FNumberStartAt then begin FNumberStartAt := Value; FLevelCounter := FNumberStartAt - 1; Changed; end; end; { TKMemoListLevels } constructor TKMemoListLevels.Create; begin inherited; FParent := nil; end; procedure TKMemoListLevels.Changed(ALevel: TKMemoListLevel); begin if FParent <> nil then FParent.LevelChanged(ALevel); end; procedure TKMemoListLevels.ClearLevelCounters(AFromLevel: Integer); var I: Integer; begin for I := AFromLevel to Count - 1 do Items[I].LevelCounter := Items[I].NumberStartAt - 1; end; function TKMemoListLevels.GetItem(Index: Integer): TKMemoListLevel; begin Result := TKMemoListLevel(inherited GetItem(Index)); end; procedure TKMemoListLevels.SetItem(Index: Integer; const Value: TKMemoListLevel); begin inherited SetItem(Index, Value); end; { TKMemoList } constructor TKMemoList.Create; begin inherited; FLevels := TKMemoListLevels.Create; FLevels.Parent := Self; end; destructor TKMemoList.Destroy; begin FLevels.Free; inherited; end; procedure TKMemoList.Assign(ASource: TKObject); begin if ASource is TKMemoList then begin ID := TKMemoList(ASource).ID; Levels.Assign(TKMemoList(ASource).Levels); end; end; procedure TKMemoList.LevelChanged(ALevel: TKMemoListLevel); begin if Parent <> nil then TKMemoListTable(Parent).ListChanged(Self, ALevel); end; procedure TKMemoList.ParentChanged; begin if Parent <> nil then FID := TKMemoListTable(Parent).NextID else FID := Random(MaxInt); end; { TKMemoListTable } constructor TKMemoListTable.Create; begin inherited; FCallUpdate := False; FOnChanged := nil; end; procedure TKMemoListTable.CallAfterUpdate; begin if FCallUpdate then DoChanged(nil, nil); end; procedure TKMemoListTable.CallBeforeUpdate; begin FCallUpdate := False; end; procedure TKMemoListTable.ClearLevelCounters; var I: Integer; begin for I := 0 to Count - 1 do Items[I].Levels.ClearLevelCounters(0); end; procedure TKMemoListTable.DoChanged(AList: TKMemoList; ALevel: TKMemoListLevel); begin if Assigned(FOnChanged) then FOnChanged(AList, ALevel); end; function TKMemoListTable.FindByID(AListID: Integer): TKMemoList; var I: Integer; begin Result := nil; for I := 0 to Count - 1 do if Items[I].ID = AListID then begin Result := Items[I]; Break; end; end; function TKMemoListTable.GetItem(Index: Integer): TKMemoList; begin Result := TKMemoList(inherited GetItem(Index)); end; procedure TKMemoListTable.ListChanged(AList: TKMemoList; ALevel: TKMemoListLevel); begin if UpdateUnlocked then DoChanged(AList, ALevel) else FCallUpdate := True; end; function TKMemoListTable.ListByNumbering(AListID, ALevelIndex: Integer; ANumbering: TKMemoParaNumbering): TKMemoList; var I, J: Integer; List: TKMemoList; ListLevel: TKMemoListLevel; begin Result := nil; if ANumbering <> pnuNone then begin ALevelIndex := Max(ALevelIndex, 0); // search for existing list List := FindByID(AListID); if List <> nil then begin // list found, use it if ALevelIndex < List.Levels.Count then begin // level found, modify it ListLevel := List.Levels[ALevelIndex]; ListLevel.Numbering := ANumbering; end else begin // add missing levels for J := List.Levels.Count to ALevelIndex do begin ListLevel := TKMemoListLevel.Create; List.Levels.Add(ListLevel); ListLevel.Numbering := ANumbering; end; end; Result := List; end else begin // list not found, so search list table, if some list has the wanted numbering at requested level for I := 0 to Count - 1 do begin List := Items[I]; if ALevelIndex < List.Levels.Count then begin if List.Levels[ALevelIndex].Numbering = ANumbering then begin Result := List; Break; end; end else begin // use first available list and add all the missing levels for J := List.Levels.Count to ALevelIndex do begin ListLevel := TKMemoListLevel.Create; List.Levels.Add(ListLevel); ListLevel.Numbering := ANumbering; end; Result := List; Break; end; end; end; if Result = nil then begin // no suitable list found in table, so create new one List := TKMemoList.Create; for I := 0 to ALevelIndex do begin ListLevel := TKMemoListLevel.Create; List.Levels.Add(ListLevel); ListLevel.Numbering := ANumbering; end; Add(List); Result := List; end; end; end; function TKMemoListTable.NextID: Integer; var I, MaxID: Integer; begin MaxID := cInvalidListID; for I := 0 to Count - 1 do MaxID := Max(MaxID, Items[I].ID); Inc(MaxID); // assume there will never be an overflow Result := MaxID; end; procedure TKMemoListTable.SetItem(Index: Integer; const Value: TKMemoList); begin inherited SetItem(Index, Value); end; { TKMemoBackground } constructor TKMemoBackground.Create; begin inherited; FColor := clNone; FImage := TPicture.Create; FImage.OnChange := ImageChanged; FRepeatX := True; FRepeatY := True; FOnChanged := nil; end; destructor TKMemoBackground.Destroy; begin FImage.Free; inherited; end; procedure TKMemoBackground.ImageChanged(Sender: TObject); begin Changed; end; procedure TKMemoBackground.Assign(ASource: TPersistent); begin if ASource is TKMemoTextStyle then begin Color := TKMemoBackground(ASource).Color; Image.Assign(TKMemoBackground(ASource).Image); RepeatX := TKMemoBackground(ASource).RepeatX; RepeatY := TKMemoBackground(ASource).RepeatY; end; end; procedure TKMemoBackground.Clear; begin FImage.Graphic := nil; FColor := clNone; end; procedure TKMemoBackground.SetColor(const Value: TColor); begin if Value <> FColor then begin FColor := Value; Changed; end; end; procedure TKMemoBackground.SetImage(const Value: TPicture); begin FImage.Assign(Value); end; procedure TKMemoBackground.SetRepeatX(const Value: Boolean); begin if Value <> FRepeatX then begin FRepeatX := Value; Changed; end; end; procedure TKMemoBackground.SetRepeatY(const Value: Boolean); begin if Value <> FRepeatY then begin FRepeatY := Value; Changed; end; end; procedure TKMemoBackground.Update; begin inherited; if Assigned(FOnChanged) then FOnChanged(Self); end; { TKMemoTextStyle } constructor TKMemoTextStyle.Create; begin inherited; FChangeable := True; FBrush := TBrush.Create; FBrush.OnChange := BrushChanged; FFont := TFont.Create; FFont.OnChange := FontChanged; FOnChanged := nil; Defaults; end; procedure TKMemoTextStyle.Defaults; var OldState: Boolean; begin FAllowBrush := True; FCapitals := tcaNone; FScriptPosition := tpoNormal; FStyleChanged := False; OldState := Changeable; Changeable := False; try DefaultsToBrush(FBrush); DefaultsToFont(FFont); finally Changeable := OldState; end; end; destructor TKMemoTextStyle.Destroy; begin FBrush.Free; FFont.Free; inherited; end; procedure TKMemoTextStyle.Assign(ASource: TPersistent); var OldState: Boolean; begin if ASource is TKMemoTextStyle then begin OldState := Changeable; Changeable := TKMemoTextStyle(ASource).Changeable; LockUpdate; try Brush.Assign(TKMemoTextStyle(ASource).Brush); Capitals := TKMemoTextStyle(ASource).Capitals; Font.Assign(TKMemoTextStyle(ASource).Font); ScriptPosition := TKMemoTextStyle(ASource).ScriptPosition; finally Changeable := OldState; UnlockUpdate; end; end; end; procedure TKMemoTextStyle.BrushChanged(Sender: TObject); begin if UpdateUnlocked then FBrushChanged := True; PropsChanged; end; function TKMemoTextStyle.EqualProperties(ASource: TKMemoTextStyle): Boolean; begin if ASource <> nil then begin Result := (ASource.AllowBrush = AllowBrush) and (ASource.Capitals = Capitals) and (ASource.ScriptPosition = ScriptPosition) and CompareBrushes(ASource.Brush, Brush) and CompareFonts(ASource.Font, Font); end else Result := False; end; procedure TKMemoTextStyle.FontChanged(Sender: TObject); begin if UpdateUnlocked then FFontChanged := True; PropsChanged; end; procedure TKMemoTextStyle.NotifyChange(AValue: TKMemoTextStyle); begin if not FStyleChanged and UpdateUnlocked then Assign(AValue); end; procedure TKMemoTextStyle.PropsChanged; begin if Changeable then FStyleChanged := True; Changed; end; procedure TKMemoTextStyle.SetAllowBrush(const Value: Boolean); begin if Value <> FAllowBrush then begin FAllowBrush := Value; PropsChanged; end; end; procedure TKMemoTextStyle.SetBrush(const Value: TBrush); begin FBrush.Assign(Value); end; procedure TKMemoTextStyle.SetCapitals(const Value: TKMemoScriptCapitals); begin if Value <> FCapitals then begin FCapitals := Value; PropsChanged; end; end; procedure TKMemoTextStyle.SetFont(const Value: TFont); begin FFont.Assign(Value); end; procedure TKMemoTextStyle.SetScriptPosition(const Value: TKMemoScriptPosition); begin if Value <> FScriptPosition then begin FScriptPosition := Value; PropsChanged; end; end; procedure TKMemoTextStyle.Update; begin if Assigned(FOnChanged) then FOnChanged(Self); end; { TKMemoParagraphStyle } constructor TKMemoBlockStyle.Create; begin inherited; FChangeable := True; FBorderWidths := TKRect.Create; FBorderWidths.OnChanged := BrushChanged; FBrush := TBrush.Create; FBrush.OnChange := BrushChanged; FContentMargin := TKRect.Create; FContentMargin.OnChanged := BrushChanged; FContentPadding := TKRect.Create; FContentPadding.OnChanged := BrushChanged; FFillBlip := nil; FOnChanged := nil; Defaults; end; destructor TKMemoBlockStyle.Destroy; begin FBorderWidths.Free; FBrush.Free; FContentPadding.Free; FContentMargin.Free; FFillBlip.Free; inherited; end; procedure TKMemoBlockStyle.Assign(ASource: TPersistent); var OldState: Boolean; begin if ASource is TKMemoBlockStyle then begin OldState := Changeable; Changeable := TKMemoBlockStyle(ASource).Changeable; LockUpdate; try BorderColor := TKMemoBlockStyle(ASource).BorderColor; BorderRadius := TKMemoBlockStyle(ASource).BorderRadius; BorderWidth := TKMemoBlockStyle(ASource).BorderWidth; BorderWidths.Assign(TKMemoBlockStyle(ASource).BorderWidths); Brush.Assign(TKMemoBlockStyle(ASource).Brush); WrapMode := TKMemoParaStyle(ASource).WrapMode; ContentMargin.Assign(TKMemoBlockStyle(ASource).ContentMargin); ContentPadding.Assign(TKMemoBlockStyle(ASource).ContentPadding); HAlign := TKMemoParaStyle(ASource).HAlign; finally Changeable := OldState; UnlockUpdate; end; end; end; function TKMemoBlockStyle.BorderRect(const ARect: TRect): TRect; begin Result := ARect; if FBorderWidths.NonZero then begin Inc(Result.Left, FBorderWidths.Left); Inc(Result.Top, FBorderWidths.Top); Dec(Result.Right, FBorderWidths.Right); Dec(Result.Bottom, FBorderWidths.Bottom); end else InflateRect(Result, -FBorderWidth, -FBorderWidth); end; procedure TKMemoBlockStyle.BrushChanged(Sender: TObject); begin PropsChanged([muExtent]); end; procedure TKMemoBlockStyle.Defaults; begin FBorderColor := clBlack; FBorderRadius := 0; FBorderWidth := 0; FBorderWidths.All := 0; FBrush.Style := bsClear; FContentPadding.All := 0; FContentMargin.All := 0; FHAlign := halLeft; FStyleChanged := False; FWrapMode := wrAround; end; function TKMemoBlockStyle.GetAllPaddingsBottom: Integer; begin Result := BottomBorderWidth + BottomMargin + BottomPadding; end; function TKMemoBlockStyle.GetAllPaddingsLeft: Integer; begin Result := LeftBorderWidth + LeftMargin + LeftPadding; end; function TKMemoBlockStyle.GetAllPaddingsRight: Integer; begin Result := RightBorderWidth + RightMargin + RightPadding; end; function TKMemoBlockStyle.GetAllPaddingsTop: Integer; begin Result := TopBorderWidth + TopMargin + TopPadding; end; function TKMemoBlockStyle.GetBottomBorderWidth: Integer; begin Result := Max(FBorderWidths.Bottom, FBorderWidth); end; function TKMemoBlockStyle.GetBottomMargin: Integer; begin Result := FContentMargin.Bottom; end; function TKMemoBlockStyle.GetBottomPadding: Integer; begin Result := FContentPadding.Bottom; end; function TKMemoBlockStyle.GetLeftBorderWidth: Integer; begin Result := Max(FBorderWidths.Left, FBorderWidth); end; function TKMemoBlockStyle.GetLeftMargin: Integer; begin Result := FContentMargin.Left; end; function TKMemoBlockStyle.GetLeftPadding: Integer; begin Result := FContentPadding.Left; end; function TKMemoBlockStyle.GetRightBorderWidth: Integer; begin Result := Max(FBorderWidths.Right, FBorderWidth); end; function TKMemoBlockStyle.GetRightMargin: Integer; begin Result := FContentMargin.Right; end; function TKMemoBlockStyle.GetRightPadding: Integer; begin Result := FContentPadding.Right; end; function TKMemoBlockStyle.GetTopBorderWidth: Integer; begin Result := Max(FBorderWidths.Top, FBorderWidth); end; function TKMemoBlockStyle.GetTopMargin: Integer; begin Result := FContentMargin.Top; end; function TKMemoBlockStyle.GetTopPadding: Integer; begin Result := FContentPadding.Top; end; function TKMemoBlockStyle.InteriorRect(const ARect: TRect): TRect; begin Result := ARect; if FContentPadding.NonZero then begin Inc(Result.Left, FContentPadding.Left); Inc(Result.Top, FContentPadding.Top); Dec(Result.Right, FContentPadding.Right); Dec(Result.Bottom, FContentPadding.Bottom); end; end; function TKMemoBlockStyle.MarginRect(const ARect: TRect): TRect; begin Result := ARect; if FContentMargin.NonZero then begin Inc(Result.Left, FContentMargin.Left); Inc(Result.Top, FContentMargin.Top); Dec(Result.Right, FContentMargin.Right); Dec(Result.Bottom, FContentMargin.Bottom); end; end; procedure TKMemoBlockStyle.NotifyChange(AValue: TKMemoBlockStyle); begin if not FStyleChanged and UpdateUnlocked then Assign(Avalue); end; procedure TKMemoBlockStyle.PaintBox(ACanvas: TCanvas; const ARect: TRect); var R, RB: TRect; begin if (FBrush.Style <> bsClear) or (FBorderWidth > 0) or FBorderWidths.NonZero then with ACanvas do begin if FBorderWidths.NonZero or (FBorderWidth > 0) and (FBorderRadius = 0) then begin R := ARect; Pen.Style := psClear; Brush.Color := FBorderColor; Brush.Style := bsSolid; if LeftBorderWidth <> 0 then begin RB := ARect; RB.Right := RB.Left + LeftBorderWidth; R.Left := RB.Right; FillRect(RB); end; if TopBorderWidth <> 0 then begin RB := ARect; RB.Bottom := RB.Top + TopBorderWidth; R.Top := RB.Bottom; FillRect(RB); end; if RightBorderWidth <> 0 then begin RB := ARect; RB.Left := RB.Right - RightBorderWidth; R.Right := RB.Left; FillRect(RB); end; if BottomBorderWidth <> 0 then begin RB := ARect; RB.Top := RB.Bottom - BottomBorderWidth; R.Bottom := RB.Top; FillRect(RB); end; Brush.Assign(FBrush); // keep this here, some printers draw incorrectly for bsClear style if Brush.Style <> bsClear then FillRect(R); end else begin Brush.Assign(FBrush); Pen.Style := psSolid; Pen.Width := FBorderWidth; Pen.Color := FBorderColor; if FBorderRadius > 0 then RoundRectangle(ACanvas, ARect, FBorderRadius, FBorderRadius) else if FBorderWidth > 0 then Rectangle(ARect) else if Brush.Style <> bsClear then FillRect(ARect); end; end; end; procedure TKMemoBlockStyle.PropsChanged(AReasons: TKMemoUpdateReasons); begin FUpdateReasons := AReasons; if Changeable then FStyleChanged := True; Changed; end; procedure TKMemoBlockStyle.SetBorderColor(const Value: TColor); begin if Value <> FBorderColor then begin FBorderColor := Value; PropsChanged([muExtent]); end; end; procedure TKMemoBlockStyle.SetBorderRadius(const Value: Integer); begin if Value <> FBorderRadius then begin FBorderRadius := Value; PropsChanged([muExtent]); end; end; procedure TKMemoBlockStyle.SetBorderWidth(const Value: Integer); begin if Value <> FBorderWidth then begin FBorderWidth := Value; PropsChanged([muExtent]); end; end; procedure TKMemoBlockStyle.SetBorderWidths(const Value: TKRect); begin FBorderWidths.Assign(Value); end; procedure TKMemoBlockStyle.SetBottomMargin(const Value: Integer); begin FContentMargin.Bottom := Value; end; procedure TKMemoBlockStyle.SetBottomPadding(const Value: Integer); begin FContentPadding.Bottom := Value; end; procedure TKMemoBlockStyle.SetBrush(const Value: TBrush); begin FBrush.Assign(Value); end; procedure TKMemoBlockStyle.SetWrapMode(const Value: TKMemoBlockWrapMode); begin if Value <> FWrapMode then begin FWrapMode := Value; PropsChanged([muExtent]); end; end; procedure TKMemoBlockStyle.SetContentMargin(const Value: TKRect); begin FContentMargin.Assign(Value); end; procedure TKMemoBlockStyle.SetContentPadding(const Value: TKRect); begin FContentPadding.Assign(Value); end; procedure TKMemoBlockStyle.SetFillBlip(const Value: TGraphic); var Cls: TGraphicClass; begin FreeAndNil(FFillBlip); if Value <> nil then begin Cls := TGraphicClass(Value.ClassType); FFillBlip := Cls.Create; FFillBlip.Assign(Value); end; PropsChanged([muExtent]); end; procedure TKMemoBlockStyle.SetHAlign(const Value: TKHAlign); begin if Value <> FHAlign then begin FHAlign := Value; PropsChanged([muExtent]); end; end; procedure TKMemoBlockStyle.SetLeftMargin(const Value: Integer); begin FContentMargin.Left := Value; end; procedure TKMemoBlockStyle.SetLeftPadding(const Value: Integer); begin FContentPadding.Left := Value; end; procedure TKMemoBlockStyle.SetRightMargin(const Value: Integer); begin FContentMargin.Right := Value; end; procedure TKMemoBlockStyle.SetRightPadding(const Value: Integer); begin FContentPadding.Right := Value; end; procedure TKMemoBlockStyle.SetTopMargin(const Value: Integer); begin FContentMargin.Top := Value; end; procedure TKMemoBlockStyle.SetTopPadding(const Value: Integer); begin FContentPadding.Top := Value; end; procedure TKMemoBlockStyle.Update; begin if Assigned(FOnChanged) then FOnChanged(Self, FUpdateReasons); end; { TKMemoParagraphStyle } procedure TKMemoParaStyle.Defaults; begin inherited; FFirstIndent := 0; FLineSpacingFactor := 1; FLineSpacingMode := lsmFactor; FLineSpacingValue := 0; FNumberingList := cInvalidListID; FNumberingListLevel := -1; FNumberStartAt := 0; FWordWrap := True; end; procedure TKMemoParaStyle.Assign(ASource: TPersistent); begin inherited; if ASource is TKMemoParaStyle then begin FirstIndent := TKMemoParaStyle(ASource).FirstIndent; LineSpacingFactor := TKMemoParaStyle(ASource).LineSpacingFactor; LineSpacingMode := TKMemoParaStyle(ASource).LineSpacingMode; LineSpacingValue := TKMemoParaStyle(ASource).LineSpacingValue; NumberingListLevel := TKMemoParaStyle(ASource).NumberingListLevel; NumberingList := TKMemoParaStyle(ASource).NumberingList; NumberStartAt := TKMemoParaStyle(ASource).NumberStartAt; WordWrap := TKMemoParaStyle(ASource).WordWrap; end; end; procedure TKMemoParaStyle.SetFirstIndent(const Value: Integer); begin if Value <> FFirstIndent then begin FFirstIndent := Value; PropsChanged([muExtent]); end; end; procedure TKMemoParaStyle.SetLineSpacingValue(const Value: Integer); begin if Value <> FLineSpacingValue then begin FLineSpacingValue := Value; PropsChanged([muExtent]); end; end; procedure TKMemoParaStyle.SetLineSpacingFactor(const Value: Double); var Tmp: Double; begin Tmp := MinMax(Value, 1, 10); if Tmp <> FLineSpacingFactor then begin FLineSpacingFactor := Tmp; PropsChanged([muExtent]); end; end; procedure TKMemoParaStyle.SetLineSpacingMode(const Value: TKMemoLineSpacingMode); begin if Value <> FLineSpacingMode then begin FLineSpacingMode := Value; PropsChanged([muExtent]); end; end; procedure TKMemoParaStyle.SetNumberStartAt(const Value: Integer); begin if Value <> FNumberStartAt then begin FNumberStartAt := Value; PropsChanged([muContent]); end; end; procedure TKMemoParaStyle.SetNumberingList(const Value: Integer); begin if Value <> FNumberingList then begin FNumberingList := Value; if FNumberingList >= 0 then FNumberingListLevel := Max(FNumberingListLevel, 0) else FNumberingListLevel := -1; PropsChanged([muContent]); end; end; procedure TKMemoParaStyle.SetNumberingListAndLevel(AListID, ALevelIndex: Integer); begin FNumberingList := AListID; FNumberingListLevel := ALevelIndex; PropsChanged([muContent]); end; procedure TKMemoParaStyle.SetNumberingListLevel(const Value: Integer); begin if Value <> FNumberingListLevel then begin FNumberingListLevel := Value; PropsChanged([muContent]); end; end; procedure TKMemoParaStyle.SetWordWrap(const Value: Boolean); begin if Value <> FWordWrap then begin FWordWrap := Value; PropsChanged([muExtent]); end; end; { TKMemoLine } constructor TKMemoLine.Create; begin FPosition := CreateEmptyPoint; FExtent := CreateEmptyPoint; FEndBlock := 0; FEndIndex := 0; FEndWord := 0; FStartBlock := 0; FStartIndex := 0; FStartWord := 0; end; function TKMemoLine.GetLineRect: TRect; begin Result := Rect(FPosition.X, FPosition.Y, FPosition.X + FExtent.X, FPosition.Y + FExtent.Y); end; { TKMemoLines } function TKMemoLines.GetItem(Index: TKMemoLineIndex): TKMemoLine; begin Result := TKMemoLine(inherited GetItem(Index)); end; procedure TKMemoLines.SetItem(Index: TKMemoLineIndex; const Value: TKMemoLine); begin inherited SetItem(Index, Value); end; { TKWord } procedure TKMemoWord.Clear; begin FBaseLine := 0; FBottomPadding := 0; FClipped := False; FExtent := CreateEmptyPoint; FEndIndex := 0; FPosition := CreateEmptyPoint; FStartIndex := 0; FTopPadding := 0; end; constructor TKMemoWord.Create; begin Clear; end; { TKWordList } function TKMemoWordList.GetItem(Index: TKMemoWordIndex): TKMemoWord; begin Result := TKMemoWord(inherited GetItem(Index)); end; procedure TKMemoWordList.SetItem(Index: TKMemoWordIndex; const Value: TKMemoWord); begin inherited SetItem(Index, Value); end; { TKMemoColors } function TKMemoColors.GetColorSpec(Index: TKColorIndex): TKColorSpec; begin case Index of ciBkGnd: begin Result.Def := cBkGndDef; Result.Name := ''; end; ciInactiveCaretBkGnd: begin Result.Def := cInactiveCaretBkGndDef; Result.Name := ''; end; ciInactiveCaretSelBkGnd: begin Result.Def := cInactiveCaretSelBkGndDef; Result.Name := ''; end; ciInactiveCaretSelText: begin Result.Def := cInactiveCaretSelTextDef; Result.Name := ''; end; ciInactiveCaretText: begin Result.Def := cInactiveCaretTextDef; Result.Name := ''; end; ciSelBkGnd: begin Result.Def := cSelBkGndDef; Result.Name := ''; end; ciSelBkGndFocused: begin Result.Def := cSelBkGndFocusedDef; Result.Name := ''; end; ciSelText: begin Result.Def := cSelTextDef; Result.Name := ''; end; ciSelTextFocused: begin Result.Def := cSelTextFocusedDef; Result.Name := ''; end; else Result := inherited GetColorSpec(Index); end; end; function TKMemoColors.InternalGetColor(Index: TKColorIndex): TColor; begin case FColorScheme of csGrayed: if Index = ciBkGnd then Result := clWindow else Result := clGrayText; csBright: begin if FBrightColors[Index] = clNone then FBrightColors[Index] := BrightColor(FColors[Index], 0.5, bsOfTop); Result := FBrightColors[Index]; end; csGrayScale: Result := ColorToGrayScale(FColors[Index]); else Result := FColors[Index]; end; end; function TKMemoColors.GetMaxIndex: Integer; begin Result := ciMemoColorsMax; end; { TKMemoChangeList } constructor TKMemoChangeList.Create(AEditor: TKCustomMemo; RedoList: TKMemoChangeList); begin inherited Create; FEditor := AEditor; FGroupUseLock := 0; FLimit := cUndoLimitDef; FIndex := -1; FModifiedIndex := FIndex; FRedoList := RedoList; FOnChange := nil; end; procedure TKMemoChangeList.AddChange(ItemKind: TKMemoChangeKind; Inserted: Boolean); var P: PKMemoChangeItem; begin // don't allow succesive crCaretPos if (ItemKind = ckCaretPos) and not Inserted and (FIndex >= 0) and (PKMemoChangeItem(Items[FIndex]).ItemKind = ckCaretPos) then Exit; if FIndex < FLimit - 1 then begin if FIndex < Count - 1 then Inc(FIndex) else FIndex := Add(New(PKMemoChangeItem)); P := Items[FIndex]; if FGroupUseLock > 0 then begin P.Group := FGroup; P.GroupKind := FGroupKind; end else begin P.Group := 0; P.GroupKind := ItemKind; end; P.ItemKind := ItemKind; P.Position := FEditor.SelStart; // P.Data := Data; P.Inserted := Inserted; if FRedoList <> nil then FRedoList.Clear; if Assigned(FOnChange) then FOnChange(Self, ItemKind); end; end; procedure TKMemoChangeList.BeginGroup(GroupKind: TKMemoChangeKind); begin if FGroupUseLock = 0 then begin FGroupKind := GroupKind; Inc(FGroup); if FGroup = 0 then Inc(FGroup); end; Inc(FGroupUseLock); end; function TKMemoChangeList.CanPeek: Boolean; begin Result := FIndex >= 0; end; procedure TKMemoChangeList.Clear; begin inherited; FGroupUseLock := 0; FIndex := -1; FModifiedIndex := FIndex; end; procedure TKMemoChangeList.EndGroup; begin if FGroupUseLock > 0 then Dec(FGroupUseLock); end; function TKMemoChangeList.GetModified: Boolean; function CaretPosOnly: Boolean; var I: Integer; begin Result := True; for I := FModifiedIndex + 1 to FIndex do begin if PKMemoChangeItem(Items[I]).ItemKind <> ckCaretPos then begin Result := False; Exit; end; end; end; begin Result := (FIndex > FModifiedIndex) and not CaretPosOnly; end; procedure TKMemoChangeList.Notify(Ptr: Pointer; Action: TListNotification); var P: PKMemoChangeItem; begin case Action of lnDeleted: if Ptr <> nil then begin P := Ptr; Dispose(P); end; end; end; function TKMemoChangeList.PeekItem: PKMemoChangeItem; begin if CanPeek then begin Result := Items[FIndex]; Dec(FIndex); end else Result := nil; end; procedure TKMemoChangeList.PokeItem; begin if FIndex < Count - 1 then Inc(FIndex); end; procedure TKMemoChangeList.SetGroupData(Group: Integer; GroupKind: TKMemoChangeKind); begin FGroup := Group; FGroupKind := GroupKind; FGroupUseLock := 1; end; procedure TKMemoChangeList.SetLimit(Value: Integer); begin if Value <> FLimit then begin FLimit := MinMax(Value, cUndoLimitMin, cUndoLimitMax); while Count > FLimit do Delete(0); FIndex := Min(FIndex, FLimit - 1); end; end; procedure TKMemoChangeList.SetModified(Value: Boolean); begin if not Value then FModifiedIndex := FIndex; end; { TKCustomMemo } constructor TKCustomMemo.Create(AOwner: TComponent); begin inherited Create(AOwner); Color := clWindow; ControlStyle := [csOpaque, csClickEvents, csDoubleClicks, csCaptureMouse]; DoubleBuffered := True; // is needed FOldFontChanged := Font.OnChange; Font.OnChange := FontChange; Height := cHeight; ParentColor := False; ParentFont := False; TabStop := True; Width := cWidth; FBackground := TKMemoBackground.Create; FBackground.OnChanged := BackgroundChanged; FBlocks := TKMemoBlocks.Create; FBlocks.MemoNotifier := Self; FBlocks.OnUpdate := BlocksChanged; FActiveBlocks := FBlocks; FCaretRect := CreateEmptyRect; FColors := TKMemoColors.Create(Self); FContentPadding := TKRect.Create; FContentPadding.All := 5; FContentPadding.OnChanged := ContentPaddingChanged; FDisabledDrawStyle := cEditDisabledDrawStyleDef; FDragMode := sgpNone; FDragRect := CreateEmptyRect; FHorzScrollStep := cHorzScrollStepDef; FInUpdateScrollRange := False; FLeftPos := 0; FLinePosition := eolInside; FListTable := TKMemoListTable.Create; FListTable.OnChanged := ListChanged; FMaxWordLength := cMaxWordLengthDef; FMouseWheelAccumulator := 0; FNewTextStyle := TKMemoTextStyle.Create; FNewTextStyleValid := False; FOldCaretRect := CreateEmptyRect; FOptions := cKMemoOptionsDef; FPreferredCaretPos := 0; FKeyMapping := TKEditKeyMapping.Create; FParaStyle := TKMemoParaStyle.Create; FParaStyle.Changeable := False; FParaStyle.OnChanged := ParaStyleChanged; FRedoList := TKMemoChangeList.Create(Self, nil); FRequiredContentWidth := 0; FRequiredMouseCursor := crIBeam; FScrollBars := ssBoth; FScrollPadding := cScrollPaddingDef; FScrollSpeed := cScrollSpeedDef; FScrollTimer := TTimer.Create(Self); FScrollTimer.Enabled := False; FScrollTimer.Interval := FScrollSpeed; FScrollTimer.OnTimer := ScrollTimerHandler; FSelectedBlock := nil; FStates := []; FTextStyle := TKMemoTextStyle.Create; FTextStyle.Changeable := False; // Lazarus: Why is Font.Size = 0 here? In Delphi it is already valid! if Font.Size <> 0 then FTextStyle.Font.Assign(Font); FTextStyle.UnlockUpdate; FTextStyle.OnChanged := TextStyleChanged; FTopPos := 0; FUndoList := TKMemoChangeList.Create(Self, FRedoList); FUndoList.OnChange := UndoChange; FVertScrollStep := cVertScrollStepDef; FWordBreaks := cDefaultWordBreaks; FOnChange := nil; FOnDropFiles := nil; FOnBlockClick := nil; FOnBlockDblClick := nil; FOnBlockEdit := nil; FOnReplaceText := nil; if csDesigning in ComponentState then Text := 'This is beta state control.'+cEOL+'You may already use it in your programs'+cEOL+'but some important functions may still be missing.'+cEOL else Text := cEOL; UpdateEditorCaret; end; destructor TKCustomMemo.Destroy; begin Clear; FOnChange := nil; FUndoList.Free; FRedoList.Free; FParaStyle.Free; FNewTextStyle.Free; FKeyMapping.Free; FTextStyle.Free; FListTable.Free; FContentPadding.Free; FColors.Free; FBlocks.Free; FBackground.Free; inherited; end; procedure TKCustomMemo.AddUndoCaretPos(Force: Boolean); begin FUndoList.AddChange(ckCaretPos, Force); end; procedure TKCustomMemo.AddUndoChar(AItemKind: TKMemoChangeKind; AData: TKChar; AInserted: Boolean = True); begin FUndoList.AddChange(AItemKind, AInserted); end; procedure TKCustomMemo.AddUndoString(AItemKind: TKMemoChangeKind; const AData: TKString; AInserted: Boolean = True); begin if AData <> '' then FUndoList.AddChange(AItemKind, AInserted); end; procedure TKCustomMemo.Assign(Source: TPersistent); begin if Source is TKCustomMemo then with Source as TKCustomMemo do begin Self.LockUpdate; try Self.Align := Align; Self.Anchors := Anchors; Self.AutoSize := AutoSize; Self.BiDiMode := BiDiMode; Self.BorderStyle := BorderStyle; Self.BorderWidth := BorderWidth; Self.Color := Color; Self.Colors := Colors; Self.Constraints.Assign(Constraints); {$IFNDEF FPC} Self.Ctl3D := Ctl3D; {$ENDIF} Self.DisabledDrawStyle := DisabledDrawStyle; Self.DragCursor := DragCursor; Self.DragKind := DragKind; Self.DragMode := DragMode; Self.Enabled := Enabled; Self.Font := Font; {$IFNDEF FPC} Self.ImeMode := ImeMode; Self.ImeName := ImeName; {$ENDIF} Self.KeyMapping.Assign(KeyMapping); Self.Modified := False; Self.Options := Options; Self.ParaStyle.Assign(ParaStyle); Self.ParentBiDiMode := ParentBiDiMode; Self.ParentColor := ParentColor; {$IFNDEF FPC} Self.ParentCtl3D := ParentCtl3D; {$ENDIF} Self.ParentFont := ParentFont; Self.ParentShowHint := ParentShowHint; Self.PopupMenu := PopupMenu; Self.ScrollBars := ScrollBars; Self.SelEnd := SelEnd; Self.SelStart := SelStart; Self.ShowHint := ShowHint; Self.TabOrder := TabOrder; Self.TabStop := TabStop; Self.TextStyle.Assign(TextStyle); Self.Visible := Visible; finally Self.UnlockUpdate; end; end else inherited; end; function TKCustomMemo.BlockAt(APos: TPoint): TKMemoBlock; var TmpPosition: TKMemoLinePosition; Index: TKMemoSelectionIndex; P: TPoint; begin SetActiveBlocksForPoint(APos); P := PointToBlockPoint(APos); Index := ActiveBlocks.PointToIndex(Canvas, P, False, False, TmpPosition); if Index >= 0 then Result := ActiveBlocks.IndexToInnerBlock(Index) else Result := ActiveBlocks.PointToRelativeBlock(P); end; function TKCustomMemo.BlockRect(ABlock: TKMemoBlock): TRect; var OldActiveBlocks: TKMemoBlocks; begin Result := CreateEmptyRect; if (ABlock <> nil) and (ABlock.WordCount > 0) then begin OldActiveBlocks := FActiveBlocks; try FActiveBlocks := FBlocks.GetParentBlocksForBlock(ABlock); if FActiveBlocks <> nil then Result := BlockRectToRect(ABlock.BoundsRect); finally FActiveBlocks := OldActiveBlocks; end; end; end; procedure TKCustomMemo.BackgroundChanged(Sender: TObject); begin Invalidate; end; procedure TKCustomMemo.BeginUndoGroup(AGroupKind: TKMemoChangeKind); begin FUndoList.BeginGroup(AGroupKind); end; function TKCustomMemo.BlockRectToRect(const ARect: TRect): TRect; begin Result := ARect; KFunctions.OffsetRect(Result, ContentLeft, ContentTop); if ActiveBlocks <> FBlocks then begin KFunctions.OffsetRect(Result, ActiveBlocks.TotalLeftOffset, ActiveBlocks.TotalTopOffset); end; end; function TKCustomMemo.BlockClick(ABlock: TKMemoBlock): Boolean; begin Result := False; if Assigned(FOnBlockClick) then FOnBlockClick(Self, Ablock, Result); end; function TKCustomMemo.BlockDblClick(ABlock: TKMemoBlock): Boolean; begin Result := False; if Assigned(FOnBlockDblClick) then FOnBlockDblClick(Self, Ablock, Result); end; procedure TKCustomMemo.BlockFreeNotification(ABlock: TKMemoBlock); begin if ABlock = FSelectedBlock then begin CancelDrag; FSelectedBlock := nil; end; end; procedure TKCustomMemo.BlocksFreeNotification(ABlocks: TKMemoBlocks); begin if ABlocks = ActiveBlocks then ActiveBlocks := FBlocks; end; procedure TKCustomMemo.BlocksChanged(Reasons: TKMemoUpdateReasons); begin if HandleAllocated and UpdateUnlocked then begin if Reasons * [muContent, muContentAddOnly, muExtent] <> [] then UpdateScrollRange(True) else if muSelectionScroll in Reasons then begin if not ClampInView(nil, False) then begin UpdateEditorCaret; Invalidate; end; end else begin UpdateEditorCaret; Invalidate; end; if muContent in Reasons then DoChange; end; end; procedure TKCustomMemo.CancelDrag; begin if FStates * [elMouseDrag, elMouseDragInit] <> [] then begin FStates := FStates - [elMouseDrag, elMouseDragInit]; Invalidate; end; end; function TKCustomMemo.CanScroll(ACommand: TKEditCommand): Boolean; var R: TRect; begin case ACommand of ecScrollUp: Result := FTopPos > 0; ecScrollDown: Result := FTopPos < FVertScrollExtent - 1; ecScrollLeft: Result := FLeftPos > 0; ecScrollRight: Result := FLeftPos < FHorzScrollExtent - 1; ecScrollCenter: begin R := IndexToRect(SelEnd, True); R.Left := R.Left - ClientWidth div 2; R.Top := R.Top - ClientHeight div 2; Result := (FLeftPos > 0) and (R.Left < 0) or (FLeftPos < FHorzScrollExtent - 1) and (R.Left > 0) or (FTopPos > 0) and (R.Top < 0) or (FTopPos < FVertScrollExtent - 1) and (R.Top > 0); end; else Result := False; end; end; function TKCustomMemo.CaretInView: Boolean; begin Result := PtInRect(ClientRect, FCaretRect.TopLeft); end; function TKCustomMemo.ClampInView(AMousePos: PPoint; ACallScrollWindow: Boolean): Boolean; var DeltaHorz, DeltaVert: Integer; begin UpdateEditorCaret(False); Result := ScrollNeeded(AMousePos, DeltaHorz, DeltaVert); if Result then begin Result := Scroll(cScrollDelta, cScrollDelta, DeltaHorz, DeltaVert, ACallScrollWindow); if Result then FScrollTimer.Enabled := True; end; end; procedure TKCustomMemo.Clear(AKeepOnePara: Boolean); begin FBlocks.LockUpdate; try FBlocks.Clear; if AKeepOnePara then FBlocks.FixEmptyBlocks; FTextStyle.Defaults; if Font.Size <> 0 then FTextStyle.Font.Assign(Font); FParaStyle.Defaults; FColors.BkGnd := cBkGndDef; FBackground.Clear; FListTable.Clear; finally FBlocks.UnlockUpdate; end; end; procedure TKCustomMemo.ClearSelection(ATextOnly: Boolean); var Len: TKMemoSelectionIndex; begin Len := ActiveBlocks.SelLength; ActiveBlocks.ClearSelection(ATextOnly); if Len <> 0 then Modified := True; end; procedure TKCustomMemo.ClearUndo; begin FUndoList.Clear; FRedoList.Clear; end; procedure TKCustomMemo.CMEnabledChanged(var Msg: TLMessage); begin inherited; UpdateEditorCaret; Invalidate; end; procedure TKCustomMemo.CMSysColorChange(var Msg: TLMessage); begin inherited; FColors.ClearBrightColors; end; function TKCustomMemo.CommandEnabled(Command: TKEditCommand): Boolean; var TmpSelEnd, TmpSelLength: TKMemoSelectionIndex; TmpLinePos: TKMemoLinePosition; begin if Enabled and Visible and not (csDesigning in ComponentState) then begin TmpSelEnd := SelEnd; TmpSelLength := RealSelLength; case Command of // movement commands ecLeft, ecSelLeft, ecWordLeft, ecSelWordLeft: Result := TmpSelEnd > 0; ecRight, ecSelRight, ecWordRight, ecSelWordRight: Result := TmpSelEnd < ActiveBlocks.SelectableLength; ecUp, ecSelUp, ecPageUp, ecSelPageUp: Result := ActiveBlocks.IndexBelowFirstLine(TmpSelEnd, True); ecDown, ecPagedown, ecSelDown, ecSelPageDown: Result := ActiveBlocks.IndexAboveLastLine(TmpSelEnd, True); ecLineStart, ecPageLeft, ecSelLineStart, ecSelPageLeft: Result := TmpSelEnd > ActiveBlocks.LineStartIndexByIndex(TmpSelEnd, True, TmpLinePos); ecLineEnd, ecPageRight: Result := TmpSelEnd < ActiveBlocks.LineEndIndexByIndex(TmpSelEnd, True, False, TmpLinePos); ecSelLineEnd, ecSelPageRight: Result := TmpSelEnd < ActiveBlocks.LineEndIndexByIndex(TmpSelEnd, True, True, TmpLinePos); ecPageTop, ecSelPageTop: Result := TmpSelEnd <> ActiveBlocks.NextIndexByVertValue(Canvas, -ContentTop + VertScrollPadding, FPreferredCaretPos, False, TmpLinePos); ecPageBottom, ecSelPageBottom: Result := TmpSelEnd <> ActiveBlocks.NextIndexByVertValue(Canvas, -ContentTop + VertScrollPadding + ClientHeight, FPreferredCaretPos, True, TmpLinePos); ecEditorTop, ecSelEditorTop: Result := TmpSelEnd > 0; ecEditorBottom, ecSelEditorBottom: Result := TmpSelEnd < ActiveBlocks.SelectableLength; ecGotoXY, ecSelGotoXY: Result := True; // scroll commands ecScrollUp, ecScrollDown, ecScrollLeft, ecScrollRight, ecScrollCenter: Result := CanScroll(Command); // editing commands ecUndo: Result := not ReadOnly and FUndoList.CanPeek; ecRedo: Result := not ReadOnly and FRedoList.CanPeek; ecCopy, ecCut: Result := not Empty and (not ReadOnly or (Command = ecCopy)) and ((TmpSelLength > 0) or RelativeSelected); ecPaste: Result := not ReadOnly and (ClipBoard.FormatCount > 0); ecInsertChar, ecInsertString, ecInsertNewLine: Result := not (ReadOnly or RelativeSelected); ecDeleteLastChar: Result := not (Empty or ReadOnly) and ((TmpSelLength > 0) or (TmpSelEnd > 0)); ecDeleteChar: Result := not (Empty or ReadOnly) and ((TmpSelLength > 0) or (TmpSelEnd < ActiveBlocks.SelectableLength - 1)); ecDeleteBOL: Result := not (Empty or ReadOnly or RelativeSelected) and ((TmpSelLength > 0) or (TmpSelEnd <> ActiveBlocks.LineStartIndexByIndex(TmpSelEnd, True, TmpLinePos))); ecDeleteEOL: Result := not (Empty or ReadOnly or RelativeSelected) and ((TmpSelLength > 0) or (TmpSelEnd <> ActiveBlocks.LineEndIndexByIndex(TmpSelEnd, True, True, TmpLinePos))); ecDeleteLine, ecClearAll, ecReplace: Result := not (Empty or ReadOnly or RelativeSelected); ecClearSelection: Result := not (Empty or ReadOnly or RelativeSelected) and (TmpSelLength > 0); ecSearch: Result := not Empty; ecSelectAll: Result := not Empty and (SelLength < SelectableLength); ecInsertMode: Result := elOverwrite in FStates; ecOverwriteMode: Result := not (elOverwrite in FStates); ecToggleMode: Result := not ReadOnly; ecGotFocus, ecLostFocus: Result := True; else Result := False; end; end else Result := False; end; procedure TKCustomMemo.ContentPaddingChanged(Sender: TObject); begin BlocksChanged([muExtent]); end; procedure TKCustomMemo.CreateHandle; begin inherited; UpdateScrollRange(True); end; procedure TKCustomMemo.CreateParams(var Params: TCreateParams); begin inherited; with Params do begin if FScrollBars in [ssVertical, ssBoth] then Style := Style or WS_VSCROLL; if FScrollBars in [ssHorizontal, ssBoth] then Style := Style or WS_HSCROLL; end; end; procedure TKCustomMemo.CreateWnd; begin inherited; {$IFDEF MSWINDOWS} if (eoDropFiles in FOptions) and not (csDesigning in ComponentState) then DragAcceptFiles(Handle, TRUE); {$ENDIF} end; procedure TKCustomMemo.DeleteBOL(At: TKMemoSelectionIndex); begin ActiveBlocks.DeleteBOL(At); Modified := True; end; procedure TKCustomMemo.DeleteChar(At: TKMemoSelectionIndex); begin if RelativeSelected then DeleteSelectedBlock else ActiveBlocks.DeleteChar(At); Modified := True; end; procedure TKCustomMemo.DeleteEOL(At: TKMemoSelectionIndex); begin ActiveBlocks.DeleteEOL(At); Modified := True; end; procedure TKCustomMemo.DeleteLastChar(At: TKMemoSelectionIndex); begin if RelativeSelected then DeleteSelectedBlock else ActiveBlocks.DeleteLastChar(At); Modified := True; end; procedure TKCustomMemo.DeleteLine(At: TKMemoSelectionIndex); begin ActiveBlocks.DeleteLine(At); Modified := True; end; procedure TKCustomMemo.DeleteSelectedBlock; var Blocks: TKMemoBlocks; begin if FSelectedBlock <> nil then begin Blocks := FSelectedBlock.ParentBlocks; if Blocks <> nil then begin Blocks.Remove(FSelectedBlock); FSelectedBlock := nil; end; end; end; procedure TKCustomMemo.DestroyWnd; begin {$IFDEF MSWINDOWS} if (eoDropFiles in FOptions) and not (csDesigning in ComponentState) then DragAcceptFiles(Handle, FALSE); {$ENDIF} inherited; end; procedure TKCustomMemo.DoChange; begin if Assigned(FOnChange) then FOnChange(Self); end; function TKCustomMemo.DoCopy: Boolean; var Stream: TMemoryStream; S: TKString; TmpItems: TKMemoBlocks; TmpSelect: Boolean; begin // temporary select entire FSelectedBlock (floating TKMemoContainer) TmpItems := ActiveBlocks; TmpSelect := (FSelectedBlock <> nil) and (FSelectedBlock.SelLength = 0); if TmpSelect then begin FSelectedBlock.Select(0, FSelectedBlock.SelectableLength(True), False); FActiveBlocks := FBlocks; end; // copy selected blocks as plain text and RTF to clipboard S := ActiveBlocks.SelText; Stream := TMemoryStream.Create; try SaveToRTFStream(Stream, True); //Stream.SaveToFile('copied.rtf'); //debug line Result := ClipBoardSaveStreamAs(cRichText, Stream, S); finally Stream.Free; // clear selection if TmpSelect then begin FSelectedBlock.Select(-1, 0, False); FActiveBlocks := TmpItems; end; end; end; function TKCustomMemo.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; const WHEEL_DIVISOR = 120; var AmountToScroll, WheelClicks: Integer; begin Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos); if not Result then begin if ssCtrl in Shift then AmountToScroll := ClientHeight else AmountToScroll := 3 * FVertScrollStep; Inc(FMouseWheelAccumulator, WheelDelta); WheelClicks := FMouseWheelAccumulator div WHEEL_DIVISOR; FMouseWheelAccumulator := FMouseWheelAccumulator mod WHEEL_DIVISOR; ScrollBy(0, - WheelClicks * AmountToScroll, eoScrollWindow in FOptions); Result := True; end; end; function TKCustomMemo.DoPaste: Boolean; var Stream: TMemoryStream; S: TKString; Picture: TPicture; OldSelectableLength, NewSelectableLength: TKMemoSelectionIndex; BlocksToInsert: TKMemoBlocks; BlockIndex: TKMemoBlockIndex; {$IFDEF USE_PNG_SUPPORT} Png: TKPngImage; {$ENDIF} begin // load blocks from clipboard either as RTF or plain text Stream := TMemoryStream.Create; try Result := ClipBoardLoadStreamAs(cRichText, Stream, S); if Result then begin ExecuteCommand(ecClearSelection); OldSelectableLength := ActiveBlocks.SelectableLength; if Stream.Size > 0 then begin Stream.Seek(0, soFromBeginning); //Stream.SaveToFile('pasted.rtf'); //debug line LoadFromRTFStream(Stream, SelEnd); end else ActiveBlocks.InsertPlainText(SelEnd, S); NewSelectableLength := ActiveBlocks.SelectableLength; if NewSelectableLength > OldSelectableLength then Select(SelEnd + NewSelectableLength - OldSelectableLength, 0); Modified := True; end else begin // try image formats Result := ClipBoard.HasFormat(CF_PICTURE); if Result then begin try Picture := TPicture.Create; try LoadPictureFromClipboard(Picture, CF_BITMAP); {$IFDEF USE_PNG_SUPPORT} // Try to convert unsupported image formats to PNG if not ((Picture.Graphic is TKPngImage) or (Picture.Graphic is TKJPegImage){$IFnDEF FPC} or (Picture.Graphic is TMetafile){$ENDIF}) then begin Png := TKPngImage.Create; try Png.Assign(Picture.Graphic); Picture.Assign(Png); finally Png.Free; end; end; {$ENDIF} BlocksToInsert := ActiveBlocks.SplitForInsert(SelEnd, BlockIndex); if BlocksToInsert <> nil then BlocksToInsert.AddImageBlock(Picture, BlockIndex); finally Picture.Free; end; except // do nothing end; end; end; finally Stream.Free; end; end; function TKCustomMemo.DoRedo: Boolean; begin //TODO Result := False; end; function TKCustomMemo.DoSearchReplace(AReplace: Boolean): Boolean; begin // TODO Result := False; end; function TKCustomMemo.DoUndo: Boolean; begin //TODO Result := False; end; procedure TKCustomMemo.DragBlock; var P: TPoint; DX, DY: Integer; begin if FStates * [elMouseDrag, elMouseDragInit] <> [] then begin P := ScreenToClient(Mouse.CursorPos); DX := P.X - FDragCurPos.X; DY := P.Y - FDragCurPos.Y; if (elMouseDrag in FStates) or (elMouseDragInit in FStates) and ((Abs(DX) > cMouseDragThreshold) or (Abs(DY) > cMouseDragThreshold)) then begin FStates := FStates - [elMouseDragInit] + [elMouseDrag]; TKSizingGrips.ClsAffectRect(FDragMode, DX, DY, FDragRect); FDragCurPos := P; Invalidate; end; end; end; function TKCustomMemo.EditBlock(ABlock: TKMemoBlock): Boolean; begin Result := False; if Assigned(FOnBlockEdit) and not ReadOnly then FOnBlockEdit(Self, ABlock, Result); end; {$IFNDEF FPC} procedure TKCustomMemo.EMGetSel(var Msg: TLMessage); begin PInteger(Msg.WParam)^ := SelStart; PInteger(Msg.LParam)^ := SelEnd; Msg.Result := 1; end; procedure TKCustomMemo.EMSetSel(var Msg: TLMessage); begin Select(Msg.WParam, Msg.LParam); Msg.Result := 1; end; {$ENDIF} procedure TKCustomMemo.EndUndoGroup; begin FUndoList.EndGroup; end; function TKCustomMemo.ExecuteCommand(Command: TKEditCommand; Data: Pointer): Boolean; var TmpSelEnd, NewSelEnd: TKMemoSelectionIndex; TmpPosition: TKMemoLinePosition; AStart, AEnd: TKMemoSelectionIndex; begin Result := False; if CommandEnabled(Command) then begin Result := True; TmpSelEnd := SelEnd; TmpPosition := FLinePosition; case Command of // selection commands ecLeft: begin NewSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, -1); SelectionInit(NewSelEnd, True, eolInside); end; ecWordLeft: begin if ActiveBlocks.GetNearestWordIndexes(TmpSelEnd, true, true, AStart, AEnd) then begin if TmpSelEnd <> AStart then NewSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, -(TmpSelEnd-AStart)) else begin TmpSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, -2); ActiveBlocks.GetNearestWordIndexes(TmpSelEnd, false, true, AStart, AEnd); NewSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, -(TmpSelEnd-AStart)); end; SelectionInit(NewSelEnd, True, eolInside); end; end; ecSelLeft: begin NewSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, -1); SelectionExpand(NewSelEnd, True, eolInside); end; ecSelWordLeft: begin if ActiveBlocks.GetNearestWordIndexes(TmpSelEnd, true, true, AStart, AEnd) then begin if TmpSelEnd <> AStart then NewSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, -(TmpSelEnd-AStart)) else begin TmpSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, -2); ActiveBlocks.GetNearestWordIndexes(TmpSelEnd, false, true, AStart, AEnd); NewSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, -(TmpSelEnd-AStart)); end; SelectionExpand(NewSelEnd, True, eolInside); end; end; ecRight: begin NewSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, 1); SelectionInit(NewSelEnd, True, TmpPosition); end; ecWordRight: begin if ActiveBlocks.GetNearestWordIndexes(TmpSelEnd, true, true, AStart, AEnd) then begin if TmpSelEnd <> AEnd then NewSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, (AEnd-TmpSelEnd)) else begin TmpSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, 2); ActiveBlocks.GetNearestWordIndexes(TmpSelEnd, false, true, AStart, AEnd); NewSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, (AEnd-TmpSelEnd)); end; SelectionInit(NewSelEnd, True, eolInside); end; end; ecSelRight: begin NewSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, 1); SelectionExpand(NewSelEnd, True, TmpPosition); end; ecSelWordRight: begin if ActiveBlocks.GetNearestWordIndexes(TmpSelEnd, true, true, AStart, AEnd) then begin if TmpSelEnd <> AEnd then NewSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, (AEnd-TmpSelEnd)) else begin TmpSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, 2); ActiveBlocks.GetNearestWordIndexes(TmpSelEnd, false, true, AStart, AEnd); NewSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, (AEnd-TmpSelEnd)); end; SelectionExpand(NewSelEnd, True, TmpPosition); end; end; ecUp: begin NewSelEnd := ActiveBlocks.NextIndexByRowDelta(Canvas, TmpSelEnd, -1, FPreferredCaretPos, TmpPosition); SelectionInit(NewSelEnd, True, TmpPosition); end; ecSelUp: begin NewSelEnd := ActiveBlocks.NextIndexByRowDelta(Canvas, TmpSelEnd, -1, FPreferredCaretPos, TmpPosition); SelectionExpand(NewSelEnd, True, TmpPosition); end; ecDown: begin NewSelEnd := ActiveBlocks.NextIndexByRowDelta(Canvas, TmpSelEnd, 1, FPreferredCaretPos, TmpPosition); SelectionInit(NewSelEnd, True, TmpPosition); end; ecSelDown: begin NewSelEnd := ActiveBlocks.NextIndexByRowDelta(Canvas, TmpSelEnd, 1, FPreferredCaretPos, TmpPosition); SelectionExpand(NewSelEnd, True, TmpPosition); end; ecLineStart: begin NewSelEnd := ActiveBlocks.LineStartIndexByIndex(TmpSelEnd, True, TmpPosition); SelectionInit(NewSelEnd, True, TmpPosition); end; ecSelLineStart: begin NewSelEnd := ActiveBlocks.LineStartIndexByIndex(TmpSelEnd, True, TmpPosition); SelectionExpand(NewSelEnd, True, TmpPosition); end; ecLineEnd: begin NewSelEnd := ActiveBlocks.LineEndIndexByIndex(TmpSelEnd, True, False, TmpPosition); SelectionInit(NewSelEnd, True, TmpPosition); end; ecSelLineEnd: begin NewSelEnd := ActiveBlocks.LineEndIndexByIndex(TmpSelEnd, True, True, TmpPosition); SelectionExpand(NewSelEnd, True, TmpPosition); end; ecPageUp: begin NewSelEnd := ActiveBlocks.NextIndexByVertExtent(Canvas, TmpSelEnd, -ClientHeight, FPreferredCaretPos, TmpPosition); SelectionInit(NewSelEnd, True, TmpPosition); end; ecSelPageUp: begin NewSelEnd := ActiveBlocks.NextIndexByVertExtent(Canvas, TmpSelEnd, -ClientHeight, FPreferredCaretPos, TmpPosition); SelectionExpand(NewSelEnd, True, TmpPosition); end; ecPageDown: begin NewSelEnd := ActiveBlocks.NextIndexByVertExtent(Canvas, TmpSelEnd, ClientHeight, FPreferredCaretPos, TmpPosition); SelectionInit(NewSelEnd, True, TmpPosition); end; ecSelPageDown: begin NewSelEnd := ActiveBlocks.NextIndexByVertExtent(Canvas, TmpSelEnd, ClientHeight, FPreferredCaretPos, TmpPosition); SelectionExpand(NewSelEnd, True, TmpPosition); end; ecPageLeft: begin NewSelEnd := ActiveBlocks.NextIndexByHorzExtent(Canvas, TmpSelEnd, -ClientWidth, TmpPosition); SelectionInit(NewSelEnd, True, TmpPosition); end; ecSelPageLeft: begin NewSelEnd := ActiveBlocks.NextIndexByHorzExtent(Canvas, TmpSelEnd, -ClientWidth, TmpPosition); SelectionExpand(NewSelEnd, True, TmpPosition); end; ecPageRight: begin NewSelEnd := ActiveBlocks.NextIndexByHorzExtent(Canvas, TmpSelEnd, ClientWidth, TmpPosition); SelectionInit(NewSelEnd, True, TmpPosition); end; ecSelPageRight: begin NewSelEnd := ActiveBlocks.NextIndexByHorzExtent(Canvas, TmpSelEnd, ClientWidth, TmpPosition); SelectionExpand(NewSelEnd, True, TmpPosition); end; ecPageTop: begin NewSelEnd := ActiveBlocks.NextIndexByVertValue(Canvas, -ContentTop + VertScrollPadding, FPreferredCaretPos, False, TmpPosition); SelectionInit(NewSelEnd, True, TmpPosition); end; ecSelPageTop: begin NewSelEnd := ActiveBlocks.NextIndexByVertValue(Canvas, FTopPos + VertScrollPadding, FPreferredCaretPos, False, TmpPosition); SelectionExpand(NewSelEnd, True, TmpPosition); end; ecPageBottom: begin NewSelEnd := ActiveBlocks.NextIndexByVertValue(Canvas, -ContentTop + ClientHeight - VertScrollPadding, FPreferredCaretPos, True, TmpPosition); SelectionInit(NewSelEnd, True, TmpPosition); end; ecSelPageBottom: begin NewSelEnd := ActiveBlocks.NextIndexByVertValue(Canvas, FTopPos + ClientHeight - VertScrollPadding, FPreferredCaretPos, True, TmpPosition); SelectionExpand(NewSelEnd, True, TmpPosition); end; ecEditorTop: SelectionInit(0, True, eolInside); ecSelEditorTop: SelectionExpand(0, True, eolInside); ecEditorBottom: SelectionInit(ActiveBlocks.SelectableLength, True, eolEnd); ecSelEditorBottom: SelectionExpand(ActiveBlocks.SelectableLength, True, eolEnd); ecGotoXY: begin NewSelEnd := PointToIndex(PPoint(Data)^, True, False, TmpPosition); SelectionInit(NewSelEnd, True, TmpPosition); end; ecSelGotoXY: begin NewSelEnd := PointToIndex(PPoint(Data)^, True, True, TmpPosition); SelectionExpand(NewSelEnd, True, TmpPosition); end; // scroll commands ecScrollUp: begin ScrollBy(0, -1, eoScrollWindow in FOptions); while CommandEnabled(ecUp) and (FCaretRect.Top + FCaretRect.Bottom > ClientHeight - VertScrollPadding) do ExecuteCommand(ecUp); end; ecScrollDown: begin ScrollBy(0, 1, eoScrollWindow in FOptions); while CommandEnabled(ecDown) and (FCaretRect.Top < VertScrollPadding) do ExecuteCommand(ecDown); end; ecScrollLeft: begin ScrollBy(-1, 0, eoScrollWindow in FOptions); while CommandEnabled(ecLeft) and (FCaretRect.Left + FCaretRect.Right > ClientWidth - HorzScrollPadding) do ExecuteCommand(ecLeft); end; ecScrollRight: begin ScrollBy(1, 0, eoScrollWindow in FOptions); while CommandEnabled(ecRight) and (FCaretRect.Left < HorzScrollPadding) do ExecuteCommand(ecRight); end; ecScrollCenter: ScrollToClientAreaCenter; // editing commands ecUndo: Result := DoUndo; ecRedo: Result := DoRedo; ecCopy: Result := DoCopy; ecCut: begin if DoCopy then ClearSelection; end; ecPaste: DoPaste; ecInsertChar: InsertChar(TmpSelEnd, PKChar(Data)^); ecInsertString: InsertString(TmpSelEnd, TKString(Data)); ecInsertNewLine: InsertNewLine(TmpSelEnd); ecDeleteLastChar: DeleteLastChar(TmpSelEnd); ecDeleteChar: DeleteChar(TmpSelEnd); ecDeleteBOL: DeleteBOL(TmpSelEnd); ecDeleteEOL: DeleteEOL(TmpSelEnd); ecDeleteLine: DeleteLine(TmpSelEnd); ecSelectAll: Select(0, ActiveBlocks.SelectableLength); ecClearAll: begin Select(0, ActiveBlocks.SelectableLength); ClearSelection; end; ecClearSelection: ClearSelection; ecSearch, ecReplace: Result := DoSearchReplace(Command = ecReplace); ecInsertMode: begin Exclude(FStates, elOverwrite); UpdateEditorCaret; end; ecOverwriteMode: begin Include(FStates, elOverwrite); UpdateEditorCaret; end; ecToggleMode: begin if elOverwrite in FStates then Exclude(FStates, elOverwrite) else Include(FStates, elOverwrite); UpdateEditorCaret; end; // focus change ecGotFocus: begin UpdateEditorCaret; Invalidate; end; ecLostFocus: begin UpdateEditorCaret; Invalidate; end; end; case Command of ecLeft, ecRight, ecLineStart, ecLineEnd, ecPageLeft, ecPageRight, ecGotoXY, ecSelLeft, ecSelRight, ecSelLineStart, ecSelLineEnd, ecSelPageLeft, ecSelPageRight, ecSelGotoXY, ecEditorTop, ecSelEditorTop, ecEditorBottom, ecSelEditorBottom, ecInsertChar, ecInsertString, ecInsertNewLine, ecDeleteLastChar, ecDeleteChar, ecDeleteBOL, ecDeleteEOL, ecDeleteLine, ecSelectAll, ecClearAll, ecClearSelection: UpdatePreferredCaretPos; end; end; end; procedure TKCustomMemo.FontChange(Sender: TObject); begin if Assigned(FOldFontChanged) then FOldFontChanged(Sender); if Font.Size <> 0 then FTextStyle.Font.Assign(Font); end; function TKCustomMemo.GetActiveBlock: TKMemoBlock; var DummyLocalIndex, Index: TKMemoSelectionIndex; begin Index := ActiveBlocks.SelEnd; if SelAvail and (ActiveBlocks.SelEnd > ActiveBlocks.SelStart) then Dec(Index); Result := ActiveBlocks.IndexToBlock(Index, DummyLocalIndex); end; function TKCustomMemo.GetActiveBlocks: TKMemoBlocks; begin Result := ActiveBlocks; end; function TKCustomMemo.GetActiveInnerBlock: TKMemoBlock; var Index, LocalIndex: TKMemoSelectionIndex; Items: TKmemoBlocks; begin Index := ActiveBlocks.SelEnd; if SelAvail and (ActiveBlocks.SelEnd > ActiveBlocks.SelStart) then Dec(Index); Items := ActiveBlocks.IndexToBlocks(Index, LocalIndex); if Items <> nil then Result := Items.IndexToBlock(LocalIndex, LocalIndex) else Result := nil; end; function TKCustomMemo.GetActiveInnerBlocks: TKMemoBlocks; var DummyLocalIndex: TKMemoSelectionIndex; begin Result := ActiveBlocks.IndexToBlocks(ActiveBlocks.RealSelEnd, DummyLocalIndex); end; function TKCustomMemo.GetCaretRect: TRect; begin Result := FCaretRect; end; function TKCustomMemo.GetCaretVisible: Boolean; begin Result := elCaretVisible in FStates; end; function TKCustomMemo.GetContentHeight: Integer; begin Result := FVertExtent; end; function TKCustomMemo.GetContentLeft: Integer; begin Result := -FLeftPos + FContentPadding.Left; end; function TKCustomMemo.GetContentRect: TRect; begin Result.Left := ContentLeft; Result.Top := ContentTop; Result.Right := Result.Left + ContentWidth; Result.Bottom := Result.Top + ContentHeight; end; function TKCustomMemo.GetContentTop: Integer; begin Result := -FTopPos + FContentPadding.Top; end; function TKCustomMemo.GetContentWidth: Integer; begin Result := FHorzExtent; end; function TKCustomMemo.GetDefaultTextStyle: TKMemoTextStyle; begin Result := FTextStyle; end; function TKCustomMemo.GetDrawSingleChars: Boolean; begin Result := (eoDrawSingleChars in FOptions) or (elPrinting in FStates); end; function TKCustomMemo.GetDefaultParaStyle: TKMemoParaStyle; begin Result := FParaStyle; end; function TKCustomMemo.GetEmpty: Boolean; begin Result := FBlocks.Empty; end; function TKCustomMemo.GetHorzScrollPadding: Integer; begin Result := Min(FScrollPadding, ClientWidth div 8); end; function TKCustomMemo.GetInsertMode: Boolean; begin Result := not (elOverwrite in FStates); end; function TKCustomMemo.GetLinePosition: TKMemoLinePosition; begin Result := FLinePosition; end; function TKCustomMemo.GetListTable: TKMemoListTable; begin Result := FListTable; end; function TKCustomMemo.GetModified: Boolean; begin Result := (elModified in FStates) or FUndoList.Modified; end; function TKCustomMemo.GetNearestParagraph: TKMemoParagraph; begin Result := ActiveBlocks.BlockIndexToBlock(GetNearestParagraphIndex) as TKMemoParagraph; end; function TKCustomMemo.GetNearestParagraphIndex: TKMemoBlockIndex; var BlockIndex: TKMemoBlockIndex; LocalIndex: TKMemoSelectionIndex; begin BlockIndex := ActiveBlocks.IndexToBlockIndex(RealSelEnd, LocalIndex); if BlockIndex >= 0 then Result := ActiveBlocks.GetNearestParagraphBlockIndex(BlockIndex) else Result := -1; end; function TKCustomMemo.GetNearestWordIndexes(AIndex: TKMemoSelectionIndex; AIncludeWhiteSpaces: Boolean; out AStartIndex, AEndIndex: TKMemoSelectionIndex): Boolean; begin Result := ActiveBlocks.GetNearestWordIndexes(AIndex, True, AIncludeWhiteSpaces, AStartIndex, AEndIndex); end; function TKCustomMemo.GetPaintSelection: Boolean; begin if elPrinting in FStates then Result := poPaintSelection in PageSetup.Options else Result := True; end; function TKCustomMemo.GetPixelsPerInchX: Integer; begin if HandleAllocated then Result := PixelsPerInchX(Handle) else Result := PixelsPerInchX(0) end; function TKCustomMemo.GetPixelsPerInchY: Integer; begin if HandleAllocated then Result := PixelsPerInchY(Handle) else Result := PixelsPerInchY(0) end; function TKCustomMemo.GetPrinting: Boolean; begin Result := elPrinting in FStates; end; function TKCustomMemo.GetMaxLeftPos: Integer; begin Result := FHorzExtent - ClientWidth; end; function TKCustomMemo.GetMaxTopPos: Integer; begin Result := FVertExtent - ClientHeight; end; function TKCustomMemo.GetMaxWordLength: TKMemoSelectionIndex; begin Result := FMaxWordLength; end; function TKCustomMemo.GetMemo: TKCustomMemo; begin Result := Self; end; function TKCustomMemo.GetReadOnly: Boolean; begin Result := elReadOnly in FStates; end; function TKCustomMemo.GetRealSelEnd: TKMemoSelectionIndex; begin Result := ActiveBlocks.RealSelEnd; end; function TKCustomMemo.GetRealSelLength: TKMemoSelectionIndex; begin Result := RealSelEnd - RealSelStart; end; function TKCustomMemo.GetRealSelStart: TKMemoSelectionIndex; begin Result := ActiveBlocks.RealSelStart; end; function TKCustomMemo.GetRelativeSelected: Boolean; begin Result := (FSelectedBlock <> nil) and (FSelectedBlock.Position <> mbpText); end; function TKCustomMemo.GetRequiredContentWidth: Integer; begin if FRequiredContentWidth > 0 then Result := FRequiredContentWidth else Result := ClientWidth - FContentPadding.Left - FContentPadding.Right; end; function TKCustomMemo.GetRTF: TKMemoRTFString; var Stream: TStringStream; begin Stream := TStringStream.Create{$IFnDEF COMPILER12_UP}(''){$ENDIF}; try ActiveBlocks := FBlocks; SaveToRTFStream(Stream, False); Result := Stream.DataString; finally Stream.Free; end; end; function TKCustomMemo.GetSelAvail: Boolean; begin Result := SelLength <> 0; end; procedure TKCustomMemo.GetSelColors(out Foreground, Background: TColor); begin if Focused then begin Foreground := FColors.SelTextFocused; Background := FColors.SelBkGndFocused; end else begin Foreground := FColors.SelText; Background := FColors.SelBkGnd; end; end; function TKCustomMemo.GetSelectableLength: TKMemoSelectionIndex; begin Result := ActiveBlocks.SelectableLength; end; function TKCustomMemo.GetSelectedBlock: TKMemoBlock; begin Result := FSelectedBlock; end; function TKCustomMemo.GetSelectionHasPara: Boolean; begin Result := ActiveBlocks.SelectionHasPara; end; function TKCustomMemo.GetSelectionParaStyle: TKMemoParaStyle; begin Result := ActiveBlocks.SelectionParaStyle; if Result = nil then Result := FParaStyle; end; function TKCustomMemo.GetSelectionTextStyle: TKMemoTextStyle; begin Result := ActiveBlocks.SelectionTextStyle; if Result = nil then Result := FTextStyle; end; function TKCustomMemo.GetSelEnd: TKMemoSelectionIndex; begin Result := ActiveBlocks.SelEnd; end; function TKCustomMemo.GetSelLength: TKMemoSelectionIndex; begin Result := ActiveBlocks.SelLength; end; function TKCustomMemo.GetSelStart: TKMemoSelectionIndex; begin Result := ActiveBlocks.SelStart end; function TKCustomMemo.GetSelText: TKString; begin Result := ActiveBlocks.SelText; end; function TKCustomMemo.GetShowFormatting: Boolean; begin if elPrinting in States then Result := False else Result := eoShowFormatting in FOptions; end; function TKCustomMemo.GetText: TKString; begin Result := ActiveBlocks.Text; end; function TKCustomMemo.GetUndoLimit: Integer; begin Result := FUndoList.Limit; end; function TKCustomMemo.GetVertScrollPadding: Integer; begin Result := Min(FScrollPadding, ClientHeight div 8); end; function TKCustomMemo.GetVisible: Boolean; begin Result := inherited Visible; end; function TKCustomMemo.GetWordBreaks: TKSysCharSet; begin Result := FWordBreaks; end; function TKCustomMemo.GetWrapSingleChars: Boolean; begin Result := eoWrapSingleChars in FOptions; end; function TKCustomMemo.HasFocus: Boolean; begin Result := Focused; end; procedure TKCustomMemo.HideEditorCaret; begin if HandleAllocated then HideCaret(Handle); end; function TKCustomMemo.IndexToRect(AValue: TKMemoSelectionIndex; ACaret: Boolean): TRect; begin Result := BlockRectToRect(ActiveBlocks.IndexToRect(Canvas, AValue, ACaret, ActiveBlocks.EOLToNormal(AValue))); end; procedure TKCustomMemo.InsertChar(At: TKMemoSelectionIndex; const AValue: TKChar); var Style: TKMemoTextStyle; begin if FNewTextStyleValid then begin Style := FNewTextStyle; FNewTextStyleValid := False; end else Style := nil; ActiveBlocks.InsertChar(At, AValue, elOverwrite in FStates, Style); Modified := True; end; procedure TKCustomMemo.InsertNewLine(At: TKMemoSelectionIndex); begin ActiveBlocks.InsertNewLine(At); Modified := True; end; procedure TKCustomMemo.InsertString(At: TKMemoSelectionIndex; const AValue: TKString); begin if AValue <> '' then begin BeginUndoGroup(ckInsert); try if ActiveBlocks.SelLength > 0 then begin ActiveBlocks.ClearSelection; At := ActiveBlocks.SelEnd; end; // always insert (don't overwrite) ActiveBlocks.InsertString(At, True, AValue); finally EndUndoGroup; end; Modified := True; end end; function TKCustomMemo.IsOptionsStored: Boolean; begin Result := FOptions <> cKMemoOptionsDef; end; procedure TKCustomMemo.KeyDown(var Key: Word; Shift: TShiftState); var Cmd: TKEditCommand; begin inherited; Exclude(FStates, elIgnoreNextChar); if not (csDesigning in ComponentState) then begin Cmd := FKeyMapping.FindCommand(Key, Shift); if Cmd <> ecNone then begin ExecuteCommand(Cmd); Key := 0; Include(FStates, elIgnoreNextChar); end; case Key of VK_ESCAPE: begin Include(FStates, elIgnoreNextChar); CancelDrag; end; VK_SHIFT, VK_CONTROL, VK_MENU: begin UpdateMouseCursor; end; end; end; end; {$IFDEF FPC} procedure TKCustomMemo.UTF8KeyPress(var Key: TUTF8Char); {$ELSE} procedure TKCustomMemo.KeyPress(var Key: Char); {$ENDIF} var C: TKCHar; begin inherited; if not (csDesigning in ComponentState) then begin if not (elIgnoreNextChar in FStates) then begin {$IF DEFINED(FPC) OR DEFINED(COMPILER12_UP)} C := Key; {$ELSE} C := AnsiStringToString(Key)[1]; {$IFEND} ExecuteCommand(ecInsertChar, @C); end else Exclude(FStates, elIgnoreNextChar); end; end; procedure TKCustomMemo.KeyUp(var Key: Word; Shift: TShiftState); begin inherited; if not (csDesigning in ComponentState) then begin case Key of VK_SHIFT, VK_CONTROL, VK_MENU: UpdateMouseCursor; end; end; end; procedure TKCustomMemo.LateUpdate(var Msg: TLMessage); begin inherited; case Msg.Msg of KM_SCROLL: UpdateScrollRange(True); end; end; procedure TKCustomMemo.ListChanged(AList: TKMemoList; ALevel: TKMemoListLevel); begin FBlocks.ListChanged(AList, ALevel); if FBlocks.UpdateUnlocked then Modified := True; end; procedure TKCustomMemo.LoadFromFile(const AFileName: TKString); var Ext: TKString; begin Ext := LowerCase(ExtractFileExt(AFileName)); if Ext = '.rtf' then LoadFromRTF(AFileName) else LoadFromTXT(AFileName); end; procedure TKCustomMemo.LoadFromRTF(const AFileName: TKString); var Reader: TKMemoRTFReader; begin Reader := TKMemoRTFReader.Create(Self); try Clear(False); Reader.LoadFromFile(AFileName, Blocks, -1); finally Reader.Free; end; end; procedure TKCustomMemo.LoadFromRTFStream(AStream: TStream; AtIndex: TKMemoSelectionIndex); var Reader: TKMemoRTFReader; begin Reader := TKMemoRTFReader.Create(Self); try Reader.LoadFromStream(AStream, ActiveBlocks, AtIndex); finally Reader.Free; end; end; procedure TKCustomMemo.LoadFromTXT(const AFileName: TKString); var List: TStringList; begin if FileExists(AFileName) then begin Clear(False); List := TStringList.Create; try List.LoadFromFile(AFileName); Text := List.Text; finally List.Free; end; end; end; procedure TKCustomMemo.LoadFromTXTStream(AStream: TStream); var List: TStringList; begin Clear(False); List := TStringList.Create; try List.LoadFromStream(AStream); Text := List.Text; finally List.Free; end; end; procedure TKCustomMemo.MeasurePages(var Info: TKPrintMeasureInfo); var FitToPage: Boolean; Scale: Double; PageHeight, PageCount: Integer; APageSetup: TKPrintPageSetup; begin APageSetup := PageSetup; FitToPage := poFitToPage in APageSetup.Options; Scale := APageSetup.Scale / 100; Info.ControlHorzPageCount := 1; // no horizontal page splitting yet, cut it if ContentWidth > 0 then begin if FitToPage then Scale := APageSetup.MappedControlPaintAreaWidth / ContentWidth; PageHeight := Round(APageSetup.MappedPaintAreaHeight / Scale); PrepareToPrint(Scale); PageCount := FBlocks.GetPageCount(PageHeight); Info.OutlineWidth := FBlocks.Width; Info.OutlineHeight := PageCount * PageHeight; Info.ControlVertPageCount := PageCount; end else Info.ControlVertPageCount := 1; end; procedure TKCustomMemo.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var P: TPoint; Action: TKMemoMouseAction; StartIndex, EndIndex: TKMemoSelectionIndex; begin inherited; if Enabled then begin P := Point(X, Y); case Button of mbRight: Action := maRightDown; mbMiddle: Action := maMidDown; else Action := maLeftDown; end; if not FBlocks.MouseAction(Action, Canvas, PointToBlockPoint(P, False), Shift) then begin if Button = mbLeft then begin SetActiveBlocksForPoint(P); if ssDouble in Shift then begin GetNearestWordIndexes(SelEnd, False, StartIndex, EndIndex); Select(StartIndex, EndIndex - StartIndex, False); end else begin Include(FStates, elMouseCapture); SelectionInit(P, False); end; ClampInView(nil, eoScrollWindow in FOptions); end; end; SafeSetFocus; end; end; procedure TKCustomMemo.MouseMove(Shift: TShiftState; X, Y: Integer); var P: TPoint; begin inherited; P := Point(X, Y); if FStates * [elMouseDrag, elMouseDragInit] <> [] then DragBlock else if elMouseCapture in FStates then begin if not FScrollTimer.Enabled then SelectionExpand(P, True); end else begin UpdateMouseCursor; end; end; procedure TKCustomMemo.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var Action: TKMemoMouseAction; P: TPoint; begin inherited; FStates := FStates - [elMouseCapture, elMouseDragInit]; UpdateEditorCaret; if elMouseDrag in FStates then MoveBlock else begin case Button of mbRight: Action := maRightUp; mbMiddle: Action := maMidUp; else Action := maLeftUp; end; P := Point(X, Y); FBlocks.MouseAction(Action, Canvas, PointToBlockPoint(P, False), Shift); end; UpdateMouseCursor; end; procedure TKCustomMemo.MoveBlock; begin if elMouseDrag in FStates then begin Exclude(FStates, elMouseDrag); FDragRect := NormalizeRect(FDragRect); if (FSelectedBlock <> nil) and not EqualRect(FDragRect, FDragOrigRect) then begin FSelectedBlock.LockUpdate; try FSelectedBlock.LeftOffset := FSelectedBlock.LeftOffset + FDragRect.Left - FDragOrigRect.Left; FSelectedBlock.TopOffset := FSelectedBlock.TopOffset + FDragRect.Top - FDragOrigRect.Top; FSelectedBlock.Resize(FDragRect.Right - FDragRect.Left, FDragRect.Bottom - FDragRect.Top); finally FSelectedBlock.UnlockUpdate; end; Modified := True; end; end; end; procedure TKCustomMemo.MoveCaretToMouseCursor(AIfOutsideOfSelection: Boolean); var P: TPoint; Index: TKMemoSelectionIndex; Move: Boolean; begin if Enabled then begin SafeSetFocus; P := ScreenToClient(Mouse.CursorPos); if AIfOutsideOfSelection then begin Index := PointToIndex(P, True, False, FLinePosition); Move := (Index < RealSelStart) or (Index > RealSelEnd); end else Move := True; if Move then begin SetActiveBlocksForPoint(P); SelectionInit(P, False); ClampInView(nil, eoScrollWindow in FOptions); end; end; end; procedure TKCustomMemo.PaintContent(ACanvas: TCanvas; const ARect: TRect; ALeftOfs, ATopOfs: Integer); var H, X, Y, SaveIndex: Integer; begin SaveIndex := SaveDC(ACanvas.handle); // don't delete try if (FColors.BkGnd <> clNone) or (FBackground.Color <> clNone) then begin if FBackground.Color <> clNone then Brush.Color := FBackground.Color else Brush.Color := FColors.BkGnd; Brush.Style := bsSolid; ACanvas.Brush.Assign(Brush); ACanvas.FillRect(ARect); end; if (FBackground.Image.Graphic <> nil) and not FBackground.Image.Graphic.Empty then begin X := ARect.Left + (ALeftOfs - FContentPadding.Left) mod FBackground.Image.Width; Y := ARect.Top + (ATopOfs - FContentPadding.Top) mod FBackground.Image.Height; H := X; while Y < ARect.Bottom do begin ACanvas.Draw(X, Y, FBackground.Image.Graphic); Inc(X, FBackground.Image.Width); if not FBackground.RepeatX or (X >= ARect.Right) then begin if FBackground.RepeatY then Inc(Y, FBackground.Image.Height) else Y := ARect.Bottom; X := H; end; end; end; FBlocks.PaintToCanvas(ACanvas, ALeftOfs, ATopOfs, ARect); finally RestoreDC(ACanvas.Handle, SaveIndex); end; end; procedure TKCustomMemo.PaintPage; var AreaWidth, AreaHeight, PageOffset, PageHeight: Integer; TmpRect, TmpRect1: TRect; APageSetup: TKPrintPageSetup; begin // poSelOnly not supported // poUseColor not supported - always paints in colors APageSetup := PageSetup; AreaWidth := Round(APageSetup.MappedControlPaintAreaWidth / APageSetup.CurrentScale); AreaHeight := Round(APageSetup.MappedPaintAreaHeight / APageSetup.CurrentScale); TmpRect := Rect(0, 0, APageSetup.MappedOutlineWidth, APageSetup.MappedOutlineHeight); FBlocks.GetPageData(AreaHeight, APageSetup.CurrentPageControl - 1, PageOffset, PageHeight); TmpRect1 := Rect(0, 0, AreaWidth, PageHeight); IntersectRect(TmpRect, TmpRect, TmpRect1); TmpRect1 := TmpRect; TranslateRectToDevice(APageSetup.Canvas.Handle, TmpRect1); SelectClipRect(APageSetup.Canvas.Handle, TmpRect1); PaintContent(APageSetup.Canvas, TmpRect, 0, - PageOffset); end; procedure TKCustomMemo.PaintToCanvas(ACanvas: TCanvas); begin {$IFDEF FPC} if CaretVisible then HideEditorCaret; try {$ENDIF} PrepareToPaint(ACanvas); // select valid clipping region RgnSelectAndDelete(ACanvas.Handle, CreateRectRgn(0, 0, ClientWidth, ClientHeight)); PaintContent(ACanvas, ClientRect, ContentLeft, ContentTop); if elMouseDrag in FStates then begin SetBkColor(ACanvas.Handle, $FFFFFF); SetTextColor(ACanvas.Handle, 0); ACanvas.DrawFocusRect(NormalizeRect(FDragRect)); end; {$IFDEF FPC} finally if CaretVisible then ShowEditorCaret; end; {$ENDIF} end; procedure TKCustomMemo.ParaStyleChanged(Sender: TObject; AReasons: TKMemoUpdateReasons); begin FBlocks.NotifyDefaultParaChange; end; function TKCustomMemo.PointToBlockPoint(const APoint: TPoint; ACalcActive: Boolean): TPoint; begin Result.X := APoint.X - ContentLeft; Result.Y := APoint.Y - ContentTop; if (ActiveBlocks <> FBlocks) and ACalcActive then begin OffsetPoint(Result, -ActiveBlocks.TotalLeftOffset, -ActiveBlocks.TotalTopOffset); end; end; function TKCustomMemo.PointToIndex(APoint: TPoint; AOutOfArea, ASelectionExpanding: Boolean; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; begin Result := ActiveBlocks.PointToIndex(Canvas, PointToBlockPoint(APoint), AOutOfArea, ASelectionExpanding, ALinePos); end; procedure TKCustomMemo.PrepareToPaint(ACanvas: TCanvas); begin if elPrinting in FStates then begin Exclude(FStates, elPrinting); FBlocks.NotifyPrintEnd; FBlocks.MeasureExtent(ACanvas, RequiredContentWidth); end; end; procedure TKCustomMemo.PrepareToPrint(AScale: Double); begin if not (elPrinting in FStates) then begin Include(FStates, elPrinting); FBlocks.NotifyPrintBegin; FBlocks.MeasureExtent(Canvas, Round(PageSetup.MappedControlPaintAreaWidth / AScale)); end; end; procedure TKCustomMemo.PrintPaintBegin; begin PrepareToPrint(PageSetup.CurrentScale); end; procedure TKCustomMemo.PrintPaintEnd; begin end; function TKCustomMemo.Pt2PxX(AValue: Double): Integer; begin Result := PointsToPixels(AValue, GetPixelsPerInchX); end; function TKCustomMemo.Pt2PxY(AValue: Double): Integer; begin Result := PointsToPixels(AValue, GetPixelsPerInchY); end; function TKCustomMemo.Px2PtX(AValue: Integer): Double; begin Result := PixelsToPoints(AValue, GetPixelsPerInchX); end; function TKCustomMemo.Px2PtY(AValue: Integer): Double; begin Result := PixelsToPoints(AValue, GetPixelsPerInchY); end; procedure TKCustomMemo.SafeSetFocus; begin if not Focused and CanFocus and not (csDesigning in ComponentState) then SetFocus; end; procedure TKCustomMemo.SaveToFile(const AFileName: TKString; ASelectedOnly: Boolean); var Ext: TKString; begin Ext := LowerCase(ExtractFileExt(AFileName)); if Ext = '.rtf' then SaveToRTF(AFileName) else SaveToTXT(AFileName); end; procedure TKCustomMemo.SaveToRTF(const AFileName: TKString; ASelectedOnly: Boolean; AReadableOutput: Boolean); var Writer: TKMemoRTFWriter; begin ActiveBlocks := FBlocks; Writer := TKMemoRTFWriter.Create(Self); try Writer.ReadableOutput := AReadableOutput; Writer.SaveToFile(AFileName, ASelectedOnly); finally Writer.Free; end; end; procedure TKCustomMemo.SaveToRTFStream(AStream: TStream; ASelectedOnly: Boolean; AReadableOutput: Boolean); var Writer: TKMemoRTFWriter; begin Writer := TKMemoRTFWriter.Create(Self); try Writer.ReadableOutput := AReadableOutput; Writer.SaveToStream(AStream, ASelectedOnly); finally Writer.Free; end; end; procedure TKCustomMemo.SaveToTXT(const AFileName: TKString; ASelectedOnly: Boolean); var List: TStringList; begin List := TStringList.Create; try if ASelectedOnly then List.Text := FBlocks.SelText else List.Text := FBlocks.Text; List.SaveToFile(AFileName); finally List.Free; end; end; function TKCustomMemo.Scroll(CodeHorz, CodeVert, DeltaHorz, DeltaVert: Integer; ACallScrollWindow: Boolean): Boolean; function Axis(Code: Cardinal; HasScrollBar: Boolean; ScrollCode: Cardinal; Delta, MaxScrollPos, ScrollStep: Integer; var ScrollPos: Integer): Boolean; var OldPos, Pos: Integer; SI: TScrollInfo; begin Result := False; if HasScrollBar then begin FillChar(SI, SizeOf(TScrollInfo), 0); SI.cbSize := SizeOf(TScrollInfo); SI.fMask := SIF_PAGE or SIF_RANGE or SIF_TRACKPOS; GetScrollInfo(Handle, Code, SI); {$IFDEF UNIX} SI.nTrackPos := Delta; {$ENDIF} end; Pos := ScrollPos; OldPos := Pos; case ScrollCode of SB_TOP: Pos := 0; SB_BOTTOM: Pos := SI.nMax; SB_LINEUP: Dec(Pos, ScrollStep); SB_LINEDOWN: Inc(Pos, ScrollStep); SB_PAGEUP: Dec(Pos, SI.nPage); SB_PAGEDOWN: Inc(Pos, SI.nPage); SB_THUMBTRACK, SB_THUMBPOSITION: Pos := SI.nTrackPos; Cardinal(cScrollDelta): Inc(Pos, Delta); end; if Pos < MaxScrollPos then Pos := (Pos div ScrollStep) * ScrollStep; Pos := MinMax(Pos, 0, MaxScrollPos); if Pos <> OldPos then begin if HasScrollBar then begin FillChar(SI, SizeOf(TScrollInfo), 0); SI.cbSize := SizeOf(TScrollInfo); SI.nPos := Pos; SI.fMask := SIF_POS; SetScrollInfo(Handle, Code, SI, True); end; ScrollPos := Pos; Result := True; end; end; var OldLeftPos, OldTopPos: Integer; ScrollHorzAxis, ScrollVertAxis: Boolean; begin OldLeftPos := FLeftPos; OldTopPos := FTopPos; ScrollHorzAxis := Axis(SB_HORZ, FScrollBars in [ssHorizontal, ssBoth], CodeHorz, DeltaHorz, FHorzScrollExtent, FHorzScrollStep, FLeftPos); ScrollVertAxis := Axis(SB_VERT, FScrollBars in [ssVertical, ssBoth], CodeVert, DeltaVert, FVertScrollExtent, FVertScrollStep, FTopPos); Result := ScrollHorzAxis or ScrollVertAxis; if Result then begin if ACallScrollWindow then ScrollWindowEx(Handle, OldLeftPos - FLeftPos, OldTopPos - FTopPos, nil, nil, 0, nil, SW_INVALIDATE) else Invalidate; UpdateEditorCaret; Inc(FPreferredCaretPos, OldLeftPos - FLeftPos); end; end; function TKCustomMemo.ScrollBy(DeltaHorz, DeltaVert: Integer; ACallScrollWindow: Boolean): Boolean; begin Result := Scroll(cScrollDelta, cScrollDelta, DeltaHorz, DeltaVert, ACallScrollWindow); end; procedure TKCustomMemo.ScrollToClientAreaCenter; var R: TRect; begin R := IndexToRect(SelEnd, True); ScrollBy(R.Left - ClientWidth div 2, R.Top - ClientHeight div 2, eoScrollWindow in FOptions); end; function TKCustomMemo.ScrollNeeded(AMousePos: PPoint; out DeltaCol, DeltaRow: Integer): Boolean; var HScrollPadding, VScrollPadding: Integer; begin DeltaCol := 0; DeltaRow := 0; HScrollPadding := HorzScrollPadding; VScrollPadding := VertScrollPadding; if AMousePos <> nil then begin if AMousePos.X < HScrollPadding then DeltaCol := AMousePos.X - HScrollPadding else if AMousePos.X > ClientWidth - HScrollPadding then DeltaCol := AMousePos.X - ClientWidth + HScrollPadding; if AMousePos.Y < VScrollPadding then DeltaRow := AMousePos.Y - VScrollPadding else if AMousePos.Y > ClientHeight - VScrollPadding then DeltaRow := AMousePos.Y - ClientHeight + VScrollPadding; end else begin if FCaretRect.Left < HScrollPadding then DeltaCol := FCaretRect.Left - HScrollPadding else if FCaretRect.Left + FCaretRect.Right > ClientWidth - HScrollPadding then DeltaCol := FCaretRect.Left + FCaretRect.Right - ClientWidth + HScrollPadding; if FCaretRect.Top < VScrollPadding then DeltaRow := FCaretRect.Top - VScrollPadding else if FCaretRect.Top + FCaretRect.Bottom > ClientHeight - VScrollPadding then DeltaRow := FCaretRect.Top + FCaretRect.Bottom - ClientHeight + VScrollPadding; end; Result := (DeltaCol <> 0) or (DeltaRow <> 0); end; procedure TKCustomMemo.ScrollTimerHandler(Sender: TObject); var DeltaHorz, DeltaVert: Integer; MousePos: TPoint; begin if (elMouseCapture in FStates) and not Dragging then begin MousePos := ScreenToClient(Mouse.CursorPos); SelectionExpand(MousePos, False); if ScrollNeeded(@MousePos, DeltaHorz, DeltaVert) then Scroll(cScrollDelta, cScrollDelta, DeltaHorz, DeltaVert, False) else if ScrollNeeded(nil, DeltaHorz, DeltaVert) then Scroll(cScrollDelta, cScrollDelta, DeltaHorz, DeltaVert, False) else FScrollTimer.Enabled := False; end else FScrollTimer.Enabled := False; end; procedure TKCustomMemo.Select(ASelStart, ASelLength: TKMemoSelectionIndex; ADoScroll: Boolean); begin if FSelectedBlock <> nil then begin FSelectedBlock.Select(0, 0, False); FSelectedBlock := nil; end; ActiveBlocks.Select(ASelStart, ASelLength, ADoScroll); end; procedure TKCustomMemo.SelectionExpand(ASelEnd: TKMemoSelectionIndex; ADoScroll: Boolean; APosition: TKMemoLinePosition); begin FLinePosition := APosition; Select(SelStart, ASelEnd - SelStart, ADoScroll); end; procedure TKCustomMemo.SelectionExpand(const APoint: TPoint; ADoScroll: Boolean); var NewSelEnd: TKMemoSelectionIndex; begin NewSelEnd := PointToIndex(APoint, True, True, FLinePosition); Select(SelStart, NewSelEnd - SelStart, ADoScroll); end; procedure TKCustomMemo.SelectionInit(ASelStart: TKMemoSelectionIndex; ADoScroll: Boolean; APosition: TKMemoLinePosition); begin FNewTextStyleValid := False; FLinePosition := APosition; Select(ASelStart, 0, ADoScroll); end; procedure TKCustomMemo.SelectionInit(const APoint: TPoint; ADoScroll: Boolean); var NewSelEnd: TKMemoSelectionIndex; begin FNewTextStyleValid := False; NewSelEnd := PointToIndex(APoint, True, False, FLinePosition); Select(NewSelEnd, 0, ADoScroll); UpdatePreferredCaretPos; end; function TKCustomMemo.SelectBlock(ABlock: TKMemoBlock; APosition: TKSizingGripPosition): Boolean; var StartIndex: TKMemoSelectionIndex; begin if ABlock.Position = mbpText then begin ActiveBlocks := ABlock.ParentRootBlocks; StartIndex := ActiveBlocks.BlockToIndex(ABlock); Result := StartIndex >= 0; if Result and (FSelectedBlock <> ABlock) then begin Select(StartIndex, ABlock.SelectableLength); FSelectedBlock := ABlock; end; end else begin // just select locally without scrolling and invalidate if ABlock is TKMemoContainer then begin ActiveBlocks := TKmemoContainer(ABlock).Blocks; FSelectedBlock := ABlock; UpdateEditorCaret end else begin ActiveBlocks := FBlocks; Select(SelStart, 0, False); // clear any other selection FSelectedBlock := ABlock; ABlock.Select(0, ABlock.SelectableLength(True), False); end; Result := True; end; // initialize dragging if not ReadOnly and ((ABlock.Position <> mbpText) or (APosition <> sgpNone)) then begin FDragCurPos := ScreenToClient(Mouse.CursorPos); FDragMode := APosition; FDragRect := SizingRect(ABlock); FDragOrigRect := FDragRect; Include(FStates, elMouseDragInit); end; end; procedure TKCustomMemo.SetActiveBlocks(const Value: TKMemoBlocks); begin if FActiveBlocks <> Value then begin Select(-1, 0, False); FActiveBlocks := Value; end; end; procedure TKCustomMemo.SetActiveBlocksForPoint(const APoint: TPoint); var TmpBlocks: TKMemoBlocks; begin TmpBlocks := FBlocks.PointToBlocks(PointToBlockPoint(APoint, False)); if TmpBlocks <> nil then ActiveBlocks := TmpBlocks else ActiveBlocks := FBlocks; end; procedure TKCustomMemo.SetRangeParaStyle(AFrom, ATo: TKMemoSelectionIndex; AStyle: TKMemoParaStyle); begin ActiveBlocks.SetRangeParaStyle(AFrom, ATo, AStyle); Modified := True; end; procedure TKCustomMemo.SetRangeTextStyle(AFrom, ATo: TKMemoSelectionIndex; AStyle: TKMemoTextStyle); begin ActiveBlocks.SetRangeTextStyle(AFrom, ATo, AStyle); Modified := True; end; procedure TKCustomMemo.SetBackground(const Value: TKMemoBackground); begin FBackground.Assign(Value); end; procedure TKCustomMemo.SetColors(Value: TKMemoColors); begin FColors.Assign(Value); end; procedure TKCustomMemo.SetContentPadding(const Value: TKRect); begin FContentPadding.Assign(Value); end; procedure TKCustomMemo.SetDisabledDrawStyle(Value: TKEditDisabledDrawStyle); begin if Value <> FDisabledDrawStyle then begin FDisabledDrawStyle := Value; if not Enabled then Invalidate; end; end; procedure TKCustomMemo.SetLeftPos(Value: Integer); begin Value := MinMax(Value, 0, FHorzScrollExtent - 1); if Value <> FLeftPos then ScrollBy(Value - FLeftPos, 0, eoScrollWindow in FOptions); end; procedure TKCustomMemo.SetMaxWordLength(const Value: TKMemoSelectionIndex); begin if Value <> FMaxWordLength then begin FMaxWordLength := Value; UpdateScrollRange(True); end; end; procedure TKCustomMemo.SetModified(Value: Boolean); begin if Value <> GetModified then begin if Value then Include(FStates, elModified) else begin Exclude(FStates, elModified); if eoUndoAfterSave in FOptions then FUndoList.Modified := False else begin FUndoList.Clear; FRedoList.Clear; end; end; end; end; procedure TKCustomMemo.SetReqMouseCursor(ACursor: TCursor); begin FRequiredMouseCursor := ACursor; end; function TKCustomMemo.SetMouseCursor(X, Y: Integer): Boolean; var ACursor: TCursor; P: TPoint; begin P := Point(X, Y); if PtInRect(ContentRect, P) then begin ACursor := FRequiredMouseCursor; end else ACursor := crDefault; {$IFDEF FPC} FCursor := ACursor; SetTempCursor(ACursor); {$ELSE} Windows.SetCursor(Screen.Cursors[ACursor]); {$ENDIF} Result := True; end; procedure TKCustomMemo.SetNewTextStyle(const Value: TKMemoTextStyle); begin FNewTextStyle.Assign(Value); FNewTextStyleValid := True; end; procedure TKCustomMemo.SetOptions(const Value: TKEditOptions); var UpdateShowFormatting, UpdateSingleChars: Boolean; {$IFDEF MSWINDOWS} UpdateDropFiles: Boolean; {$ENDIF} begin if Value <> FOptions then begin UpdateShowFormatting := (eoShowFormatting in Value) <> (eoShowFormatting in FOptions); {$IFDEF MSWINDOWS} UpdateDropFiles := (eoDropFiles in Value) <> (eoDropFiles in FOptions); {$ENDIF} UpdateSingleChars := (eoDrawSingleChars in Value) <> (eoDrawSingleChars in FOptions); FOptions := Value; FBlocks.NotifyOptionsChange; if UpdateShowFormatting or UpdateSingleChars then BlocksChanged([muExtent]); {$IFDEF MSWINDOWS} // (un)register HWND as drop target if UpdateDropFiles and not (csDesigning in ComponentState) and HandleAllocated then DragAcceptFiles(Handle, (eoDropFiles in fOptions)); {$ENDIF} end; end; procedure TKCustomMemo.SetReadOnly(Value: Boolean); begin if Value <> GetReadOnly then begin if Value then Include(FStates, elReadOnly) else Exclude(FStates, elReadOnly); end; end; procedure TKCustomMemo.SetRequiredContentWidth(const Value: Integer); begin if Value <> FRequiredContentWidth then begin FRequiredContentWidth := Value; UpdateScrollRange(True); end; end; procedure TKCustomMemo.SetRTF(const Value: TKMemoRTFString); var Stream: TStringStream; begin Stream := TStringStream.Create{$IFnDEF COMPILER12_UP}(''){$ENDIF}; try Stream.WriteString(Value); Stream.Seek(0, soFromBeginning); Clear(False); LoadFromRTFStream(Stream, -1); finally Stream.Free; end; end; procedure TKCustomMemo.SetScrollBars(Value: TScrollStyle); begin if Value <> FScrollBars then begin FScrollBars := Value; {$IFDEF FPC} CallUpdateSize; {$ELSE} RecreateWnd; {$ENDIF} end; end; procedure TKCustomMemo.SetScrollPadding(Value: Integer); begin FScrollPadding := MinMax(Integer(Value), cScrollPaddingMin, cScrollPaddingMax); end; procedure TKCustomMemo.SetScrollSpeed(Value: Cardinal); begin Value := MinMax(Integer(Value), cScrollSpeedMin, cScrollSpeedMax); if Value <> FScrollSpeed then begin FScrollSpeed := Value; FScrollTimer.Enabled := False; FScrollTimer.Interval := FScrollSpeed; end; end; procedure TKCustomMemo.SetSelectionParaStyle(const Value: TKMemoParaStyle); begin ActiveBlocks.SelectionParaStyle := Value; Modified := True; end; procedure TKCustomMemo.SetSelectionTextStyle(const Value: TKMemoTextStyle); begin ActiveBlocks.SelectionTextStyle := Value; Modified := True; end; procedure TKCustomMemo.SetSelEnd(Value: TKMemoSelectionIndex); begin Select(SelStart, Value - SelStart); end; procedure TKCustomMemo.SetSelLength(Value: TKMemoSelectionIndex); begin Select(SelStart, Value); end; procedure TKCustomMemo.SetSelStart(Value: TKMemoSelectionIndex); begin Select(Value, SelEnd - Value); end; procedure TKCustomMemo.SetText(const Value: TKString); begin ActiveBlocks.LockUpdate; try ActiveBlocks.Clear; ActiveBlocks.Text := Value; finally ActiveBlocks.UnlockUpdate; end; end; procedure TKCustomMemo.SetTopPos(Value: Integer); begin Value := MinMax(Value, 0, FVertScrollExtent - 1); if Value <> FTopPos then ScrollBy(0, Value - FTopPos, eoScrollWindow in FOptions); end; procedure TKCustomMemo.SetUndoLimit(Value: Integer); begin Value := MinMax(Value, cUndoLimitMin, cUndoLimitMax); if Value <> FUndoList.Limit then begin FUndoList.Limit := Value; FRedoList.Limit := Value; end; end; procedure TKCustomMemo.SetVisible(Value: Boolean); begin FBlocks.LockUpdate; try inherited Visible := Value; finally FBlocks.UnLockUpdate; end; end; procedure TKCustomMemo.SetWordBreaks(const Value: TKSysCharSet); begin if Value <> FWordBreaks then begin FWordBreaks := Value; BlocksChanged([muExtent]); end; end; procedure TKCustomMemo.ShowEditorCaret; begin if HandleAllocated then begin {$IFDEF FPC} SetCaretPosEx(Handle, FCaretRect.Left, FCaretRect.Top); {$ELSE} SetCaretPos(FCaretRect.Left, FCaretRect.Top); {$ENDIF} ShowCaret(Handle); end; end; function TKCustomMemo.SizingRect(ABlock: TKMemoBlock): TRect; var OldActiveBlocks: TKMemoBlocks; begin Result := CreateEmptyRect; if ABlock <> nil then begin OldActiveBlocks := FActiveBlocks; try FActiveBlocks := FBlocks.GetParentBlocksForBlock(ABlock); if FActiveBlocks <> nil then Result := BlockRectToRect(ABlock.SizingRect); finally FActiveBlocks := OldActiveBlocks; end; end; end; function TKCustomMemo.SplitAt(AIndex: TKMemoSelectionIndex): TKMemoBlockIndex; var LocalIndex, InnerLocalIndex: TKMemoSelectionIndex; Items: TKmemoBlocks; Block, NewBlock: TKMemoBlock; begin Items := ActiveBlocks.IndexToBlocks(AIndex, LocalIndex); if Items <> nil then begin Result := Items.IndexToBlockIndex(LocalIndex, InnerLocalIndex); if InnerLocalIndex > 0 then begin Block := Items[Result]; NewBlock := Block.Split(InnerLocalIndex); if NewBlock <> nil then begin Inc(Result); Items.AddAt(NewBlock, Result); end; end; end else Result := 0; end; procedure TKCustomMemo.TextStyleChanged(Sender: TObject); begin FBlocks.NotifyDefaultTextChange; end; procedure TKCustomMemo.UndoChange(Sender: TObject; ItemKind: TKMemoChangeKind); begin { if (Sender = FUndoList) and (ItemKind <> ckCaretPos) then DoChange;} end; procedure TKCustomMemo.UpdateEditorCaret(AShow: Boolean); begin if HandleAllocated then begin Include(FStates, elCaretUpdate); try if SelLength = 0 then ActiveBlocks.FixEOL(SelEnd, True, FLinePosition); FCaretRect := IndexToRect(SelEnd, True); Dec(FCaretRect.Right, FCaretRect.Left); // Right is width Dec(FCaretRect.Bottom, FCaretRect.Top); // Bottom is height if AShow then begin if Enabled and Focused and not (csDesigning in ComponentState) and (SelLength = 0) and not (eoDisableCaret in FOptions) and not RelativeSelected then begin if not (elOverwrite in FStates) then FCaretRect.Right := MinMax(FCaretRect.Bottom div 10, 2, 3); if not (elCaretCreated in FStates) or (FOldCaretRect.Right <> FCaretRect.Right) or (FOldCaretRect.Bottom <> FCaretRect.Bottom) then begin if CreateCaret(Handle, 0, FCaretRect.Right, FCaretRect.Bottom) then begin ShowEditorCaret; Include(FStates, elCaretVisible); Include(FStates, elCaretCreated); end; end else if (FOldCaretRect.Left <> FCaretRect.Left) or (FOldCaretRect.Top <> FCaretRect.Top) then begin ShowEditorCaret; Include(FStates, elCaretVisible); end; FOldCaretRect := FCaretRect; end else if elCaretCreated in FStates then begin HideEditorCaret; {$IFDEF FPC} DestroyCaret(Handle); {$ELSE} DestroyCaret; {$ENDIF} FStates := FStates - [elCaretCreated, elCaretVisible]; end; end; finally Exclude(FStates, elCaretUpdate); end; end; end; procedure TKCustomMemo.UpdateMouseCursor; var P: TPoint; OldCursor, NewCursor: TCursor; DoUpdate: Boolean; begin if not (elMouseCapture in FStates) then begin DoUpdate := False; P := ScreenToClient(Mouse.CursorPos); NewCursor := crIBeam; if NewCursor <> FRequiredMouseCursor then begin FRequiredMouseCursor := NewCursor; DoUpdate := True; end; OldCursor := FRequiredMouseCursor; FBlocks.MouseAction(maMove, Canvas, PointToBlockPoint(P, False), GetShiftState); if FRequiredMouseCursor <> OldCursor then DoUpdate := True; if DoUpdate then SetMouseCursor(P.X, P.Y); end; end; procedure TKCustomMemo.UpdatePreferredCaretPos; begin FPreferredCaretPos := FCaretRect.Left - ContentLeft; if ActiveBlocks <> FBlocks then Dec(FPreferredCaretPos, ActiveBlocks.TotalLeftOffset); end; procedure TKCustomMemo.UpdateScrollRange(CallInvalidate: Boolean); var DeltaHorz, DeltaVert, ClientHorz, ClientVert: Integer; SI: TScrollInfo; SBVisible: Boolean; begin if HandleAllocated then begin if not UpdateUnlocked then Exit; if FInUpdateScrollRange then begin PostLateUpdate(FillMessage(KM_SCROLL, 0, 0), True); Exit; end; FInUpdateScrollRange := True; try FBlocks.MeasureExtent(Canvas, RequiredContentWidth); FHorzExtent := FBlocks.Width + FContentPadding.Left + FContentPadding.Right; FVertExtent := FBlocks.Height + FContentPadding.Top + FContentPadding.Bottom; ClientHorz := ClientWidth; ClientVert := ClientHeight; DeltaHorz := Max(FLeftPos + ClientHorz - FHorzExtent - 1, 0); DeltaVert := Max(FTopPos + ClientVert - FVertExtent - 1, 0); FHorzScrollExtent := 0; FVertScrollExtent := 0; if FScrollBars in [ssBoth, ssHorizontal, ssVertical] then begin SI.cbSize := SizeOf(TScrollInfo); SI.fMask := SIF_RANGE or SIF_PAGE or SIF_POS {$IFDEF UNIX}or SIF_UPDATEPOLICY{$ENDIF}; SI.nMin := 0; {$IFDEF UNIX} SI.nTrackPos := SB_POLICY_CONTINUOUS; {$ELSE} SI.nTrackPos := 0; {$ENDIF} if FScrollBars in [ssBoth, ssHorizontal] then begin SBVisible := ClientWidth < FHorzExtent; ShowScrollBar(Handle, SB_HORZ, SBVisible); if SBVisible then begin SI.nMax := FHorzExtent{$IFnDEF FPC}- 1{$ENDIF}; SI.nPage := ClientHorz; SI.nPos := FLeftPos; SetScrollInfo(Handle, SB_HORZ, SI, True); FHorzScrollExtent := Max(FHorzExtent - Integer(SI.nPage), 0); end; end else ShowScrollBar(Handle, SB_HORZ, False); if FScrollBars in [ssBoth, ssVertical] then begin SBVisible := ClientVert < FVertExtent; ShowScrollBar(Handle, SB_VERT, SBVisible); if SBVisible then begin SI.nMax := FVertExtent{$IFnDEF FPC}- 1{$ENDIF}; SI.nPage := ClientVert; SI.nPos := FTopPos; SetScrollInfo(Handle, SB_VERT, SI, True); FVertScrollExtent := Max(FVertExtent - Integer(SI.nPage), 0); end; end else ShowScrollBar(Handle, SB_VERT, False); end; if CallInvalidate then begin if not ScrollBy(-DeltaHorz, -DeltaVert, False) then begin UpdateEditorCaret; Invalidate; end; end; InvalidatePageSetup; PrepareToPaint(Canvas); finally FInUpdateScrollRange := False; end; end; end; procedure TKCustomMemo.UpdateSize; begin UpdateScrollRange(True); end; procedure TKCustomMemo.WMClear(var Msg: TLMessage); begin ExecuteCommand(ecClearAll); end; procedure TKCustomMemo.WMCopy(var Msg: TLMessage); begin ExecuteCommand(ecCopy); end; procedure TKCustomMemo.WMCut(var Msg: TLMessage); begin ExecuteCommand(ecCut); end; {$IFNDEF FPC} procedure TKCustomMemo.WMDropFiles(var Msg: TMessage); var I, FileCount: Integer; PathName: array[0..260] of Char; Point: TPoint; FilesList: TStringList; begin try if Assigned(FOnDropFiles) then begin FilesList := TStringList.Create; try FileCount := DragQueryFile(THandle(Msg.wParam), Cardinal(-1), nil, 0); DragQueryPoint(THandle(Msg.wParam), Point); for i := 0 to FileCount - 1 do begin DragQueryFile(THandle(Msg.wParam), I, PathName, SizeOf(PathName)); FilesList.Add(PathName); end; FOnDropFiles(Self, Point.X, Point.Y, FilesList); finally FilesList.Free; end; end; finally Msg.Result := 0; DragFinish(THandle(Msg.wParam)); end; end; {$ENDIF} procedure TKCustomMemo.WMEraseBkgnd(var Msg: TLMessage); begin Msg.Result := 1 end; procedure TKCustomMemo.WMGetDlgCode(var Msg: TLMNoParams); begin Msg.Result := DLGC_WANTARROWS; if eoWantTab in FOptions then Msg.Result := Msg.Result or DLGC_WANTTAB; end; procedure TKCustomMemo.WMHScroll(var Msg: TLMHScroll); begin SafeSetFocus; Scroll(Msg.ScrollCode, cScrollNoAction, Msg.Pos, 0, eoScrollWindow in FOptions); end; procedure TKCustomMemo.WMKillFocus(var Msg: TLMKillFocus); begin inherited; ExecuteCommand(ecLostFocus); end; procedure TKCustomMemo.WMPaste(var Msg: TLMessage); begin ExecuteCommand(ecPaste); end; procedure TKCustomMemo.WMSetFocus(var Msg: TLMSetFocus); begin inherited; ExecuteCommand(ecGotFocus); end; procedure TKCustomMemo.WMVScroll(var Msg: TLMVScroll); begin SafeSetFocus; Scroll(cScrollNoAction, Msg.ScrollCode, 0, Msg.Pos, eoScrollWindow in FOptions); end; { TKMemoBlock } constructor TKMemoBlock.Create; begin inherited; FOffset := CreateEmptyPoint; FDoubleClickState := mdblNone; FMouseCaptureWord := -1; FClickOnMouseUp := True; FOnClick := nil; FOnDblClick := nil; end; destructor TKMemoBlock.Destroy; begin if MemoNotifier <> nil then MemoNotifier.BlockFreeNotification(Self); inherited Destroy; end; function TKMemoBlock.EqualProperties(ASource: TKObject): Boolean; begin Result := False; end; function TKMemoBlock.ActiveBlocks: TKMemoBlocks; var Notifier: IKMemoNotifier; begin Notifier := MemoNotifier; if Notifier <> nil then Result := Notifier.GetActiveBlocks else Result := nil; end; procedure TKMemoBlock.Assign(ASource: TKObject); begin if ASource is TKMemoBlock then begin Select(TKMemoBlock(ASource).SelStart, TKMemoBlock(ASource).SelLength, False); OnClick := TKMemoBlock(ASource).OnClick; OnDblClick := TKMemoBlock(ASource).OnDblClick; AssignAttributes(TKMemoBlock(ASource)); end; end; procedure TKMemoBlock.AssignAttributes(ABlock: TKMemoBlock); begin if ABlock <> nil then begin Position := ABlock.Position; LeftOffset := ABlock.LeftOffset; TopOffset := ABlock.TopOffset; end; end; function TKMemoBlock.CalcAscent(ACanvas: TCanvas): Integer; begin Result := 0; end; procedure TKMemoBlock.CallAfterUpdate; begin if ParentBlocks <> nil then ParentBlocks.UnlockUpdate; end; procedure TKMemoBlock.CallBeforeUpdate; begin if ParentBlocks <> nil then ParentBlocks.LockUpdate; end; function TKMemoBlock.CanAdd(ABlock: TKMemoBlock): Boolean; begin Result := False; end; procedure TKMemoBlock.ClearSelection(ATextOnly: Boolean); begin end; function TKMemoBlock.Concat(ABlock: TKMemoBlock): Boolean; begin Result := False; end; function TKMemoBlock.ContentLength: TKMemoSelectionIndex; begin Result := 0; end; function TKMemoBlock.GetBottomPadding: Integer; begin Result := 0; end; function TKMemoBlock.GetBoundsRect: TRect; begin Result := Rect(Left, Top, Left + Width, Top + Height); end; function TKMemoBlock.GetCanAddText: Boolean; begin Result := False; end; function TKMemoBlock.GetWrapMode: TKMemoBlockWrapMode; begin Result := wrAround; end; function TKMemoBlock.GetDefaultParaStyle: TKMemoParaStyle; begin if Parent <> nil then Result := ParentBlocks.DefaultParaStyle else Result := nil; end; function TKMemoBlock.GetDefaultTextStyle: TKMemoTextStyle; begin if Parent <> nil then Result := ParentBlocks.DefaultTextStyle else Result := nil; end; function TKMemoBlock.GetHeight: Integer; var I: Integer; begin Result := 0; for I := 0 to WordCount - 1 do Result := Max(Result, WordTop[I] + WordHeight[I]); Dec(Result, Top); end; function TKMemoBlock.GetLeft: Integer; var I: Integer; begin Result := WordLeft[0]; for I := 1 to WordCount - 1 do Result := Min(Result, WordLeft[I]); end; function TKMemoBlock.GetMemoNotifier: IKMemoNotifier; begin if Parent <> nil then Result := ParentBlocks.MemoNotifier else Result := nil; end; function TKMemoBlock.GetPaintSelection: Boolean; var Notifier: IKMemoNotifier; begin Notifier := MemoNotifier; if Notifier <> nil then Result := Notifier.GetPaintSelection else Result := False; end; function TKMemoBlock.GetParaStyle: TKMemoParaStyle; begin Result := nil; end; function TKMemoBlock.GetParentBlocks: TKMemoBlocks; begin Result := Parent as TKMemoBlocks; end; function TKMemoBlock.GetParentRootBlocks: TKMemoBlocks; var Block: TKMemoBlock; begin Result := ParentBlocks; if Result <> nil then begin Block := Result.Parent; while (Block <> nil) and (Block.Position = mbpText) do begin if Block.ParentBlocks <> nil then begin Result := Block.ParentBlocks; Block := Result.Parent end else Block := nil; end; end; end; function TKMemoBlock.GetPrinting: Boolean; var Notifier: IKMemoNotifier; begin Notifier := MemoNotifier; if Notifier <> nil then Result := Notifier.GetPrinting else Result := False; end; function TKMemoBlock.GetReadOnly: Boolean; var Notifier: IKMemoNotifier; begin Notifier := MemoNotifier; if Notifier <> nil then Result := Notifier.GetReadOnly else Result := False; end; function TKMemoBlock.GetWordRect(Index: TKMemoWordIndex): TRect; begin Result.Left := WordLeft[Index]; Result.Top := WordTop[Index]; Result.Right := Result.Left + WordWidth[Index]; Result.Bottom := Result.Top + WordHeight[Index]; end; function TKMemoBlock.GetResizable: Boolean; begin Result := False; end; procedure TKMemoBlock.GetSelColors(out Foreground, Background: TColor); begin Foreground := cSelTextFocusedDef; Background := cSelBkGndFocusedDef; if Parent <> nil then ParentBlocks.GetSelColors(Foreground, Background); end; function TKMemoBlock.GetSelEnd: TKMemoSelectionIndex; begin Result := SelStart + SelLength; end; function TKMemoBlock.GetSelLength: TKMemoSelectionIndex; begin Result := 0; end; function TKMemoBlock.GetSelStart: TKMemoSelectionIndex; begin Result := -1; end; function TKMemoBlock.GetSelText: TKString; begin Result := ''; end; function TKMemoBlock.GetShowFormatting: Boolean; begin if Parent <> nil then Result := ParentBlocks.ShowFormatting else Result := False; end; function TKMemoBlock.GetSizingRect: TRect; begin Result := BoundsRect; KFunctions.OffsetRect(Result, RealLeftOffset, RealTopOffset); end; function TKMemoBlock.GetText: TKString; begin Result := ''; end; function TKMemoBlock.GetTop: Integer; var I: Integer; begin Result := WordTop[0]; for I := 1 to WordCount - 1 do Result := Min(Result, WordTop[I]); end; function TKMemoBlock.GetTopPadding: Integer; begin Result := 0; end; function TKMemoBlock.GetWidth: Integer; var I: Integer; begin Result := 0; for I := 0 to WordCount - 1 do Result := Max(Result, WordLeft[I] + WordWidth[I]); Dec(Result, Left); end; function TKMemoBlock.GetWordBaseLine(Index: TKMemoWordIndex): Integer; begin Result := 0; end; function TKMemoBlock.GetWordBottomPadding(Index: TKMemoWordIndex): Integer; begin Result := 0; end; function TKMemoBlock.GetWordBoundsRect(Index: TKMemoWordIndex): TRect; begin Result := CreateEmptyRect; end; function TKMemoBlock.GetWordBreakable(Index: TKMemoWordIndex): Boolean; begin Result := True; end; function TKMemoBlock.GetWordClipped(Index: TKMemoWordIndex): Boolean; begin Result := False; end; function TKMemoBlock.GetWordCount: Integer; begin Result := 0; end; function TKMemoBlock.GetWordHeight(Index: TKMemoWordIndex): Integer; begin Result := 0; end; procedure TKMemoBlock.GetWordIndexes(AIndex: TKMemoSelectionIndex; out ASt, AEn: TKMemoSelectionIndex); begin ASt := 0; AEn := 0; end; function TKMemoBlock.GetWordLeft(Index: TKMemoWordIndex): Integer; begin Result := 0; end; function TKMemoBlock.GetWordLength(Index: TKMemoWordIndex): TKMemoSelectionIndex; begin Result := 0; end; function TKMemoBlock.GetWordLengthWOWS(Index: TKMemoWordIndex): TKMemoSelectionIndex; begin Result := GetWordLength(Index); end; function TKMemoBlock.GetWords(Index: TKMemoWordIndex): TKString; begin Result := ''; end; function TKMemoBlock.GetWordTop(Index: TKMemoWordIndex): Integer; begin Result := 0; end; function TKMemoBlock.GetWordTopPadding(Index: TKMemoWordIndex): Integer; begin Result := 0; end; function TKMemoBlock.GetWordWidth(Index: TKMemoWordIndex): Integer; begin Result := 0; end; function TKMemoBlock.IndexToRect(ACanvas: TCanvas; AIndex: TKMemoSelectionIndex; ACaret: Boolean): TRect; var Found: Boolean; WordIndex: TKMemoWordIndex; WLen: Integer; begin Result := CreateEmptyRect; Found := False; WordIndex := 0; WLen := 0; while not Found and (WordIndex < WordCount) do begin Result := WordIndexToRect(ACanvas, WordIndex, AIndex - WLen, ACaret); Inc(WLen, WordLength[WordIndex]); Inc(WordIndex); end; end; function TKMemoBlock.InsertParagraph(AIndex: TKMemoSelectionIndex): Boolean; var ParentBlock: TKMemoBlockIndex; NewItem: TKMemoBlock; begin Result := False; if Parent <> nil then begin ParentBlock := ParentBlocks.IndexOf(Self); NewItem := Split(AIndex); if NewItem <> nil then begin ParentBlocks.AddAt(NewItem, ParentBlock + 1); ParentBlocks.AddParagraph(ParentBlock + 1); end else begin if AIndex = 0 then ParentBlocks.AddParagraph(ParentBlock) else ParentBlocks.AddParagraph(ParentBlock + 1); end; Result := True; end; end; function TKMemoBlock.InsertString(const AText: TKString; At: TKMemoSelectionIndex): Boolean; begin Result := False; end; function TKMemoBlock.RealLeftOffset: Integer; begin if FPosition <> mbpText then Result := FOffset.X else Result := 0; end; function TKMemoBlock.RealTopOffset: Integer; begin if FPosition <> mbpText then Result := FOffset.Y else Result := 0; end; procedure TKMemoBlock.Resize(ANewWidth, ANewHeight: Integer); begin end; procedure TKMemoBlock.RestoreUpdateState(AValue: TKMemoUpdateReasons); begin if ParentBlocks <> nil then ParentBlocks.RestoreUpdateState(AValue); end; function TKMemoBlock.MeasureExtent(ACanvas: TCanvas; ARequiredWidth: Integer): TPoint; var I: Integer; Extent: TPoint; begin Result := CreateEmptyPoint; for I := 0 to WordCount - 1 do begin Extent := WordMeasureExtent(ACanvas, I, ARequiredWidth); Inc(Result.X, Extent.X); Result.Y := Max(Result.Y, Extent.Y); end; end; procedure TKMemoBlock.NotifyDefaultParaChange; begin end; procedure TKMemoBlock.NotifyDefaultTextChange; begin end; procedure TKMemoBlock.NotifyOptionsChange; begin end; procedure TKMemoBlock.NotifyPrintBegin; begin end; procedure TKMemoBlock.NotifyPrintEnd; begin end; procedure TKMemoBlock.PaintToCanvas(ACanvas: TCanvas; ALeft, ATop: Integer); var I: Integer; begin for I := 0 to WordCount - 1 do WordPaintToCanvas(ACanvas, I, ALeft, ATop); end; function TKMemoBlock.PixelsPerInchX: Integer; var Notifier: IKMemoNotifier; begin Notifier := MemoNotifier; if Notifier <> nil then Result := Notifier.GetPixelsPerInchX else Result := KEditCommon.PixelsPerInchX(0); end; function TKMemoBlock.PixelsPerInchY: Integer; var Notifier: IKMemoNotifier; begin Notifier := MemoNotifier; if Notifier <> nil then Result := Notifier.GetPixelsPerInchY else Result := KEditCommon.PixelsPerInchY(0); end; function TKMemoBlock.PointToIndex(ACanvas: TCanvas; const APoint: TPoint; AOutOfArea, ASelectionExpanding: Boolean; out APosition: TKMemoLinePosition): TKMemoSelectionIndex; var WordIndex: TKMemoWordIndex; begin Result := -1; WordIndex := 0; while (Result < 0) and (WordIndex < WordCount) do begin Result := WordPointToIndex(ACanvas, APoint, WordIndex, AOutOfArea, ASelectionExpanding, APosition); Inc(WordIndex); end; end; function TKMemoBlock.WordPointToIndex(ACanvas: TCanvas; const APoint: TPoint; AWordIndex: TKMemoWordIndex; AOutOfArea, ASelectionExpanding: Boolean; out APosition: TKMemoLinePosition): TKMemoSelectionIndex; begin Result := -1; end; function TKMemoBlock.SaveUpdateState: TKMemoUpdateReasons; begin if ParentBlocks <> nil then Result := ParentBlocks.SaveUpdateState else Result := []; end; function TKMemoBlock.Select(ASelStart, ASelLength: TKMemoSelectionIndex; ADoScroll: Boolean): Boolean; begin Result := False; end; function TKMemoBlock.SelectableLength(ALocalCalc: Boolean): TKMemoSelectionIndex; begin if (Position = mbpText) or ALocalCalc then Result := ContentLength else Result := 0; end; procedure TKMemoBlock.SelectAll; begin Select(0, SelectableLength, False); end; function TKMemoBlock.SelectedBlock: TKMemoBlock; var Notifier: IKMemoNotifier; begin Notifier := MemoNotifier; if Notifier <> nil then Result := Notifier.GetSelectedBlock else Result := nil; end; procedure TKMemoBlock.SetLeftOffset(const Value: Integer); begin if Value <> FOffset.X then begin FOffset.X := Value; Update([muExtent]); end; end; procedure TKMemoBlock.SetPosition(const Value: TKMemoBlockPosition); begin if Value <> FPosition then begin FPosition := Value; Update([muContent]); end; end; function TKMemoBlock.Click: Boolean; var Notifier: IKMemoNotifier; begin if Assigned(FOnClick) then begin FOnClick(Self); Result := True; end else begin Notifier := MemoNotifier; if Notifier <> nil then Result := Notifier.BlockClick(Self) else Result := False; end; end; function TKMemoBlock.DblClick: Boolean; var Notifier: IKMemoNotifier; begin if Assigned(FOnDblClick) then begin FOnDblClick(Self); Result := True; end else begin Notifier := MemoNotifier; if Notifier <> nil then Result := Notifier.BlockDblClick(Self) else Result := False; end; end; procedure TKMemoBlock.SetResizable(const Value: Boolean); begin Error('Resizable property unsupported for this block.'); end; procedure TKMemoBlock.SetTopOffset(const Value: Integer); var BlockIndex: TKMemoBlockIndex; Blocks: TKMemoBlocks; Block: TKMemoBlock; Y: Integer; begin if Value <> FOffset.Y then begin Y := Value; if (Y < 0) and (FPosition = mbpRelative) then begin Blocks := ParentBlocks; if Blocks <> nil then begin Blocks.LockUpdate; try // try to move block anchor first BlockIndex := Blocks.IndexOf(Self) - 1; if BlockIndex > 0 then begin Inc(Y, TopOffset); repeat BlockIndex := Blocks.GetNearestAnchorBlockIndex(BlockIndex); if BlockIndex >= 0 then begin Block := Blocks[BlockIndex]; Inc(Y, Block.Height); Dec(BlockIndex); end; until (Y >= 0) or (BlockIndex < 0); Inc(BlockIndex); Blocks.Extract(Self); Blocks.AddAt(Self, BlockIndex); end; finally Blocks.UnLockUpdate; end; end; end; FOffset.Y := Y; Update([muExtent]); end; end; procedure TKMemoBlock.SetWordBaseLine(Index: TKMemoWordIndex; const Value: Integer); begin end; procedure TKMemoBlock.SetWordBottomPadding(Index: TKMemoWordIndex; const Value: Integer); begin end; procedure TKMemoBlock.SetWordClipped(Index: TKMemoWordIndex; const Value: Boolean); begin end; procedure TKMemoBlock.SetWordHeight(Index: TKMemoWordIndex; const Value: Integer); begin end; procedure TKMemoBlock.SetWordLeft(Index: TKMemoWordIndex; const Value: Integer); begin end; procedure TKMemoBlock.SetWordTop(Index: TKMemoWordIndex; const Value: Integer); begin end; procedure TKMemoBlock.SetWordTopPadding(Index: TKMemoWordIndex; const Value: Integer); begin end; procedure TKMemoBlock.SetWordWidth(Index: TKMemoWordIndex; const Value: Integer); begin end; function TKMemoBlock.SizingGripsCursor(const ARect: TRect; const APoint: TPoint): TCursor; var Grips: TKSizingGrips; begin if Resizable then begin Grips := TKSizingGrips.Create; try Grips.BoundsRect := ARect; Result := Grips.CursorAt(APoint); finally Grips.Free; end; end else Result := crDefault; end; procedure TKMemoBlock.SizingGripsDraw(ACanvas: TCanvas; const ARect: TRect); var Grips: TKSizingGrips; begin if Resizable then begin Grips := TKSizingGrips.Create; try Grips.BoundsRect := ARect; Grips.DrawTo(ACanvas); finally Grips.Free; end; end; end; function TKMemoBlock.SizingGripsPosition(const ARect: TRect; const APoint: TPoint): TKSizingGripPosition; var Grips: TKSizingGrips; begin if Resizable then begin Grips := TKSizingGrips.Create; try Grips.BoundsRect := ARect; Result := Grips.HitTest(APoint); finally Grips.Free; end; end else Result := sgpNone; end; function TKMemoBlock.Split(At: TKMemoSelectionIndex; AllowEmpty: Boolean): TKMemoBlock; begin Result := nil; end; procedure TKMemoBlock.Update(AReasons: TKMemoUpdateReasons); begin if Parent <> nil then ParentBlocks.Update(AReasons) end; function TKMemoBlock.WordIndexToRect(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AIndex: TKMemoSelectionIndex; ACaret: Boolean): TRect; begin Result := CreateEmptyRect; end; function TKMemoBlock.WordMeasureExtent(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ARequiredWidth: Integer): TPoint; begin Result := CreateEmptyPoint; end; function TKMemoBlock.WordMouseAction(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AAction: TKMemoMouseAction; const APoint: TPoint; AShift: TShiftState): Boolean; var R: TRect; begin Result := False; R := WordRect[AWordIndex]; if PtInRect(R, APoint) then begin case AAction of maLeftDown: begin if FMouseCaptureWord < 0 then begin FMouseCaptureWord := AWordIndex; FDoubleClickState := mdblNone; if ssDouble in AShift then begin Result := DblClick; if Result then FDoubleClickState := mdblClickedAndHandled else FDoubleClickState := mdblClicked; end else if not ClickOnMouseUp then Result := Click end; end; maLeftUp: begin if FMouseCaptureWord >= 0 then begin FMouseCaptureWord := -1; if ClickOnMouseUp and (FDoubleClickState = mdblNone) then Result := Click end; end; end; end else begin case AAction of maLeftUp: if FMouseCaptureWord = AWordIndex then FMouseCaptureWord := -1; end; end; end; procedure TKMemoBlock.WordPaintToCanvas(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ALeft, ATop: Integer); begin end; { TKMemoSingleBlock } constructor TKMemoSingleton.Create; begin inherited; FSelEnd := -1; FSelStart := -1; end; function TKMemoSingleton.GetSelLength: TKMemoSelectionIndex; begin Result := FSelEnd - FSelStart; end; function TKMemoSingleton.GetSelStart: TKMemoSelectionIndex; begin Result := FSelStart; end; function TKMemoSingleton.Select(ASelStart, ASelLength: TKMemoSelectionIndex; ADoScroll: Boolean): Boolean; var NewSelEnd, MaxLen: TKMemoSelectionIndex; begin NewSelEnd := ASelStart + ASelLength; if NewSelEnd < ASelStart then Exchange(Integer(ASelStart), Integer(NewSelEnd)); MaxLen := SelectableLength(True); NewSelEnd := MinMax(NewSelEnd, -1, MaxLen); ASelStart := MinMax(ASelStart, -1, MaxLen); if (ASelStart <> FSelStart) or (NewSelEnd <> FSelEnd) then begin FSelEnd := NewSelEnd; FSelStart := ASelStart; if ADoScroll then Update([muSelectionScroll]) else Update([muSelection]); Result := True; end else Result := False; end; { TKTextMemoBlock } constructor TKMemoTextBlock.Create; begin FTextStyle := TKMemoTextStyle.Create; FTextStyle.OnChanged := TextStyleChanged; FWordBreakStyle := wbsLastWordChar; inherited; FText := ''; FTextLength := 0; FWordCount := 0; FWords := TKMemoWordList.Create; end; destructor TKMemoTextBlock.Destroy; begin FTextStyle.Free; FWords.Free; FWordCount := 0; inherited; end; function TKMemoTextBlock.SingleCharWords: Boolean; var Notifier: IKMemoNotifier; begin Result := FWordBreakStyle = wbsEveryChar; if not Result then begin Notifier := MemoNotifier; if Notifier <> nil then Result := Notifier.GetDrawSingleChars or Notifier.GetWrapSingleChars; end end; function TKMemoTextBlock.EqualProperties(ASource: TKObject): Boolean; begin if ASource is TKMemoTextBlock then begin Result := (TKMemoTextBlock(ASource).Text = Text) and TKMemoTextBlock(ASource).TextStyle.EqualProperties(TextStyle); end else Result := False; end; function TKMemoTextBlock.ApplyFormatting(const AText: TKString): TKString; begin if ShowFormatting then begin Result := UnicodeStringReplace(AText, ' ', SpaceChar, [rfReplaceAll]); end else begin Result := UnicodeStringReplace(AText, NewLineChar, ' ', [rfReplaceAll]); end; end; procedure TKMemoTextBlock.ApplyTextStyle(ACanvas: TCanvas); begin with ACanvas do begin Font.Assign(FTextStyle.Font); FScriptFontHeight := FTextStyle.Font.Height; Font.Height := FScriptFontHeight; case FTextStyle.ScriptPosition of tpoSuperscript: begin FScriptVertOffset := GetFontAscent(ACanvas.Handle); // aligned to ascent line of original font FScriptFontHeight := MulDiv(FScriptFontHeight, 3, 5); // 60% Font.Height := FScriptFontHeight; Dec(FScriptVertOffset, GetFontAscent(ACanvas.Handle)); end; tpoSubscript: begin FScriptVertOffset := -GetFontDescent(ACanvas.Handle); // aligned to descent line of original font FScriptFontHeight := MulDiv(FScriptFontHeight, 3, 5); // 60% Font.Height := FScriptFontHeight; end; else FScriptVertOffset := 0; end; if FTextStyle.AllowBrush then Brush.Assign(FTextStyle.Brush) else begin Brush.Style := bsClear; Font.Style := Font.Style - [fsUnderLine]; end; end; end; procedure TKMemoTextBlock.Assign(ASource: TKObject); begin inherited; if ASource is TKMemoTextBlock then Text := TKMemoTextBlock(ASource).Text; end; procedure TKMemoTextBlock.AssignAttributes(ABlock: TKMemoBlock); begin inherited; if ABlock is TKMemoTextBlock then begin TextStyle.Assign(TKMemoTextBlock(ABlock).TextStyle); WordBreakStyle := TKMemoTextBlock(ABlock).WordBreakStyle; end; end; function TKMemoTextBlock.CalcAscent(ACanvas: TCanvas): Integer; begin ApplyTextStyle(ACanvas); Result := GetFontAscent(ACanvas.Handle); end; function TKMemoTextBlock.CalcDescent(ACanvas: TCanvas): Integer; begin ApplyTextStyle(ACanvas); Result := GetFontDescent(ACanvas.Handle); end; procedure TKMemoTextBlock.ClearSelection(ATextOnly: Boolean); var S: TKString; begin inherited; if SelLength <> 0 then begin S := Text; StringDelete(S, FSelStart + 1, FSelEnd - FSelStart); FSelEnd := FSelStart; Text := S; end; end; function TKMemoTextBlock.Concat(ABlock: TKMemoBlock): Boolean; var TmpLen: Integer; begin Result := ABlock is TKMemoTextBlock; if Result then begin TmpLen := SelectableLength; InsertString(TKMemoTextBlock(ABlock).Text, -1); // concat selection when necessary if (ABlock.SelLength > 0) and (ABlock.SelStart = 0) then begin if (SelLength > 0) and (SelEnd >= TmpLen) then begin // concat with previous selection Select(SelStart, TmpLen + ABlock.SelLength, False); end else begin // create new selection Select(TmpLen, TmpLen + ABlock.SelLength, False); end; end; end; end; function TKMemoTextBlock.ContentLength: TKMemoSelectionIndex; begin Result := FTextLength; end; function TKMemoTextBlock.GetCanAddText: Boolean; begin Result := Position = mbpText; end; function TKMemoTextBlock.GetKerningDistance(ACanvas: TCanvas; const AChar1, AChar2: TKChar): Integer; {$IFDEF MSWINDOWS} var Cnt: Integer; Pairs: array of TKerningPair; C1, C2: WideChar; I: Integer; {$ENDIF} begin Result := 0; {$IFDEF MSWINDOWS} Cnt := GetKerningPairs(ACanvas.Handle, 0, nil); if Cnt > 0 then begin SetLength(Pairs, Cnt); GetKerningPairs(ACanvas.Handle, Cnt, PKerningPairs(@Pairs[0])); C1 := NativeUTFToUnicode(AChar1); C2 := NativeUTFToUnicode(AChar2); for I := 0 to Cnt - 1 do if (Pairs[I].wFirst = Ord(C1)) and (Pairs[I].wSecond = Ord(C2)) then begin if Pairs[I].iKernAmount <> 0 then begin Result := Pairs[I].iKernAmount; end; Exit; end; end; {$ENDIF} end; function TKMemoTextBlock.GetSelText: TKString; begin Result := StringCopy(Text, FSelStart + 1, FSelEnd - FSelStart); end; function TKMemoTextBlock.GetText: TKString; begin Result := FText; end; function TKMemoTextBlock.GetWordBaseLine(Index: TKMemoWordIndex): Integer; begin Result := FWords[Index].BaseLine; end; function TKMemoTextBlock.GetWordBottomPadding(Index: TKMemoWordIndex): Integer; begin Result := FWords[Index].BottomPadding; end; function TKMemoTextBlock.GetWordClipped(Index: TKMemoWordIndex): Boolean; begin Result := FWords[Index].Clipped; end; function TKMemoTextBlock.GetWordCount: Integer; begin Result := FWordCount; end; function TKMemoTextBlock.GetWordHeight(Index: TKMemoWordIndex): Integer; begin Result := FWords[Index].Extent.Y; end; procedure TKMemoTextBlock.GetWordIndexes(AIndex: TKMemoSelectionIndex; out ASt, AEn: TKMemoSelectionIndex); var I: TKMemoWordIndex; begin inherited; for I := 0 to FWordCount - 1 do if (AIndex >= FWords[I].StartIndex) and (AIndex < FWords[I].EndIndex) then begin ASt := FWords[I].StartIndex; AEn := FWords[I].EndIndex; Break; end; end; function TKMemoTextBlock.GetWordLeft(Index: TKMemoWordIndex): Integer; begin Result := FWords[Index].Position.X; end; function TKMemoTextBlock.GetWordLength(Index: TKMemoWordIndex): TKMemoSelectionIndex; begin Result := FWords[Index].EndIndex - FWords[Index].StartIndex + 1; end; function TKMemoTextBlock.GetWordLengthWOWS(Index: TKMemoWordIndex): TKMemoSelectionIndex; var I: Integer; S: TKString; begin Result := GetWordLength(Index); S := Words[Index]; I := Length(S); while (I >= 1) and CharInSetEx(S[I], [cTAB] + Wordbreaks) do begin Dec(Result); Dec(I); end; end; function TKMemoTextBlock.GetWordBoundsRect(Index: TKMemoWordIndex): TRect; begin Result.TopLeft := CreateEmptyPoint; Result.BottomRight := FWords[Index].Extent; KFunctions.OffsetRect(Result, FWords[Index].Position); end; function TKMemoTextBlock.GetWordBreakable(Index: TKMemoWordIndex): Boolean; var S: TKString; Notifier: IKMemoNotifier; begin Result := False; Notifier := MemoNotifier; if Notifier <> nil then Result := Notifier.GetWrapSingleChars; if not Result then begin S := Words[Index]; if S <> '' then begin case FWordBreakStyle of wbsLastWordChar: Result := CharInSetEx(S[Length(S)], [cTAB] + Wordbreaks); wbsFirstWordChar: Result := CharInSetEx(S[1], [cTAB] + Wordbreaks); else Result := True; end; end else Result := True; end; end; function TKMemoTextBlock.GetWordBreaks: TKSysCharSet; var Notifier: IKMemoNotifier; begin Notifier := MemoNotifier; if Notifier <> nil then Result := Notifier.GetWordBreaks else Result := cDefaultWordBreaks; end; function TKMemoTextBlock.GetWords(Index: TKMemoWordIndex): TKString; begin Result := StringCopy(Text, FWords[Index].StartIndex + 1, FWords[Index].EndIndex - FWords[Index].StartIndex + 1); end; function TKMemoTextBlock.GetWordTop(Index: TKMemoWordIndex): Integer; begin Result := FWords[Index].Position.Y; end; function TKMemoTextBlock.GetWordTopPadding(Index: TKMemoWordIndex): Integer; begin Result := FWords[Index].TopPadding; end; function TKMemoTextBlock.GetWordWidth(Index: TKMemoWordIndex): Integer; begin Result := FWords[Index].Extent.X; end; function TKMemoTextBlock.IndexToTextIndex(const AText: TKString; AIndex: Integer): Integer; begin AIndex := MinMax(AIndex, 0, ContentLength); Result := StrCPIndexToByteIndex(AText, AIndex); end; function TKMemoTextBlock.InsertString(const AText: TKString; At: TKMemoSelectionIndex): Boolean; var S, T, Part1, Part2: TKString; begin Result := False; S := Text; if At >= 0 then begin SplitText(S, At + 1, Part1, Part2); T := Part1 + AText + Part2; end else T := S + AText; if T <> S then begin Text := T; Result := True; end; end; function TKMemoTextBlock.InternalTextExtent(ACanvas: TCanvas; const AText: TKString): TSize; begin Result := TKTextBox.TextExtent(ACanvas, AText, 1, Length(AText)); end; procedure TKMemoTextBlock.InternalTextOutput(ACanvas: TCanvas; ALeft, ATop: Integer; const AText: TKString); begin TKTextBox.TextOutput(ACanvas, ALeft, ATop, AText, 1, Length(AText)); end; function TKMemoTextBlock.ModifiedTextExtent(ACanvas: TCanvas; const AText: TKString): TPoint; var Size: TSize; C, CU, SU: TKString; I, SmallFontHeight, X, Y: Integer; begin if Pos(cTab, AText) <> 0 then begin SU := UnicodeStringReplace(AText, cTab, TabChar, [rfReplaceAll]); Size := InternalTextExtent(ACanvas, SU); Result := Point(Size.cx, Size.cy); end else if FTextStyle.Capitals = tcaNone then begin Size := InternalTextExtent(ACanvas, AText); Result := Point(Size.cx, Size.cy); end else begin SU := UnicodeUpperCase(AText); if FTextStyle.Capitals = tcaNormal then begin Size := InternalTextExtent(ACanvas, SU); Result := Point(Size.cx, Size.cy); end else begin SmallFontHeight := MulDiv(FScriptFontHeight, 4, 5); X := 0; Y := 0; for I := 1 to StringLength(SU) do begin C := StringCopy(AText, I, 1); CU := StringCopy(SU, I, 1); if C <> CU then ACanvas.Font.Height := SmallFontheight else ACanvas.Font.Height := FScriptFontheight; Size := InternalTextExtent(ACanvas, CU); Inc(X, Size.cx); Y := Max(Y, Size.cy); end; Result := Point(X, Y); end; end; end; procedure TKMemoTextBlock.NotifyDefaultTextChange; begin FTextStyle.NotifyChange(GetDefaultTextStyle); end; procedure TKMemoTextBlock.NotifyOptionsChange; begin inherited; UpdateWords; end; procedure TKMemoTextBlock.NotifyPrintBegin; begin inherited; UpdateWords; // update words to take each character separately end; procedure TKMemoTextBlock.NotifyPrintEnd; begin inherited; UpdateWords; // restore words end; procedure TKMemoTextBlock.ParentChanged; begin inherited; NotifyDefaultTextChange; end; procedure TKMemoTextBlock.SetText(const Value: TKString); begin if FText <> Value then begin FText := Value; FTextLength := StringLength(Value); UpdateWords; Update([muContent]); end; end; procedure TKMemoTextBlock.SetWordBaseLine(Index: TKMemoWordIndex; const Value: Integer); begin FWords[Index].BaseLine := Value; end; procedure TKMemoTextBlock.SetWordBottomPadding(Index: TKMemoWordIndex; const Value: Integer); begin FWords[Index].BottomPadding := Value; end; procedure TKMemoTextBlock.SetWordBreakStyle(const Value: TKMemoWordBreakStyle); begin if Value <> FWordBreakStyle then begin FWordBreakStyle := Value; UpdateWords; Update([muExtent]); end; end; procedure TKMemoTextBlock.SetWordClipped(Index: TKMemoWordIndex; const Value: Boolean); begin FWords[Index].Clipped := Value; end; procedure TKMemoTextBlock.SetWordHeight(Index: TKMemoWordIndex; const Value: Integer); var P: TPoint; begin P := FWords[Index].Extent; P.Y := Value; FWords[Index].Extent := P; end; procedure TKMemoTextBlock.SetWordLeft(Index: TKMemoWordIndex; const Value: Integer); var P: TPoint; begin P := FWords[Index].Position; P.X := Value; FWords[Index].Position := P; end; procedure TKMemoTextBlock.SetWordTop(Index: TKMemoWordIndex; const Value: Integer); var P: TPoint; begin P := FWords[Index].Position; P.Y := Value; FWords[Index].Position := P; end; procedure TKMemoTextBlock.SetWordTopPadding(Index: TKMemoWordIndex; const Value: Integer); begin FWords[Index].TopPadding := Value; end; procedure TKMemoTextBlock.SetWordWidth(Index: TKMemoWordIndex; const Value: Integer); var P: TPoint; begin P := FWords[Index].Extent; P.X := Value; FWords[Index].Extent := P; end; function TKMemoTextBlock.Split(At: TKMemoSelectionIndex; AllowEmpty: Boolean): TKMemoBlock; var Block: TKMemoTextBlock; S, Part1, Part2: TKString; Cls: TKMemoBlockClass; TmpSelStart, TmpSelEnd: TKMemoSelectionIndex; begin if ((At > 0) or AllowEmpty and (At = 0)) and (At < ContentLength) then begin Cls := TKMemoBlockClass(Self.ClassType); Block := Cls.Create as TKMemoTextBlock; Block.Assign(Self); S := GetText; SplitText(S, At + 1, Part1, Part2); // split selection when necessary if SelLength > 0 then begin TmpSelStart := SelStart; TmpSelEnd := SelEnd; if TmpSelStart < At then Select(TmpSelStart, At - TmpSelStart, False) else Select(-1, 0, False); if TmpSelEnd > At then Block.Select(0, TmpSelEnd - At, False) else Block.Select(-1, 0, False) end; Text := Part1; Block.Text := Part2; Result := Block; end else Result := nil; end; class procedure TKMemoTextBlock.SplitText(const ASource: TKString; At: Integer; out APart1, APart2: TKString); begin APart1 := StringCopy(ASource, 1, At - 1); APart2 := StringCopy(ASource, At, Length(ASource) - At + 1); end; function TKMemoTextBlock.TextIndexToIndex(var AText: TKString; ATextIndex: Integer): Integer; begin if ATextIndex >= 0 then Result := StrByteIndexToCPIndex(AText, ATextIndex) else Result := -1; end; procedure TKMemoTextBlock.TextStyleChanged(Sender: TObject); begin Update([muExtent]); end; procedure TKMemoTextBlock.UpdateWords; procedure AddWord(AStart, AEnd: TKMemoSelectionIndex); var Word: TKMemoWord; begin if WordCount < FWords.Count then begin Word := FWords[TKMemoWordIndex(WordCount)]; Word.Clear; end else begin Word := TKMemoWord.Create; FWords.Add(Word); end; Word.StartIndex := AStart - 1; Word.EndIndex := AEnd - 1; Inc(FWordCount); end; var Index, PrevIndex, CharIndex: Integer; WasBreak, IsTab, WasTab, SingleChars: Boolean; begin FWordCount := 0; if FText <> '' then begin CharIndex := 1; Index := 1; PrevIndex := 1; IsTab := False; WasBreak := False; SingleChars := SingleCharWords; while Index <= FTextLength do begin if SingleChars then AddWord(Index, Index) else begin if CharInSetEx(FText[CharIndex], WordBreaks) then WasBreak := True else begin WasTab := IsTab; IsTab := CharInSetEx(FText[CharIndex], [cTab]); if WasBreak or (WasTab and not IsTab) or (IsTab and not WasTab) then begin AddWord(PrevIndex, Index - 1); PrevIndex := Index; WasBreak := False; end; end; end; Inc(Index); CharIndex := StrNextCharIndex(FText, CharIndex); end; if not SingleChars and (Index > PrevIndex) then AddWord(PrevIndex, Index - 1); end; if SelLength <> 0 then begin FSelStart := MinMax(FSelStart, 0, SelectableLength); FSelEnd := MinMax(FSelEnd, 0, SelectableLength); if FSelStart = FSelEnd then begin // unselect... FSelStart := -1; FSelEnd := -1; end; end; end; function TKMemoTextBlock.WordIndexToRect(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AIndex: TKMemoSelectionIndex; ACaret: Boolean): TRect; var BaseLine, Y, DY: Integer; AppliedText, S, T: TKString; Ofs, Size: TPoint; Word: TKMemoWord; begin Word := FWords[AWordIndex]; if (AIndex >= 0) and (AIndex <= WordLength[AWordIndex]) then begin AppliedText := ApplyFormatting(FText); S := StringCopy(AppliedText, Word.StartIndex + 1, AIndex); T := StringCopy(AppliedText, Word.StartIndex + AIndex + 1, 1); ApplyTextStyle(ACanvas); with ACanvas do begin Ofs := ModifiedTextExtent(ACanvas, S); Size := ModifiedTextExtent(ACanvas, T); end; if ACaret then begin BaseLine := GetFontAscent(ACanvas.Handle); Y := Word.Position.Y + Word.TopPadding + Word.BaseLine - BaseLine - FScriptVertOffset; DY := Size.Y; end else begin Y := Word.Position.Y; DY := Word.Extent.Y; end; Result := Rect(Word.Position.X + Ofs.X, Y, Word.Position.X + Ofs.X + Size.X, Y + DY); end else Result := CreateEmptyRect; end; function TKMemoTextBlock.WordMeasureExtent(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ARequiredWidth: Integer): TPoint; var AppliedText: TKString; begin AppliedText := ApplyFormatting(Words[AWordIndex]); with ACanvas do begin ApplyTextStyle(ACanvas); FWords[AWordIndex].Extent := ModifiedTextExtent(ACanvas, AppliedText); Result := FWords[AWordIndex].Extent; end; end; function TKMemoTextBlock.WordMouseAction(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AAction: TKMemoMouseAction; const APoint: TPoint; AShift: TShiftState): Boolean; var R, R1, R2: TRect; Word: TKMemoWord; Notifier: IKMemoNotifier; begin Result := inherited WordMouseAction(ACanvas, AWordIndex, AAction, APoint, AShift); if not Result then begin Word := FWords[AWordIndex]; if (SelLength > 0) and (SelStart <= Word.EndIndex) and (SelEnd > Word.StartIndex) then begin Notifier := MemoNotifier; if Notifier <> nil then begin case AAction of maMove: begin R1 := WordIndexToRect(ACanvas, AWordIndex, Max(SelStart, Word.StartIndex) - Word.StartIndex, False); R2 := WordIndexToRect(ACanvas, AWordIndex, Min(SelEnd - 1, Word.EndIndex) - Word.StartIndex, False); UnionRect(R, R1, R2); if PtInRect(R, APoint) then begin Notifier.SetReqMouseCursor(crDefault); Result := True; end; end; end; end; end; end; end; procedure TKMemoTextBlock.WordPaintToCanvas(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ALeft, ATop: Integer); function AdjustBaseLine(ABaseLine: Integer): Integer; begin Dec(ABaseline, GetFontAscent(ACanvas.Handle) + FScriptVertOffset); Result := ABaseLine; end; procedure TextDraw(const ARect: TRect; ABaseLine: Integer; const AText: TKString); var C, CU, SU: TKString; AdjBaseLine, I, SmallFontHeight, X: Integer; Size: TSize; begin with ACanvas do begin if Brush.Style <> bsClear then DrawFilledRectangle(ACanvas, ARect, clNone); SetBkMode(Handle, TRANSPARENT); AdjBaseLine := AdjustBaseLine(ABaseLine); // align to baseline if (Pos(cTab, AText) <> 0) and ShowFormatting then begin SU := UnicodeStringReplace(AText, cTab, TabChar, [rfReplaceAll]); InternalTextOutput(ACanvas, ARect.Left, AdjBaseLine, SU); end else if FTextStyle.Capitals = tcaNone then begin InternalTextOutput(ACanvas, ARect.Left, AdjBaseLine, AText); end else begin SU := UnicodeUpperCase(AText); if FTextStyle.Capitals = tcaNormal then InternalTextOutput(ACanvas, ARect.Left, AdjBaseLine, SU) else begin SmallFontHeight := MulDiv(FScriptFontHeight, 4, 5); X := ARect.Left; for I := 1 to StringLength(SU) do begin C := StringCopy(AText, I, 1); CU := StringCopy(SU, I, 1); if C <> CU then Font.Height := SmallFontHeight else Font.Height := FScriptFontHeight; AdjBaseLine := AdjustBaseLine(ABaseLine); InternalTextOutput(ACanvas, X, AdjBaseLine, CU); Size := InternalTextExtent(ACanvas, CU); Inc(X, Size.cx); end; end; end; end; end; var W, X, Y, BaseLine: Integer; AppliedText, S, Part1, Part2, Part3: TKString; R, RClip: TRect; Word: TKMemoWord; Color, Bkgnd: TColor; PrevRgn: HRGN; begin with ACanvas do begin ApplyTextStyle(ACanvas); AppliedText := ApplyFormatting(Words[AWordIndex]); Word := FWords[AWordIndex]; X := Word.Position.X + ALeft + RealLeftOffset; Y := Word.Position.Y + ATop + RealTopOffset; BaseLine := Y + Word.TopPadding; if Position = mbpText then Inc(BaseLine, Word.BaseLine) else Inc(BaseLine, Word.Extent.Y); if PaintSelection and (FSelEnd > FSelStart) and (Word.EndIndex >= FSelStart) and (Word.StartIndex < FSelEnd) then begin GetSelColors(Color, BkGnd); if FSelStart > Word.StartIndex then begin W := FSelStart - Word.StartIndex; SplitText(AppliedText, W + 1, Part1, S); end else begin W := 0; S := AppliedText; end; SplitText(S, FSelEnd - Word.StartIndex - W + 1, Part2, Part3); if Part1 <> '' then begin W := ModifiedTextExtent(ACanvas, Part1).X; R := Rect(X, Y + Word.TopPadding, X + W, Y + Word.Extent.Y - Word.BottomPadding); TextDraw(R, BaseLine, Part1); Inc(X, W); end; if Part2 <> '' then begin Brush.Style := bsSolid; Brush.Color := Bkgnd; Font.Color := Color; W := ModifiedTextExtent(ACanvas, Part2).X; R := Rect(X, Y, X + W, Y + Word.Extent.Y); TextDraw(R, BaseLine, Part2); Inc(X, W); end; if Part3 <> '' then begin ApplyTextStyle(ACanvas); W := ModifiedTextExtent(ACanvas, Part3).X; R := Rect(X, Y + Word.TopPadding, X + W, Y + Word.Extent.Y - Word.BottomPadding); TextDraw(R, BaseLine, Part3); end; end else begin R := Rect(X, Y + Word.TopPadding, X + Word.Extent.X, Y + Word.Extent.Y - Word.BottomPadding); if FWords[AWordIndex].Clipped then begin RClip := R; TranslateRectToDevice(ACanvas.Handle, RClip); PrevRgn := RgnCreateAndGet(ACanvas.Handle); try if ExtSelectClipRect(ACanvas.Handle, RClip, RGN_AND, PrevRgn) then TextDraw(R, BaseLine, AppliedText); finally RgnSelectAndDelete(ACanvas.Handle, PrevRgn); end; ACanvas.Refresh; end else TextDraw(R, BaseLine, AppliedText); end; end; end; function TKMemoTextBlock.WordPointToIndex(ACanvas: TCanvas; const APoint: TPoint; AWordIndex: TKMemoWordIndex; AOutOfArea, ASelectionExpanding: Boolean; out APosition: TKMemoLinePosition): TKMemoSelectionIndex; var I: TKMemoSelectionIndex; WPos: Integer; AppliedText, S: TKString; Size: TPoint; R: TRect; Word: TKMemoWord; begin Result := -1; Word := FWords[AWordIndex]; R := Rect(Word.Position.X, Word.Position.Y, Word.Position.X + Word.Extent.X, Word.Position.Y + Word.Extent.Y); with ACanvas do begin if PtInRect(R, APoint) or (AOutOfArea and (APoint.X >= R.Left) and (APoint.X < R.Right)) then begin ApplyTextStyle(ACanvas); AppliedText := ApplyFormatting(FText); WPos := Word.Position.X; for I := Word.StartIndex to Word.EndIndex do begin S := StringCopy(AppliedText, I + 1, 1); Size := ModifiedTextExtent(ACanvas, S); R := Rect(WPos, Word.Position.Y, WPos + Size.X, Word.Position.Y + Word.Extent.Y); if PtInRect(R, APoint) or (AOutOfArea and (APoint.X >= R.Left) and (APoint.X < R.Right)) then begin Result := I - Word.StartIndex; Break; end; Inc(WPos, Size.X); end; end; end; end; { TKMemoHyperlink } constructor TKMemoHyperlink.Create; begin inherited; FURL := ''; DefaultStyle; end; procedure TKMemoHyperlink.Assign(ASource: TKObject); begin inherited; if ASource is TKMemoHyperlink then begin FURL := TKMemoHyperlink(ASource).URL; end; end; function TKMemoHyperlink.Click: Boolean; begin Result:=inherited Click; if not Result and (FURL <> '') then begin if (ssCtrl in GetShiftState) or ReadOnly then begin OpenURLWithShell(FURL); Result := True; end; end; end; procedure TKMemoHyperlink.DefaultStyle; begin FTextStyle.Font.Color := clBlue; FTextStyle.Font.Style := FTextStyle.Font.Style + [fsUnderline]; end; function TKMemoHyperlink.WordMouseAction(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AAction: TKMemoMouseAction; const APoint: TPoint; AShift: TShiftState): Boolean; var R: TRect; Notifier: IKMemoNotifier; begin Result := inherited WordMouseAction(ACanvas, AWordIndex, AAction, APoint, AShift); if not Result then begin R := WordRect[AWordIndex]; if PtInRect(R, APoint) then begin case AAction of maMove: begin Notifier := MemoNotifier; if Notifier <> nil then begin if (ssCtrl in AShift) or ReadOnly then Notifier.SetReqMouseCursor(crHandPoint); Result := True; end; end; end; end; end; end; { TKParagraph } constructor TKMemoParagraph.Create; begin inherited; FExtent := CreateEmptyPoint; FTextStyle.Changeable := False; try FTextStyle.AllowBrush := False; finally FTextStyle.Changeable := True; end; FNumberBlock := nil; FParaStyle := TKMemoParaStyle.Create; FParaStyle.OnChanged := ParaStyleChanged; FOrigin := CreateEmptyPoint; Text := NewLineChar; end; destructor TKMemoParagraph.Destroy; begin FNumberBlock.Free; FParaStyle.Free; inherited; end; procedure TKMemoParagraph.AssignAttributes(ABlock: TKMemoBlock); begin inherited; if ABlock is TKMemoParagraph then FParaStyle.Assign(TKMemoParagraph(ABlock).ParaStyle); end; procedure TKMemoParagraph.ParaStyleChanged(Sender: TObject; AReasons: TKMemoUpdateReasons); begin Update(AReasons); end; function TKMemoParagraph.Concat(ABlock: TKMemoBlock): Boolean; begin Result := False; end; function TKMemoParagraph.GetCanAddText: Boolean; begin Result := False; end; function TKMemoParagraph.GetNumberBlock: TKMemoTextBlock; var ListTable: TKMemoListTable; Notifier: IKMemoNotifier; begin Notifier := MemoNotifier; if Notifier <> nil then begin ListTable := Notifier.GetListTable; if ListTable.FindByID(FParaStyle.NumberingList) <> nil then begin if FNumberBlock = nil then begin FNumberBlock := TKMemoTextBlock.Create; FNumberBlock.Parent := Parent; // because of FMemoNotifier end; end else FreeAndNil(FNumberBlock); end else FreeAndNil(FNumberBlock); Result := FNumberBlock; end; function TKMemoParagraph.GetNumbering: TKMemoParaNumbering; var ListLevel: TKMemoListLevel; begin ListLevel := GetNumberingListLevel; if ListLevel <> nil then Result := ListLevel.Numbering else Result := pnuNone; end; function TKMemoParagraph.GetNumberingList: TKMemoList; var ListTable: TKMemoListTable; Notifier: IKMemoNotifier; begin Result := nil; if FParaStyle.NumberingList <> cInvalidListID then begin Notifier := MemoNotifier; if Notifier <> nil then begin ListTable := Notifier.GetListTable; Result := ListTable.FindByID(FParaStyle.NumberingList); end; end; end; function TKMemoParagraph.GetNumberingListLevel: TKMemoListLevel; var List: TKMemoList; begin List := GetNumberingList; if List <> nil then Result := List.Levels[FParaStyle.NumberingListLevel] else Result := nil; end; function TKMemoParagraph.GetParaStyle: TKMemoParaStyle; begin Result := FParaStyle; end; function TKMemoParagraph.GetWordBreakable(Index: TKMemoWordIndex): Boolean; begin Result := True; end; procedure TKMemoParagraph.NotifyDefaultParaChange; begin FParaStyle.NotifyChange(GetDefaultParaStyle); end; procedure TKMemoParagraph.SetNumbering(const Value: TKMemoParaNumbering); var List: TKMemoList; ListLevel: TKMemoListLevel; ListTable: TKMemoListTable; Notifier: IKMemoNotifier; LevelIndex: Integer; begin if Value <> GetNumbering then begin // here we try to set best numbering match from list table Notifier := MemoNotifier; if Notifier <> nil then begin ListTable := Notifier.GetListTable; LevelIndex := Max(FParaStyle.NumberingListLevel, 0); List := ListTable.ListByNumbering(FParaStyle.FNumberingList, LevelIndex, Value); if (List <> nil) and (LevelIndex < List.Levels.Count) then begin FParaStyle.NumberingList := List.ID; FParaStyle.NumberStartAt := 0; ListLevel := List.Levels[LevelIndex]; FParaStyle.FirstIndent := ListLevel.FirstIndent; FParaStyle.LeftPadding := ListLevel.LeftIndent; end else begin FParaStyle.NumberingList := cInvalidListID; end; end; end; end; function TKMemoParagraph.Split(At: TKMemoSelectionIndex; AllowEmpty: Boolean): TKMemoBlock; begin Result := nil; end; procedure TKMemoParagraph.WordPaintToCanvas(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ALeft, ATop: Integer); begin inherited; end; { TKImageMemoBlock } constructor TKMemoImageBlock.Create; begin inherited; FBaseLine := 0; FWordBottomPadding := 0; FCreatingCroppedImage := False; FCrop := TKRect.Create; FCrop.OnChanged := CropChanged; FCalcBaseLine := 0; FExtent := CreateEmptyPoint; FImage := nil; FImageStyle := TKMemoBlockStyle.Create; FImageStyle.ContentMargin.All := 5; FImageStyle.OnChanged := ImageStyleChanged; FMouseCapture := False; FExplicitExtent := CreateEmptyPoint; FOrigin := CreateEmptyPoint; FResizable := True; FScale := Point(100, 100); FCroppedImage := nil; FWordTopPadding := 0; end; destructor TKMemoImageBlock.Destroy; begin FCrop.Free; FImageStyle.Free; FImage.Free; FCroppedImage.Free; inherited; end; procedure TKMemoImageBlock.Assign(ASource: TKObject); begin inherited; if ASource is TKMemoImageBlock then AssignImage(TKMemoImageBlock(ASource).Image); end; procedure TKMemoImageBlock.AssignAttributes(ABlock: TKMemoBlock); begin inherited; if ABlock is TKMemoImageBlock then begin LockUpdate; try Crop.Assign(TKMemoImageBlock(ABlock).Crop); ImageStyle.Assign(TKMemoImageBlock(ABlock).ImageStyle); ExplicitWidth := TKMemoImageBlock(ABlock).ExplicitWidth; ExplicitHeight := TKMemoImageBlock(ABlock).ExplicitHeight; Resizable := TKMemoImageBlock(ABlock).Resizable; ScaleX := TKMemoImageBlock(ABlock).ScaleX; ScaleY := TKMemoImageBlock(ABlock).ScaleY; finally UnlockUpdate; end; end; end; procedure TKMemoImageBlock.AssignImage(ASource: TGraphic); var MS: TMemoryStream; begin FreeAndNil(FImage); if ASource <> nil then begin FImage := TGraphicClass(ASource.ClassType).Create; FImage.OnChange := ImageChanged; //FImage.Assign(ASource); does not work well in all cases so use slower workaround: MS := TMemoryStream.Create; try ASource.SaveToStream(MS); MS.Seek(0, soFromBeginning); Image.LoadFromStream(MS); finally MS.Free; end; end; end; function TKMemoImageBlock.CalcAscent(ACanvas: TCanvas): Integer; var Block: TKMemoBlock; BlockIndex: TKMemoBlockIndex; Ascent, Descent: Integer; begin if (Parent <> nil) and (Position = mbpText) then begin Result := FExtent.Y div 2; BlockIndex := ParentBlocks.IndexOf(Self); if BlockIndex >= 0 then begin Block := ParentBlocks.GetLastBlockByClass(BlockIndex, TKMemoTextBlock); if Block = nil then Block := ParentBlocks.GetNextBlockByClass(BlockIndex, TKMemoTextBlock); if Block <> nil then begin Ascent := TKMemoTextBlock(Block).CalcAscent(ACanvas); Descent := TKMemoTextBlock(Block).CalcDescent(ACanvas); Result := (FExtent.Y - (Ascent + Descent)) div 2 + Ascent; end else begin Block := ParentBlocks.GetNearestParagraphBlock(BlockIndex); if Block <> nil then begin Descent := TKMemoTextBlock(Block).CalcDescent(ACanvas); Result := FExtent.Y - Descent; end; end; end; end else Result := 0; FCalcBaseLine := Result; end; function TKMemoImageBlock.ContentLength: TKMemoSelectionIndex; begin Result := 1; end; function TKMemoImageBlock.GetWrapMode: TKMemoBlockWrapMode; begin Result := FImageStyle.WrapMode; end; function TKMemoImageBlock.GetImageHeight: Integer; begin if FScale.Y <> 0 then Result := ScaleHeight else if FImage <> nil then Result := FImage.Height else Result := 0; Dec(Result, FCrop.Top + FCrop.Bottom); end; function TKMemoImageBlock.GetImageWidth: Integer; begin if FScale.X <> 0 then Result := ScaleWidth else if FImage <> nil then Result := FImage.Width else Result := 0; Dec(Result, FCrop.Left + FCrop.Right); end; function TKMemoImageBlock.GetLogScaleX: Integer; begin if ImageDPIX <> 0 then Result := MulDiv(ScaleX, ImageDPIX, PixelsPerInchX) else Result := ScaleX; end; function TKMemoImageBlock.GetLogScaleY: Integer; begin if ImageDPIY <> 0 then Result := MulDiv(ScaleY, ImageDPIY, PixelsPerInchY) else Result := ScaleY; end; function TKMemoImageBlock.GetNativeOrExplicitHeight: Integer; begin if FExplicitExtent.Y <> 0 then Result := FExplicitExtent.Y else if FImage <> nil then Result := FImage.Height else Result := 0; end; function TKMemoImageBlock.GetNativeOrExplicitWidth: Integer; begin if FExplicitExtent.X <> 0 then Result := FExplicitExtent.X else if FImage <> nil then Result := FImage.Width else Result := 0; end; function TKMemoImageBlock.GetResizable: Boolean; begin Result := FResizable; end; function TKMemoImageBlock.GetScaleHeight: Integer; begin Result := MulDiv(NativeOrExplicitHeight, FScale.Y, 100); end; function TKMemoImageBlock.GetScaleWidth: Integer; begin Result := MulDiv(NativeOrExplicitWidth, FScale.X, 100); end; function TKMemoImageBlock.GetSizingRect: TRect; var ROuter: TRect; begin // Result := inherited GetSizingRect; ROuter := OuterRect(False); CroppedImage; Result := FScaledRect; KFunctions.OffsetRect(Result, ROuter.Left + FImageStyle.AllPaddingsLeft, ROuter.Top + FImageStyle.AllPaddingsTop + FWordTopPadding + FBaseLine - FCalcBaseLine); end; function TKMemoImageBlock.GetWordBottomPadding(Index: TKMemoWordIndex): Integer; begin Result := FWordBottomPadding; end; function TKMemoImageBlock.GetWordBoundsRect(Index: TKMemoWordIndex): TRect; begin Result.TopLeft := CreateEmptyPoint; Result.BottomRight := FExtent; KFunctions.OffsetRect(Result, FOrigin); end; function TKMemoImageBlock.GetWordCount: Integer; begin Result := 1; end; function TKMemoImageBlock.GetWordHeight(Index: TKMemoWordIndex): Integer; begin Result := FExtent.Y; end; function TKMemoImageBlock.GetWordLeft(Index: TKMemoWordIndex): Integer; begin Result := FOrigin.X; end; function TKMemoImageBlock.GetWordLength(Index: TKMemoWordIndex): TKMemoSelectionIndex; begin Result := 1; end; function TKMemoImageBlock.GetWords(Index: TKMemoWordIndex): TKString; begin Result := ''; end; function TKMemoImageBlock.GetWordTop(Index: TKMemoWordIndex): Integer; begin Result := FOrigin.Y; end; function TKMemoImageBlock.GetWordTopPadding(Index: TKMemoWordIndex): Integer; begin Result := FWordTopPadding; end; function TKMemoImageBlock.GetWordWidth(Index: TKMemoWordIndex): Integer; begin Result := FExtent.X; end; procedure TKMemoImageBlock.ImageChanged(Sender: TObject); begin if not FCreatingCroppedImage then begin FreeAndNil(FCroppedImage); FImageDPI := GetImageDPI(FImage); Update([muContent]); end; end; procedure TKMemoImageBlock.ImageStyleChanged(Sender: TObject; AReasons: TKMemoUpdateReasons); begin Update(AReasons); end; procedure TKMemoImageBlock.LoadFromFile(const APath: string); var Picture: TPicture; begin Picture := TPicture.Create; try Picture.LoadFromFile(APath); AssignImage(Picture.Graphic); finally Picture.Free; end; FreeAndNil(FCroppedImage); Update([muContent]); end; function TKMemoImageBlock.OuterRect(ACaret: Boolean): TRect; begin Result.TopLeft := FOrigin; Result.Right := Result.Left + FExtent.X; Result.Bottom := Result.Top + FExtent.Y; if ACaret then begin Inc(Result.Top, FWordTopPadding); Dec(Result.Bottom, FWordBottomPadding); end; KFunctions.OffsetRect(Result, RealLeftOffset, RealTopOffset); end; procedure TKMemoImageBlock.Resize(ANewWidth, ANewHeight: Integer); begin ScaleWidth := ANewWidth + FCrop.Left + FCrop.Right; ScaleHeight := ANewHeight + FCrop.Top + FCrop.Bottom; end; procedure TKMemoImageBlock.CropChanged(Sender: TObject); begin FreeAndNil(FCroppedImage); Update([muExtent]); end; function TKMemoImageBlock.CroppedImage: TKAlphaBitmap; var ExtentX, ExtentY: Integer; RatioX, RatioY: Double; OrigCrop: TRect; begin if (FCroppedImage = nil) and (FImage <> nil) and not FCreatingCroppedImage then begin FCreatingCroppedImage := True; try // get scaled image only on demand ExtentX := ScaleWidth; if ExtentX = 0 then ExtentX := FImage.Width; ExtentY := ScaleHeight; if ExtentY = 0 then ExtentY := FImage.Height; RatioX := ExtentX / FImage.Width; RatioY := ExtentY / FImage.Height; // crop in original units OrigCrop := Rect(Round(FCrop.Left / RatioX), Round(FCrop.Top / RatioY), Round(FCrop.Right / RatioX), Round(FCrop.Bottom / RatioY)); Dec(ExtentX, FCrop.Left + FCrop.Right); Dec(ExtentY, FCrop.Top + FCrop.Bottom); FScaledRect := Rect(0, 0, ExtentX, ExtentY); if (ExtentX * ExtentY <> 0) and (FImage.Width * FImage.Height <> 0) then begin FCroppedImage := TKAlphaBitmap.Create; FCroppedImage.SetSize(FImage.Width - OrigCrop.Left - OrigCrop.Right, FImage.Height - OrigCrop.Top - OrigCrop.Bottom); FCroppedImage.CopyFromXY(-OrigCrop.Left, -OrigCrop.Top, FImage); end; finally FCreatingCroppedImage := False; end; end; Result := FCroppedImage; end; procedure TKMemoImageBlock.SetCrop(const Value: TKRect); begin FCrop.Assign(Value); end; procedure TKMemoImageBlock.SetImage(const Value: TGraphic); begin AssignImage(Value); FreeAndNil(FCroppedImage); Update([muContent]); end; procedure TKMemoImageBlock.SetLogScaleX(const Value: Integer); begin if ImageDPIX <> 0 then ScaleX := MulDiv(Value, PixelsPerInchX, ImageDPIX) else ScaleX := Value; end; procedure TKMemoImageBlock.SetLogScaleY(const Value: Integer); begin if ImageDPIY <> 0 then ScaleY := MulDiv(Value, PixelsPerInchY, ImageDPIY) else ScaleY := Value; end; procedure TKMemoImageBlock.SetResizable(const Value: Boolean); begin if Value <> FResizable then begin FResizable := Value; Update([muExtent]); end; end; procedure TKMemoImageBlock.SetExplicitHeight(const Value: Integer); begin if Value <> FExplicitExtent.Y then begin FExplicitExtent.Y := Value; FreeAndNil(FCroppedImage); Update([muContent]); end; end; procedure TKMemoImageBlock.SetExplicitWidth(const Value: Integer); begin if Value <> FExplicitExtent.X then begin FExplicitExtent.X := Value; FreeAndNil(FCroppedImage); Update([muContent]); end; end; procedure TKMemoImageBlock.SetScaleHeight(const Value: Integer); begin if Value <> ScaleHeight then begin FScale.Y := MulDiv(Value, 100, NativeOrExplicitHeight); FreeAndNil(FCroppedImage); Update([muExtent]); end; end; procedure TKMemoImageBlock.SetScaleWidth(const Value: Integer); begin if Value <> ScaleWidth then begin FScale.X := MulDiv(Value, 100, NativeOrExplicitWidth); FreeAndNil(FCroppedImage); Update([muExtent]); end; end; procedure TKMemoImageBlock.SetScaleX(const Value: Integer); begin if Value <> FScale.X then begin FScale.X := Value; FreeAndNil(FCroppedImage); Update([muExtent]); end; end; procedure TKMemoImageBlock.SetScaleY(const Value: Integer); begin if Value <> FScale.Y then begin FScale.Y := Value; FreeAndNil(FCroppedImage); Update([muExtent]); end; end; procedure TKMemoImageBlock.SetWordBaseLine(Index: TKMemoWordIndex; const Value: Integer); begin FBaseLine := Value; end; procedure TKMemoImageBlock.SetWordBottomPadding(Index: TKMemoWordIndex; const Value: Integer); begin FWordBottomPadding := Value; end; procedure TKMemoImageBlock.SetWordHeight(Index: TKMemoWordIndex; const Value: Integer); begin FExtent.Y := Value; end; procedure TKMemoImageBlock.SetWordLeft(Index: TKMemoWordIndex; const Value: Integer); begin FOrigin.X := Value; end; procedure TKMemoImageBlock.SetWordTop(Index: TKMemoWordIndex; const Value: Integer); begin FOrigin.Y := Value; end; procedure TKMemoImageBlock.SetWordTopPadding(Index: TKMemoWordIndex; const Value: Integer); begin FWordTopPadding := Value; end; function TKMemoImageBlock.WordIndexToRect(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AIndex: TKMemoSelectionIndex; ACaret: Boolean): TRect; begin Result := OuterRect(ACaret); end; function TKMemoImageBlock.WordMeasureExtent(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ARequiredWidth: Integer): TPoint; begin FreeAndNil(FCroppedImage); Result := Point( ImageWidth + FImageStyle.AllPaddingsLeft + FImageStyle.AllPaddingsRight, ImageHeight + FImageStyle.AllPaddingsTop + FImageStyle.AllPaddingsBottom); FExtent := Result; end; function TKMemoImageBlock.WordMouseAction(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AAction: TKMemoMouseAction; const APoint: TPoint; AShift: TShiftState): Boolean; var R: TRect; Notifier: IKMemoNotifier; Cursor: TCursor; begin Result := False; R := GetSizingRect; if PtInRect(R, APoint) then begin Result := inherited WordMouseAction(ACanvas, AWordIndex, AAction, APoint, AShift); if not Result then begin Notifier := MemoNotifier; if Notifier <> nil then begin case AAction of maMove: begin if ReadOnly then Cursor := crDefault else begin if SelLength > 0 then begin Cursor := SizingGripsCursor(R, APoint); if Cursor = crDefault then Cursor := crSizeAll; end else Cursor := crSizeAll; if (Position = mbpText) and (Cursor = crSizeAll) then Cursor := crDefault; end; Notifier.SetReqMouseCursor(Cursor); Result := True; end; maLeftDown: begin if ssDouble in AShift then Notifier.EditBlock(Self) else Notifier.SelectBlock(Self, SizingGripsPosition(R, APoint)); Result := True; end; maRightDown: begin Result := Notifier.SelectBlock(Self, sgpNone); end; end; end; end; end; end; procedure TKMemoImageBlock.WordPaintToCanvas(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ALeft, ATop: Integer); var X, Y: Integer; R: TRect; ROuter: TRect; Bitmap: TKAlphaBitmap; Color, Bkgnd: TColor; begin inherited; ROuter := OuterRect(False); KFunctions.OffsetRect(ROuter, ALeft, ATop); X := ROuter.Left + FImageStyle.AllPaddingsLeft; Y := ROuter.Top + FImageStyle.AllPaddingsTop + FWordTopPadding + FBaseLine - FCalcBaseLine; CroppedImage; R := FScaledRect; KFunctions.OffsetRect(R, X, Y); ROuter := ImageStyle.MarginRect(ROuter); if PaintSelection and (SelLength > 0) then begin GetSelColors(Color, BkGnd); ACanvas.Brush.Color := BkGnd; ACanvas.FillRect(ROuter); if FCroppedImage <> nil then begin Bitmap := TKAlphaBitmap.Create; try Bitmap.CopyFromAlphaBitmap(FCroppedImage); Bitmap.AlphaFillPercent(50, False); ACanvas.StretchDraw(R, Bitmap); if not ReadOnly and (SelectedBlock = Self) then SizingGripsDraw(ACanvas, R); finally Bitmap.Free; end; end; end else begin FImageStyle.PaintBox(ACanvas, ROuter); if FCroppedImage <> nil then ACanvas.StretchDraw(R, FCroppedImage); end; end; function TKMemoImageBlock.WordPointToIndex(ACanvas: TCanvas; const APoint: TPoint; AWordIndex: TKMemoWordIndex; AOutOfArea, ASelectionExpanding: Boolean; out APosition: TKMemoLinePosition): TKMemoSelectionIndex; begin if PtInRect(OuterRect(False), APoint) then Result := 0 else Result := -1; end; { TKMemoContainer } constructor TKMemoContainer.Create; begin inherited; FBlocks := TKMemoBlocks.Create; FBlocks.Parent := Self; FBlocks.OnUpdate := Update; FBlockStyle := TKMemoBlockStyle.Create; FBlockStyle.OnChanged := BlockStyleChanged; FWordBottomPadding := 0; FClip := False; FCurrentRequiredHeight := 0; FCurrentRequiredWidth := 0; FFixedHeight := False; FFixedWidth := False; FOrigin := CreateEmptyPoint; FRequiredHeight := 0; FRequiredWidth := 0; FResizable := True; FWordTopPadding := 0; end; destructor TKMemoContainer.Destroy; begin FBlocks.Free; FBlockStyle.Free; inherited; end; function TKMemoContainer.AddRectOffset(const ARect: TRect): TRect; begin Result := ARect; KFunctions.OffsetRect(Result, Left + RealLeftOffset + FBlockStyle.AllPaddingsLeft, Top + RealTopOffset + FBlockStyle.AllPaddingsTop + FWordTopPadding); end; procedure TKMemoContainer.AddSingleLine; var Line: TKMemoLine; begin if Position = mbpText then begin FBlocks.Lines.Clear; if FBlocks.Count > 0 then begin Line := TKMemoLine.Create; Line.StartBlock := 0; Line.StartWord := 0; Line.StartIndex := 0; Line.EndBlock := FBlocks.Count - 1; Line.EndWord := 0; Line.EndIndex := FBlocks.SelectableLength - 1; Line.Position := Point(0, 0); Line.Extent := Point(Width, Height); FBlocks.Lines.Add(Line); end; end; end; procedure TKMemoContainer.Assign(ASource: TKObject); begin inherited; if ASource is TKMemoContainer then begin LockUpdate; try Blocks.Assign(TKMemoContainer(ASource).Blocks); finally UnlockUpdate; end; end; end; procedure TKMemoContainer.AssignAttributes(ABlock: TKMemoBlock); begin inherited; if ABlock is TKMemoContainer then begin LockUpdate; try BlockStyle.Assign(TKMemoContainer(ABlock).BlockStyle); Clip := TKMemoContainer(ABlock).Clip; FixedWidth := TKMemoContainer(ABlock).FixedWidth; FixedHeight := TKMemoContainer(ABlock).FixedHeight; RequiredWidth := TKMemoContainer(ABlock).RequiredWidth; RequiredHeight := TKMemoContainer(ABlock).RequiredHeight; Resizable := TKMemoContainer(ABlock).Resizable; finally UnlockUpdate; end; end; end; procedure TKMemoContainer.AddBlockLine(AStartBlock, AStartIndex, AEndBlock, AEndIndex, ALeft, ATop, AWidth, AHeight: Integer); var Line: TKMemoLine; begin if Position = mbpText then begin if AEndBlock >= AStartBlock then begin Line := TKMemoLine.Create; Line.StartBlock := AStartBlock; Line.StartWord := 0; Line.StartIndex := AStartIndex; Line.EndBlock := AEndBlock; Line.EndWord := 0; Line.EndIndex := AEndIndex; Line.Position := Point(ALeft, ATop); Line.Extent := Point(AWidth, AHeight); FBlocks.Lines.Add(Line); end; end; end; procedure TKMemoContainer.BlockStyleChanged(Sender: TObject; AReasons: TKMemoUpdateReasons); begin Update(AReasons); end; function TKMemoContainer.CalcAscent(ACanvas: TCanvas): Integer; var PA: TKMemoParagraph; ParaDescent: Integer; begin Result := 0; if (Parent <> nil) and (Position = mbpText) then begin PA := ParentBlocks.GetNearestParagraphBlock(ParentBlocks.IndexOf(Self)); if PA <> nil then begin ParaDescent := PA.CalcDescent(ACanvas); Result := FBlocks.Height - ParaDescent; end; end; end; function TKMemoContainer.CanAdd(ABlock: TKMemoBlock): Boolean; begin // generic container cannot accept some kinds of subblocks Result := not ( (ABlock is TKMemoTableRow) or (ABlock is TKMemoTableCell) ); end; procedure TKMemoContainer.ClearLines; begin FBlocks.Lines.Clear; end; procedure TKMemoContainer.ClearSelection(ATextOnly: Boolean); begin FBlocks.ClearSelection(ATextOnly); end; function TKMemoContainer.ContentLength: TKMemoSelectionIndex; begin Result := FBlocks.SelectableLength; end; procedure TKMemoContainer.FixedHeightChanged; begin end; procedure TKMemoContainer.FixedWidthChanged; begin end; function TKMemoContainer.GetBottomPadding: Integer; begin Result := FBlockStyle.BottomPadding; end; function TKMemoContainer.GetCanAddText: Boolean; begin Result := True; end; function TKMemoContainer.GetResizable: Boolean; begin Result := FResizable; end; function TKMemoContainer.GetWrapMode: TKMemoBlockWrapMode; begin Result := FBlockStyle.WrapMode; end; function TKMemoContainer.GetSelLength: TKMemoSelectionIndex; begin Result := FBlocks.SelLength; end; function TKMemoContainer.GetSelStart: TKMemoSelectionIndex; begin Result := FBlocks.SelStart; end; function TKMemoContainer.GetSelText: TKString; begin Result := FBlocks.SelText; end; function TKMemoContainer.GetText: TKString; begin Result := FBlocks.Text; end; function TKMemoContainer.GetTopPadding: Integer; begin Result := FBlockStyle.TopPadding; end; function TKMemoContainer.GetTotalLineCount: Integer; begin Result := FBlocks.TotalLineCount; end; function TKMemoContainer.GetTotalLineRect(Index: TKMemoTotalLineIndex): TRect; begin Result := AddRectOffset(FBlocks.TotalLineRect[Index]); end; function TKMemoContainer.GetWordBottomPadding(Index: TKMemoWordIndex): Integer; begin Result := FWordBottomPadding; end; function TKMemoContainer.GetWordBoundsRect(Index: TKMemoWordIndex): TRect; begin Result := Rect(0, 0, Width, Height); KFunctions.OffsetRect(Result, FOrigin); end; function TKMemoContainer.GetWordCount: Integer; begin Result := 1; end; function TKMemoContainer.GetWordHeight(Index: TKMemoWordIndex): Integer; begin if FFixedHeight and (FRequiredHeight > 0) then Result := FRequiredHeight else Result := Max(FCurrentRequiredHeight, FBlocks.Height + FBlockStyle.AllPaddingsBottom + FBlockStyle.AllPaddingsTop); end; function TKMemoContainer.GetWordLeft(Index: TKMemoWordIndex): Integer; begin Result := FOrigin.X; end; function TKMemoContainer.GetWordLength(Index: TKMemoWordIndex): TKMemoSelectionIndex; begin Result := ContentLength; end; function TKMemoContainer.GetWords(Index: TKMemoWordIndex): TKString; begin Result := FBlocks.Text; end; function TKMemoContainer.GetWordTop(Index: TKMemoWordIndex): Integer; begin Result := FOrigin.Y; end; function TKMemoContainer.GetWordTopPadding(Index: TKMemoWordIndex): Integer; begin Result := FWordTopPadding; end; function TKMemoContainer.GetWordWidth(Index: TKMemoWordIndex): Integer; begin if FFixedWidth and (FRequiredWidth > 0) then Result := FRequiredWidth else Result := Max(FCurrentRequiredWidth, FBlocks.Width + FBlockStyle.AllPaddingsLeft + FBlockStyle.AllPaddingsRight); end; function TKMemoContainer.InsertParagraph(AIndex: TKMemoSelectionIndex): Boolean; begin Result := FBlocks.InsertParagraph(AIndex, False); end; function TKMemoContainer.InsertString(const AText: TKString; At: TKMemoSelectionIndex): Boolean; begin if At < 0 then At := FBlocks.SelectableLength; Result := FBlocks.InsertString(At, False, AText); end; procedure TKMemoContainer.NotifyDefaultParaChange; begin FBlocks.NotifyDefaultParaChange; end; procedure TKMemoContainer.NotifyDefaultTextChange; begin FBlocks.NotifyDefaultTextChange; end; procedure TKMemoContainer.NotifyPrintBegin; begin FBlocks.NotifyPrintBegin; end; procedure TKMemoContainer.NotifyPrintEnd; begin FBlocks.NotifyPrintEnd; end; procedure TKMemoContainer.ParentChanged; begin inherited; FBlocks.MemoNotifier := GetMemoNotifier; end; procedure TKMemoContainer.RequiredHeightChanged; begin end; procedure TKMemoContainer.RequiredWidthChanged; begin end; procedure TKMemoContainer.Resize(ANewWidth, ANewHeight: Integer); begin FixedWidth := True; FixedHeight := True; RequiredWidth := ANewWidth; RequiredHeight := ANewHeight; end; function TKMemoContainer.Select(ASelStart, ASelLength: TKMemoSelectionIndex; ADoScroll: Boolean): Boolean; begin Result := FBlocks.Select(ASelStart, ASelLength, ADoScroll); end; procedure TKMemoContainer.SetBlockExtent(AWidth, AHeight: Integer); begin FBlocks.SetExtent(AWidth - FBlockStyle.AllPaddingsLeft - FBlockStyle.AllPaddingsRight, AHeight - FBlockStyle.AllPaddingsTop - FBlockStyle.AllPaddingsBottom); end; procedure TKMemoContainer.SetClip(const Value: Boolean); begin if Value <> FClip then begin FClip := Value; Update([muExtent]); end; end; procedure TKMemoContainer.SetFixedHeight(const Value: Boolean); begin if Value <> FFixedHeight then begin FFixedHeight := Value; FixedHeightChanged; Update([muExtent]); end; end; procedure TKMemoContainer.SetFixedWidth(const Value: Boolean); begin if Value <> FFixedWidth then begin FFixedWidth := Value; FixedWidthChanged; Update([muExtent]); end; end; procedure TKMemoContainer.SetRequiredHeight(const Value: Integer); begin if Value <> FRequiredHeight then begin FRequiredHeight := Value; RequiredHeightChanged; Update([muExtent]); end; end; procedure TKMemoContainer.SetRequiredWidth(const Value: Integer); begin if Value <> FRequiredWidth then begin FRequiredWidth := Value; RequiredWidthChanged; Update([muExtent]); end; end; procedure TKMemoContainer.SetResizable(const Value: Boolean); begin if Value <> FResizable then begin FResizable := Value; Update([muExtent]); end; end; procedure TKMemoContainer.SetWordBottomPadding(Index: TKMemoWordIndex; const Value: Integer); begin FWordBottomPadding := Value; end; procedure TKMemoContainer.SetWordHeight(Index: TKMemoWordIndex; const Value: Integer); begin FCurrentRequiredHeight := Value; end; procedure TKMemoContainer.SetWordLeft(Index: TKMemoWordIndex; const Value: Integer); begin FOrigin.X := Value; end; procedure TKMemoContainer.SetWordTop(Index: TKMemoWordIndex; const Value: Integer); begin FOrigin.Y := Value; end; procedure TKMemoContainer.SetWordTopPadding(Index: TKMemoWordIndex; const Value: Integer); begin FWordTopPadding := Value; end; procedure TKMemoContainer.SetWordWidth(Index: TKMemoWordIndex; const Value: Integer); begin FCurrentRequiredWidth := Value; end; procedure TKMemoContainer.UpdateAttributes; begin FBlocks.UpdateAttributes; end; function TKMemoContainer.WordIndexToRect(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AIndex: TKMemoSelectionIndex; ACaret: Boolean): TRect; begin Result := FBlocks.IndexToRect(ACanvas, AIndex, ACaret, False); if not ACaret then begin // expand rect to enable vertical caret movement if Result.Top = 0 then Dec(Result.Top, FBlockStyle.AllPaddingsTop + FWordTopPadding); if Result.Bottom = FBlocks.Height then Inc(Result.Bottom, Height - FBlocks.Height - FBlockStyle.AllPaddingsTop - FWordTopPadding); end; Result := AddRectOffset(Result); end; function TKMemoContainer.WordMeasureExtent(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ARequiredWidth: Integer): TPoint; begin if FFixedWidth then FCurrentRequiredWidth := FRequiredWidth else FCurrentRequiredWidth := ARequiredWidth; FCurrentRequiredHeight := 0; FBlocks.MeasureExtent(ACanvas, Max(FCurrentRequiredWidth - FBlockStyle.AllPaddingsLeft - FBlockStyle.AllPaddingsRight, 0)); Result := Point(Width, Height); end; function TKMemoContainer.WordMouseAction(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AAction: TKMemoMouseAction; const APoint: TPoint; AShift: TShiftState): Boolean; var P: TPoint; R, RMargin, RInterior: TRect; Notifier: IKMemoNotifier; Cursor: TCursor; begin Result := False; P := APoint; R := Rect(0, 0, Width, Height); OffsetPoint(P, -Left - RealLeftOffset, -Top - RealTopOffset - FWordTopPadding); RMargin := FBlockStyle.MarginRect(R); RInterior := FBlockStyle.InteriorRect(FBlockStyle.BorderRect(RMargin)); if PtInRect(RInterior, P) then begin OffsetPoint(P, -FBlockStyle.AllPaddingsLeft, -FBlockStyle.AllPaddingsTop); Result := FBlocks.MouseAction(AAction, ACanvas, P, AShift); if not Result then Result := inherited WordMouseAction(ACanvas, AWordIndex, AAction, APoint, AShift); end else if (Position <> mbpText) and PtInRect(R, P) and (ActiveBlocks = FBlocks) then begin Notifier := MemoNotifier; if Notifier <> nil then begin case AAction of maMove: begin if ReadOnly then Cursor := crDefault else begin Cursor := SizingGripsCursor(RMargin, P); if Cursor = crDefault then Cursor := crSizeAll; end; Notifier.SetReqMouseCursor(Cursor); Result := True; end; maLeftDown: begin if ssDouble in AShift then Notifier.EditBlock(Self) else Notifier.SelectBlock(Self, SizingGripsPosition(RMargin, P)); Result := True; end; maRightDown: begin Result := Notifier.SelectBlock(Self, sgpNone); end; end; end; end; end; procedure TKMemoContainer.WordPaintToCanvas(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ALeft, ATop: Integer); var R, RClip: TRect; PrevRgn: HRGN; begin R := Rect(0, 0, Width, Height); KFunctions.OffsetRect(R, Left + ALeft + RealLeftOffset, Top + ATop + RealTopOffset + FWordTopPadding); R := FBlockStyle.MarginRect(R); FBlockStyle.PaintBox(ACanvas, R); if not ReadOnly and (ActiveBlocks = FBlocks) then SizingGripsDraw(ACanvas, R); R := FBlockStyle.BorderRect(R); Inc(ALeft, Left + FBlockStyle.AllPaddingsLeft + RealLeftOffset); Inc(ATop, Top + FBlockStyle.AllPaddingsTop + RealTopOffset + FWordTopPadding); if FClip then begin RClip := R; TranslateRectToDevice(ACanvas.Handle, RClip); PrevRgn := RgnCreateAndGet(ACanvas.Handle); try if ExtSelectClipRect(ACanvas.Handle, RClip, RGN_AND, PrevRgn) then begin R := FBlockStyle.InteriorRect(R); FBlocks.PaintToCanvas(ACanvas, ALeft, ATop, R); end; finally RgnSelectAndDelete(ACanvas.Handle, PrevRgn); end; ACanvas.Refresh; end else begin R := FBlockStyle.InteriorRect(R); FBlocks.PaintToCanvas(ACanvas, ALeft, ATop, R); end; end; function TKMemoContainer.WordPointToIndex(ACanvas: TCanvas; const APoint: TPoint; AWordIndex: TKMemoWordIndex; AOutOfArea, ASelectionExpanding: Boolean; out APosition: TKMemoLinePosition): TKMemoSelectionIndex; var P: TPoint; R: TRect; begin P := APoint; R := Rect(0, 0, Width, Height); OffsetPoint(P, -Left - RealLeftOffset, -Top - RealTopOffset - FWordTopPadding); if PtInRect(R, P) or (AOutOfArea and (P.X >= R.Left) and (P.X < R.Right)) then begin OffsetPoint(P, -FBlockStyle.AllPaddingsLeft, -FBlockStyle.AllPaddingsTop); Result := FBlocks.PointToIndex(ACanvas, P, AOutOfArea, ASelectionExpanding, APosition); end else Result := -1; end; { TKMemoTableCell } constructor TKMemoTableCell.Create; begin inherited; FClip := True; FParaStyle := TKMemoParaStyle.Create; FParaStyle.OnChanged := ParaStyleChanged; FRequiredBorderWidths := TKRect.Create; FRequiredBorderWidths.OnChanged := RequiredBorderWidthsChanged; FSpan := MakeCellSpan(1, 1); //FBlocks.FixEmptyBlocks; only for testing end; destructor TKMemoTableCell.Destroy; begin FParaStyle.Free; FRequiredBorderWidths.Free; inherited; end; procedure TKMemoTableCell.Assign(ASource: TKObject); begin inherited; if ASource is TKMemoTableCell then begin Span := TKMemoTableCell(ASource).Span; end; end; function TKMemoTableCell.ContentLength: TKMemoSelectionIndex; begin if (FSpan.ColSpan > 0) and (FSpan.RowSpan > 0) then Result := inherited ContentLength else Result := 0; end; function TKMemoTableCell.GetParaStyle: TKMemoParaStyle; begin Result := FParaStyle; end; function TKMemoTableCell.GetParentRow: TKMemoTableRow; begin if Parent <> nil then Result := ParentBlocks.Parent as TKMemoTableRow else Result := nil; end; function TKMemoTableCell.GetColIndex: Integer; var Row: TKMemoTableRow; begin Row := ParentRow; if Row <> nil then Result := Row.Blocks.IndexOf(Self) else Result := -1; end; function TKMemoTableCell.GetParentTable: TKMemoTable; var Row: TKMemoTableRow; begin Row := ParentRow; if Row <> nil then Result := Row.ParentTable else Result := nil; end; function TKMemoTableCell.GetRowIndex: Integer; var Table: TKMemoTable; begin Table := ParentTable; if Table <> nil then Result := Table.Blocks.IndexOf(ParentRow) else Result := -1; end; function TKMemoTableCell.PointToIndex(ACanvas: TCanvas; const APoint: TPoint; AFirstRow, ALastRow, AOutOfArea, ASelectionExpanding: Boolean; out APosition: TKMemoLinePosition): TKMemoSelectionIndex; var P: TPoint; R: TRect; begin P := APoint; R := Rect(0, 0, Width, Height); OffsetPoint(P, -Left - RealLeftOffset, -Top - RealTopOffset - FWordTopPadding); if PtInRect(R, P) or AFirstRow and (P.X >= R.Left) and (P.X < R.Right) and (P.Y < R.Bottom) or ALastRow and (P.X >= R.Left) and (P.X < R.Right) and (P.Y >= R.Top) then begin OffsetPoint(P, -FBlockStyle.AllPaddingsLeft, -FBlockStyle.AllPaddingsTop); Result := FBlocks.PointToIndex(ACanvas, P, AOutOfArea, ASelectionExpanding, APosition); end else Result := -1; end; procedure TKMemoTableCell.ParaStyleChanged(Sender: TObject; AReasons: TKMemoUpdateReasons); begin // take some default paragraph properties to cell style FBlockStyle.ContentPadding.Assign(FParaStyle.ContentPadding); end; procedure TKMemoTableCell.RequiredBorderWidthsChanged(Sender: TObject); var Table: TKMemoTable; begin Table := ParentTable; if (Table <> nil) and Table.UpdateUnlocked then Table.FixupBorders; end; procedure TKMemoTableCell.SetColSpan(Value: Integer); var Table: TKMemoTable; ACol, ARow: Integer; begin if Value <> FSpan.ColSpan then begin Table := ParentTable; if (Table <> nil) and Table.UpdateUnlocked and Table.FindCell(Self, ACol, ARow) then Table.CellSpan[ACol, ARow] := MakeCellSpan(Value, FSpan.RowSpan) else FSpan.ColSpan := Value; end; end; procedure TKMemoTableCell.SetRowSpan(Value: Integer); var Table: TKMemoTable; ACol, ARow: Integer; begin if Value <> FSpan.RowSpan then begin Table := ParentTable; if (Table <> nil) and Table.UpdateUnlocked and Table.FindCell(Self, ACol, ARow) then Table.CellSpan[ACol, ARow] := MakeCellSpan(FSpan.ColSpan, Value) else FSpan.RowSpan := Value; end; end; procedure TKMemoTableCell.SetSpan(const Value: TKCellSpan); var Table: TKMemoTable; ACol, ARow: Integer; begin if (Value.ColSpan <> FSpan.ColSpan) or (Value.RowSpan <> FSpan.RowSpan) then begin Table := ParentTable; if (Table <> nil) and Table.UpdateUnlocked and Table.FindCell(Self, ACol, ARow) then Table.CellSpan[ACol, ARow] := Value else FSpan := Value; end; end; function TKMemoTableCell.WordMeasureExtent(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ARequiredWidth: Integer): TPoint; begin if (FSpan.ColSpan > 0) and (FSpan.RowSpan > 0) then Result := inherited WordMeasureExtent(ACanvas, AWordIndex, ARequiredWidth) else Result := CreateEmptyPoint; end; procedure TKMemoTableCell.WordPaintToCanvas(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ALeft, ATop: Integer); begin if (FSpan.ColSpan > 0) and (FSpan.RowSpan > 0) then inherited; end; { TKMemoTableRow } constructor TKMemoTableRow.Create; begin inherited; end; destructor TKMemoTableRow.Destroy; begin inherited; end; function TKMemoTableRow.CanAdd(ABlock: TKMemoBlock): Boolean; begin // table row can only accept table cells Result := ABlock is TKMemoTableCell; end; function TKMemoTableRow.GetParentTable: TKMemoTable; begin if Parent <> nil then Result := ParentBlocks.Parent as TKMemoTable else Result := nil; end; procedure TKMemoTableRow.FixedHeightChanged; var I: Integer; begin for I := 0 to CellCount - 1 do Cells[I].FixedHeight := FixedHeight; end; function TKMemoTableRow.GetTotalLineCount: Integer; begin Result := 1; // do not add lines in cells end; function TKMemoTableRow.GetTotalLineRect(Index: TKMemoTotalLineIndex): TRect; begin Result := CreateEmptyRect; // use line info from Parent instead end; function TKMemoTableRow.GetCellCount: Integer; begin Result := Blocks.Count; end; function TKMemoTableRow.GetCells(Index: Integer): TKMemoTableCell; begin if (Index >= 0) and (Index < Blocks.Count) then Result := Blocks[Index] as TKMemoTableCell else Result := nil; end; procedure TKMemoTableRow.SetCellCount(const Value: Integer); var I: Integer; begin if Value <> CellCount then begin if Value > CellCount then begin for I := CellCount to Value - 1 do Blocks.Add(TKMemoTableCell.Create); end else begin for I := Value to CellCount - 1 do Blocks.Delete(Value); end; end; end; procedure TKMemoTableRow.RequiredHeightChanged; var I: Integer; begin for I := 0 to CellCount - 1 do begin Cells[I].FixedHeight := True; Cells[I].RequiredHeight := RequiredHeight; end; end; { TKMemoTable } constructor TKMemoTable.Create; begin inherited; FCellStyle := TKMemoBlockStyle.Create; FCellStyle.Changeable := False; FColCount := 0; FColWidths := TKMemoIndexObjectList.Create; FBlockStyle.WrapMode := wrNone; end; destructor TKMemoTable.Destroy; begin FCellStyle.Free; FColWidths.Free; inherited; end; procedure TKMemoTable.ApplyDefaultCellStyle; var Cell: TKMemoTableCell; Row: TKMemoTableRow; I, J, W: Integer; begin LockUpdate; try for I := 0 to RowCount - 1 do begin Row := Rows[I]; for J := 0 to Row.CellCount - 1 do begin Cell := Row.Cells[J]; if (Cell.ColSpan > 0) and (Cell.RowSpan > 0) then begin W := FCellStyle.BorderWidth; Cell.BlockStyle.Assign(FCellStyle); Cell.BlockStyle.BorderWidth := 0; Cell.BlockStyle.BorderWidths.All := 0; Cell.RequiredBorderWidths.All := W; end; end; end; FixupBorders; finally UnlockUpdate; end; end; procedure TKMemoTable.Assign(ASource: TKObject); var I: Integer; begin inherited; if ASource is TKMemoTable then begin // here cells are already copied, so just update respective fields to avoid SetSize call LockUpdate; try FColCount := TKMemoTable(ASource).ColCount; FColWidths.SetSize(FColCount); for I := 0 to FColCount - 1 do FColWidths[I].Index := TKMemoTable(ASource).ColWidths[I]; finally UnlockUpdate; end; end; end; procedure TKMemoTable.AssignAttributes(ABlock: TKMemoBlock); begin inherited; if ABlock is TKMemoTable then CellStyle.Assign(TKMemoTable(ABlock).CellStyle); end; function TKMemoTable.CalcTotalCellWidth(ACol, ARow: Integer): Integer; var BaseCol, BaseRow: Integer; Cell: TKMemoTableCell; Row: TKMemoTableRow; I, W: Integer; begin FindBaseCell(ACol, ARow, BaseCol, BaseRow); Row := Rows[BaseRow]; Cell := Row.Cells[BaseCol]; Result := 0; for I := BaseCol to BaseCol + Cell.ColSpan - 1 do begin Cell := Row.Cells[I]; if Cell.RequiredWidth > 0 then W := Cell.RequiredWidth else W := Cell.Width; Inc(Result, W); end; end; function TKMemoTable.CanAdd(ABlock: TKMemoBlock): Boolean; begin // table can only accept table rows Result := ABlock is TKMemoTableRow; end; function TKMemoTable.CellValid(ACol, ARow: Integer): Boolean; begin Result := (ARow >= 0) and (ARow < RowCount) and (ACol >= 0) and (ACol < Rows[ARow].CellCount); end; function TKMemoTable.CellVisible(ACol, ARow: Integer): Boolean; var Span: TKCellSpan; begin Span := CellSpan[ACol, ARow]; Result := (Span.ColSpan > 0) and (Span.RowSpan > 0); end; function TKMemoTable.ColValid(ACol: Integer): Boolean; begin Result := (ACol >= 0) and (ACol < FColCount); end; procedure TKMemoTable.FindBaseCell(ACol, ARow: Integer; out BaseCol, BaseRow: Integer); var Span: TKCellSpan; begin BaseCol := ACol; BaseRow := ARow; Span := GetCellSpan(ACol, ARow); if (Span.ColSpan <= 0) and (Span.RowSpan <= 0) then begin BaseCol := ACol + Span.ColSpan; BaseRow := ARow + Span.RowSpan; end; end; function TKMemoTable.FindCell(ACell: TKMemoTableCell; out ACol, ARow: Integer): Boolean; var I, J: Integer; Row: TKMemoTableRow; begin Result := False; for I := 0 to RowCount - 1 do begin Row := Rows[I]; for J := 0 to Row.CellCount - 1 do if Row.Cells[J] = ACell then begin ACol := J; ARow := I; Result := True; Exit; end; end; end; procedure TKMemoTable.FixupBorders; var Cell: TKMemoTableCell; Row: TKMemoTableRow; PrevColCell: TKMemoTableCell; PrevRowCell: TKMemoTableCell; BaseCol, BaseRow, I, J, Width, Part, CurBaseCol, CurBaseRow: Integer; begin LockUpdate; try for I := 0 to RowCount - 1 do begin Row := Rows[I]; for J := 0 to Row.CellCount - 1 do begin Cell := Row.Cells[J]; // find cells in previous row and column (or base cells corresponding to these positions) // these cells cannot be a part of merged area of cells to which the current cell also belongs FindBaseCell(J, I, CurBaseCol, CurBaseRow); PrevRowCell := nil; if I > 0 then begin FindBaseCell(J, I - 1, BaseCol, BaseRow); if (CurBaseCol <> BaseCol) or (CurBaseRow <> BaseRow) then PrevRowCell := Rows[BaseRow].Cells[BaseCol]; end; PrevColCell := nil; if J > 0 then begin FindBaseCell(J - 1, I, BaseCol, BaseRow); if (CurBaseCol <> BaseCol) or (CurBaseRow <> BaseRow) then PrevColCell := Rows[BaseRow].Cells[BaseCol]; end; // assign default cell borders Cell.BlockStyle.BorderWidth := 0; Cell.BlockStyle.BorderWidths.Assign(Cell.RequiredBorderWidths); if PrevColCell <> nil then begin // we split the border width among two neighbor cells in horizontal direction Width := Max(Cell.RequiredBorderWidths.Left, PrevColCell.RequiredBorderWidths.Right); if Width > 0 then begin Part := DivUp(Width, 2); Cell.BlockStyle.BorderWidths.Left := Part; PrevColCell.BlockStyle.BorderWidths.Right := Width - Part; end; end; if PrevRowCell <> nil then begin // we split the border width among two neighbor cells in vertical direction Width := Max(Cell.RequiredBorderWidths.Top, PrevRowCell.RequiredBorderWidths.Bottom); if Width > 0 then begin Part := DivUp(Width, 2); Cell.BlockStyle.BorderWidths.Top := Part; PrevRowCell.BlockStyle.BorderWidths.Bottom := Width - Part end; end; end; end; finally UnlockUpdate; end; end; procedure TKMemoTable.FixupCellSpan; var I, J: Integer; Span, RefSpan: TKCellSpan; Row: TKMemoTableRow; Cell: TKMemoTableCell; begin LockUpdate; try RefSpan := MakeCellSpan(1, 1); // don't make this too complicated, but maybe it is little bit slower: // reset all negative spans for I := 0 to RowCount - 1 do begin Row := Rows[I]; for J := 0 to Row.CellCount - 1 do begin Cell := Row.Cells[J]; if (Cell.ColSpan <= 0) or (Cell.RowSpan <= 0) then Cell.Span := RefSpan; end; end; // create all spans for I := 0 to RowCount - 1 do begin Row := Rows[I]; for J := 0 to Row.CellCount - 1 do begin Cell := Row.Cells[J]; if (Cell.ColSpan > 1) or (Cell.RowSpan > 1) then begin Span := MakeCellSpan(Min(Cell.ColSpan, Row.CellCount - J), Min(Cell.RowSpan, RowCount - I)); Cell.Span := RefSpan; InternalSetCellSpan(J, I, Span); end; end; end; finally UnlockUpdate; end; end; procedure TKMemoTable.FixupCellSpanFromRTF; function HasSomeCellZeroWidth(ARow: TKMemoTableRow): Boolean; var I: Integer; begin Result := False; for I := 0 to ARow.CellCount - 1 do if ARow.Cells[I].RequiredWidth = 0 then begin Result := True; Exit; end; end; function FindValidBaseCell(ACol, ARow: Integer; out AColDelta, ARowDelta: Integer): TKMemoTableCell; var I, J: Integer; Row: TKMemoTableRow; Cell: TKMemoTableCell; begin Result := nil; AColDelta := 0; ARowDelta := 0; Row := nil; for I := ARow downto 0 do begin Row := Rows[I]; Cell := Row.Cells[ACol]; if (Cell.ColSpan >= 0) and (Cell.RowSpan > 0) or (Cell.ColSpan < 0) and (Cell.RowSpan = 0) then Break else Inc(ARowDelta); end; if Row <> nil then begin for J := ACol downto 0 do begin Cell := Row.Cells[J]; if (Cell.RowSpan >= 0) and (Cell.ColSpan > 0) or (Cell.RowSpan < 0) and (Cell.ColSpan = 0) then begin Result := Cell; Break; end else Inc(AColDelta); end; end; end; var I, J, K, CellCnt, ColDelta, MaxXPos, RowDelta, RowXPos, WDelta, XPos: Integer; Row: TKMemoTableRow; Span: TKCellSpan; LastCell, Cell, TmpCell: TKMemoTableCell; begin // this routine assumes the table was loaded from RTF LockUpdate; try { First update our FColCount and FColWidths properties. This is needed because horizontally merged table cells are stored as a single cell and the only distinguishing factor is their width. So go through the table and find every vertical cell split (end of each cell). } MaxXPos := 0; for I := 0 to RowCount - 1 do begin Row := Rows[I]; XPos := 0; for J := 0 to Row.CellCount - 1 do Inc(XPos, Row.Cells[J].RequiredWidth); MaxXPos := Max(MaxXPos, XPos); end; XPos := 0; K := 0; while XPos < MaxXPos do begin WDelta := MaxInt; for I := 0 to RowCount - 1 do begin Row := Rows[I]; J := 0; RowXPos := 0; while (J < Row.CellCount) and (RowXPos <= XPos) do begin Inc(RowXPos, Row.Cells[J].RequiredWidth); Inc(J); end; if RowXPos > XPos then WDelta := Min(RowXPos - XPos, WDelta); end; Inc(XPos, WDelta); if K < FColCount then FColWidths[K].Index := WDelta else begin Inc(FColCount); FColWidths.AddItem(WDelta); end; Inc(K); end; { Now fill the missing cells for each row that has horizontally merged cells. } for I := 0 to RowCount - 1 do begin Row := Rows[I]; if (Row.CellCount < FColCount) or HasSomeCellZeroWidth(Row) then begin CellCnt := 0; LastCell := Row.Cells[CellCnt]; // this cell must always exist for J := 0 to FColCount - 1 do if LastCell <> nil then begin // fill the gaps for possibly merged cells WDelta := LastCell.RequiredWidth - FColWidths[J].Index; if WDelta = 0 then begin // OK, here this cell was certainly not merged so take next cell Inc(CellCnt); if CellCnt < Row.CellCount then LastCell := Row.Cells[CellCnt] else LastCell := nil; end else if WDelta > 0 then begin // the cell must have been merged here TmpCell := nil; if CellCnt < Row.CellCount - 1 then begin // first check if next cell has zero width TmpCell := Row.Cells[CellCnt + 1]; if TmpCell.RequiredWidth > 0 then TmpCell := nil; end; if TmpCell = nil then begin // otherwise insert new cell TmpCell := TKMemoTableCell.Create; TmpCell.RowSpan := LastCell.RowSpan; Row.Blocks.Insert(CellCnt + 1, TmpCell); end; TmpCell.FixedWidth := True; TmpCell.RequiredWidth := WDelta; TmpCell.ColSpan := 0; // for later fixup LastCell.RequiredWidth := LastCell.RequiredWidth - WDelta; LastCell := TmpCell; Inc(CellCnt); end; end; // delete superfluous cells while Row.CellCount > FColCount do Row.Blocks.Delete(FColCount); end else begin for J := 0 to FColCount - 1 do Row.Cells[J].RequiredWidth := FColWidths[J].Index; end; end; // here we fixup the Span properties for I := 0 to RowCount - 1 do begin Row := Rows[I]; for J := 0 to Row.CellCount - 1 do begin Cell := Row.Cells[J]; Span := Cell.Span; if (Span.ColSpan = 0) or (Span.RowSpan = 0) then begin LastCell := FindValidBaseCell(J, I, ColDelta, RowDelta); if LastCell <> nil then begin LastCell.ColSpan := Max(LastCell.ColSpan, ColDelta + 1); LastCell.RowSpan := Max(LastCell.RowSpan, RowDelta + 1); Cell.ColSpan := -ColDelta; Cell.RowSpan := -RowDelta; end end; Cell.FixedWidth := False; Cell.FixedHeight := False; if (Span.ColSpan > 0) and (Span.RowSpan > 0) then Cell.Blocks.AddParagraph; end; end; finally UnlockUpdate; end; end; function TKMemoTable.GetCells(ACol, ARow: Integer): TKMemoTableCell; begin if CellValid(ACol, ARow) then Result := Rows[ARow].Cells[ACol] else Result := nil; end; function TKMemoTable.GetCellSpan(ACol, ARow: Integer): TKCellSpan; begin if CellValid(ACol, ARow) then Result := Rows[ARow].Cells[ACol].Span else Result := MakeCellSpan(1, 1); end; function TKMemoTable.GetColWidths(Index: Integer): Integer; begin Result := FColWidths[Index].Index; end; function TKMemoTable.GetRowCount: Integer; begin Result := Blocks.Count; end; function TKMemoTable.GetRowHeights(Index: Integer): Integer; begin if (Index >= 0) and (Index < RowCount) then Result := Rows[Index].Height else Result := 0 end; function TKMemoTable.GetRows(Index: Integer): TKMemoTableRow; begin if (Index >= 0) and (Index < RowCount) then Result := Blocks[Index] as TKMemoTableRow else Result := nil; end; procedure TKMemoTable.InternalSetCellSpan(ACol, ARow: Integer; const Value: TKCellSpan); procedure Merge(ACol1, ARow1, ACol2, ARow2: Integer); var I, J: Integer; Row: TKMemoTableRow; Cell: TKMemoTableCell; begin for I := ARow1 to ARow2 - 1 do begin Row := Rows[I]; for J := ACol1 to ACol2 - 1 do begin Cell := Row.Cells[J]; if (I = ACol1) and (J = ARow1) then Cell.Span := MakeCellSpan(ACol2 - ACol1, ARow2 - ARow1) else Cell.Span := MakeCellSpan(ACol1 - J, ARow1 - I); end; end; end; procedure Split(ACol1, ARow1, ACol2, ARow2: Integer); var I, J: Integer; Row: TKMemoTableRow; Cell: TKMemoTableCell; RefSpan: TKCellSpan; begin RefSpan := MakeCellSpan(1, 1); for I := ARow1 to ARow2 - 1 do begin Row := Rows[I]; for J := ACol1 to ACol2 - 1 do begin Cell := Row.Cells[J]; Cell.Span := RefSpan; end; end; end; var I, J, BaseCol, BaseRow: Integer; Span: TKCellSpan; Row: TKMemoTableRow; Cell: TKMemoTableCell; begin LockUpdate; try Span := GetCellSpan(ACol, ARow); if (Span.ColSpan > 1) or (Span.RowSpan > 1) then begin // destroy previously merged area Split(ACol, ARow, ACol + Span.ColSpan, ARow + Span.RowSpan); end; for J := ARow to ARow + Value.RowSpan - 1 do begin Row := Rows[J]; for I := ACol to ACol + Value.ColSpan - 1 do begin Cell := Row.Cells[I]; Span := Cell.Span; if (Span.ColSpan <> 1) or (Span.RowSpan <> 1) then begin // adjust all four overlapping spans FindBaseCell(I, J, BaseCol, BaseRow); if (BaseCol <> ACol) or (BaseRow <> ARow) then begin Span := GetCellSpan(BaseCol, BaseRow); Split(Max(ACol, BaseCol), Max(ARow, BaseRow), Min(ACol + Value.ColSpan, BaseCol + Span.ColSpan), Min(ARow + Value.RowSpan, BaseRow + Span.RowSpan)); Merge(BaseCol, BaseRow, BaseCol + Span.ColSpan, ARow); Merge(BaseCol, ARow + Value.RowSpan, BaseCol + Span.ColSpan, BaseRow + Span.RowSpan); Merge(BaseCol, Max(ARow, BaseRow), ACol, Min(ARow + Value.RowSpan, BaseRow + Span.RowSpan)); Merge(ACol + Value.ColSpan, Max(ARow, BaseRow), BaseCol + Span.ColSpan, Min(ARow + Value.RowSpan, BaseRow + Span.RowSpan)); end; end; if (I = ACol) and (J = ARow) then Cell.Span := Value else // negative cell span - means this cell is hidden // it indicates where base cell for this span is located Cell.Span := MakeCellSpan(ACol - I, ARow - J); end; end; finally UnlockUpdate; end; end; function TKMemoTable.RowValid(ARow: Integer): Boolean; begin Result := (ARow >= 0) and (ARow < RowCount); end; procedure TKMemoTable.SetCellSpan(ACol, ARow: Integer; Value: TKCellSpan); var Span: TKCellSpan; begin if CellValid(ACol, ARow) then begin Value.ColSpan := MinMax(Value.ColSpan, 1, Rows[ARow].CellCount - ACol); Value.RowSpan := MinMax(Value.RowSpan, 1, RowCount - ARow); Span := GetCellSpan(ACol, ARow); if (Span.ColSpan <> Value.ColSpan) or (Span.RowSpan <> Value.RowSpan) then InternalSetCellSpan(ACol, ARow, Value); end; end; procedure TKMemoTable.SetColCount(const Value: Integer); begin SetSize(Value, RowCount); end; procedure TKMemoTable.SetColWidths(Index: Integer; const Value: Integer); var I: Integer; begin if Value <> ColWidths[Index] then begin FColWidths[Index].Index := Value; LockUpdate; try for I := 0 to RowCount - 1 do Rows[I].Cells[Index].RequiredWidth := Value; finally UnlockUpdate; end; end; end; procedure TKMemoTable.SetRowCount(const Value: Integer); begin SetSize(ColCount, Value); end; procedure TKMemoTable.SetRowHeights(Index: Integer; const Value: Integer); begin if (Index >= 0) and (Index < RowCount) then Rows[Index].RequiredHeight := Value; end; procedure TKMemoTable.SetSize(AColCount, ARowCount: Integer); var I, J: Integer; Row: TKMemoTableRow; begin LockUpdate; try if AColCount <> FColCount then begin FColCount := AColCount; for I := 0 to RowCount - 1 do Rows[I].CellCount := FColCount; FColWidths.SetSize(FColCount); end; if ARowCount <> RowCount then begin if ARowCount > RowCount then begin for I := RowCount to ARowCount - 1 do begin Row := TKMemoTableRow.Create; Row.CellCount := FColCount; Row.RequiredWidth := RequiredWidth; for J := 0 to FColCount - 1 do if ColWidths[J] <> 0 then Row.Cells[J].RequiredWidth := ColWidths[J]; Blocks.Add(Row); end; end else begin for I := ARowCount to RowCount - 1 do Blocks.Delete(RowCount - 1); end; end; finally UnlockUpdate; end; end; function TKMemoTable.WordMeasureExtent(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ARequiredWidth: Integer): TPoint; function GetExtentSpanned(AExtents: TKMemoIndexObjectList; AIndex, ASpan: Integer): Integer; var I: Integer; begin Result := 0; for I := AIndex to AIndex + ASpan - 1 do if I < AExtents.Count then Result := Result + AExtents[I].Index; end; const cMinColSize = 20; var I, J, K, Len, RealColCount, ColWidth, DefColCount, DefSpace, AvailableSpace, OverflowSpace, RequiredSpace, MeasuredWidth, MinSpannedWidth, NewWidth, UndefColCount, UndefColWidth, UndefSpace, TotalSpace, PosX, PosY, VDelta: Integer; Extent, MeasExtent: TPoint; Row: TKMemoTableRow; Cell: TKmemoTableCell; DefColWidths, MeasWidths, MinWidths, Heights: TKMemoIndexObjectList; begin // this is the table layout calculation // first get required table width if FFixedWidth then begin if FRequiredWidth > 0 then // required width given for entire table, scale all column widths ARequiredWidth := FRequiredWidth - FBlockStyle.AllPaddingsLeft + FBlockStyle.AllPaddingsRight else begin // required width not given for entire table, use column widths ARequiredWidth := 0; for I := 0 to FColCount - 1 do Inc(ARequiredWidth, FColWidths[I].Index); end; end else Dec(ARequiredWidth, FBlockStyle.AllPaddingsLeft + FBlockStyle.AllPaddingsRight); // calculate real column count, this may be different from FColCount RealColCount := 0; for I := 0 to RowCount - 1 do RealColCount := Max(RealColCount, Rows[I].CellCount); // calculate predefined column widths DefColCount := 0; DefSpace := 0; for I := 0 to FColCount - 1 do begin Inc(DefSpace, FColWidths[I].Index); if FColWidths[I].Index > 0 then Inc(DefColCount); end; if RealColCount > DefColCount then begin UndefColCount := RealColCount - DefColCount; UndefSpace := Max(ARequiredWidth - DefSpace, UndefColCount * cMinColSize); UndefColWidth := DivDown(UndefSpace, UndefColCount); end else begin UndefSpace := 0; UndefColWidth := cMinColSize; end; TotalSpace := DefSpace + UndefSpace; // now measure cells DefColWidths := TKMemoIndexObjectList.Create; MeasWidths := TKMemoIndexObjectList.Create; MinWidths := TKMemoIndexObjectList.Create; Heights := TKMemoIndexObjectList.Create; try DefColWidths.SetSize(RealColCount); MeasWidths.SetSize(RealColCount); MinWidths.SetSize(RealColCount); Heights.SetSize(RowCount); for J := 0 to RowCount - 1 do Heights[J].Index := 0; // first measure cells with predefined column widths for I := 0 to RealColCount - 1 do begin if (I < FColCount) and (FColWidths[I].Index > 0) then // always scale the predefined column widths to fit into ARequiredWidth // set FixedWidth to true and RequiredWidth to zero or sum of all column widths to get exact column widths ColWidth := Max(MulDiv(FColWidths[I].Index, ARequiredWidth, TotalSpace), cMinColSize) else ColWidth := UndefColWidth; DefColWidths[I].Index := ColWidth; end; // measure unmerged cells for I := 0 to RealColCount - 1 do begin MeasWidths[I].Index := 0; MinWidths[I].Index := 0; for J := 0 to RowCount - 1 do begin Row := Rows[J]; if I < Row.CellCount then begin Cell := Row.Cells[I]; if Cell.ColSpan = 1 then begin Extent := Cell.WordMeasureExtent(ACanvas, 0, cMinColSize); MinWidths[I].Index := Max(MinWidths[I].Index, Extent.X); MeasExtent := Cell.WordMeasureExtent(ACanvas, 0, DefColWidths[I].Index); MeasWidths[I].Index := Max(MeasWidths[I].Index, MeasExtent.X); if Cell.RowSpan = 1 then Heights[J].Index := Max(Heights[J].Index, MeasExtent.Y); end; end; end; if MeasWidths[I].Index = 0 then MeasWidths[I].Index := DefColWidths[I].Index; if MinWidths[I].Index = 0 then MinWidths[I].Index := DefColWidths[I].Index; end; // measure horizontally merged cells for I := 0 to RealColCount - 1 do begin for J := 0 to RowCount - 1 do begin Row := Rows[J]; if I < Row.CellCount then begin Cell := Row.Cells[I]; if Cell.ColSpan > 1 then begin MinSpannedWidth := 0; for K := I to I + Cell.ColSpan - 1 do Inc(MinSpannedWidth, MinWidths[K].Index); Extent := Cell.WordMeasureExtent(ACanvas, 0, cMinColSize); if Extent.X > MinSpannedWidth then begin // equally distribute the width of merged cells across participating columns for K := I to I + Cell.ColSpan - 1 do begin MinWidths[K].Index := DivUp(MinWidths[K].Index * Extent.X, MinSpannedWidth); MeasWidths[K].Index := Max(MeasWidths[K].Index, MinWidths[K].Index); end; end; end; end; end; end; // then, if some MeasWidths were bigger than ColWidth, recalculate remaining columns to fit required width MeasuredWidth := 0; for I := 0 to RealColCount - 1 do Inc(MeasuredWidth, MeasWidths[I].Index); OverflowSpace := MeasuredWidth - ARequiredWidth; if MeasuredWidth > ARequiredWidth then repeat AvailableSpace := 0; RequiredSpace := ARequiredWidth; for I := 0 to RealColCount - 1 do if MeasWidths[I].Index > MinWidths[I].Index then Inc(AvailableSpace, MeasWidths[I].Index) else Dec(RequiredSpace, MinWidths[I].Index); // AvailableSpace = sum of all MeasWidths bigger than MinWidths // RequiredSpace = ARequiredWidth - sum of all unchangeable MeasWidths (lower than or equal to MinWidths) // now distribute OverflowSpace across AvailableSpace if AvailableSpace > 0 then begin for I := 0 to RealColCount - 1 do if (MeasWidths[I].Index > MinWidths[I].Index) and (OverflowSpace > 0) then begin NewWidth := Max(Trunc(MeasWidths[I].Index * RequiredSpace / AvailableSpace), MinWidths[I].Index); if NewWidth >= MinWidths[I].Index then begin Dec(OverflowSpace, MeasWidths[I].Index - NewWidth); if OverflowSpace < 0 then begin Inc(NewWidth, -OverflowSpace); OverflowSpace := 0; end; MeasWidths[I].Index := NewWidth; end; end; end; until (OverflowSpace = 0) or (AvailableSpace = 0); // then, measure again with maximum allowed column width and update vertical extents for I := 0 to RowCount - 1 do begin Row := Rows[I]; for J := 0 to Row.CellCount - 1 do begin Cell := Row.Cells[J]; if CellVisible(J, I) and ((MeasWidths[J].Index <> Cell.Width) or (Cell.ColSpan > 1) or (Cell.RowSpan > 1)) then begin Extent := Cell.WordMeasureExtent(ACanvas, 0, GetExtentSpanned(MeasWidths, J, Cell.ColSpan)); // update vertical extents if Cell.RowSpan = 1 then Heights[I].Index := Max(Heights[I].Index, Extent.Y); end; end; end; // then, update vertical extents for row-spanned cells, because some of these cells might be taller than remaining cells for I := 0 to RowCount - 1 do begin Row := Rows[I]; for J := 0 to Row.CellCount - 1 do begin Cell := Row.Cells[J]; if CellVisible(J, I) and (Cell.RowSpan > 1) then begin VDelta := Cell.Height - GetExtentSpanned(Heights, I, Cell.RowSpan); if VDelta > 0 then Heights[I + Cell.RowSpan - 1].Index := Heights[I + Cell.RowSpan - 1].Index + VDelta; end; end; end; // finally, set cell/row positions and heights ClearLines; Extent.X := 0; for I := 0 to RealColCount - 1 do Inc(Extent.X, MeasWidths[I].Index); Len := 0; PosY := 0; for I := 0 to RowCount - 1 do begin Row := Rows[I]; PosX := 0; for J := 0 to Row.CellCount - 1 do begin Cell := Row.Cells[J]; // Cell.SetBlockExtent(Cell.WordWidth[0], VertExtents[I].Index); // No! Cell is measured by default way Cell.WordLeft[0] := PosX; Cell.WordTop[0] := 0; if CellVisible(J, I) then begin Cell.WordHeight[0] := GetExtentSpanned(Heights, I, Cell.RowSpan); end else begin Cell.WordHeight[0] := Heights[I].Index; end; Inc(PosX, MeasWidths[J].Index); end; Row.SetBlockExtent(Extent.X, Heights[I].Index); Row.WordLeft[0] := 0; Row.WordTop[0] := PosY; Row.WordHeight[0] := Heights[I].Index; Row.AddSingleLine; AddBlockLine(I, Len, I, Len + Row.ContentLength - 1, 0, PosY, Extent.X, Heights[I].Index); Inc(Len, Row.ContentLength); Inc(PosY, Heights[I].Index); end; Extent.Y := PosY; Inc(Extent.X, FBlockStyle.AllPaddingsLeft + FBlockStyle.AllPaddingsRight); Inc(Extent.Y, FBlockStyle.AllPaddingsTop + FBlockStyle.AllPaddingsBottom); SetBlockExtent(Extent.X, Extent.Y); WordLeft[0] := 0; WordTop[0] := 0; WordHeight[0] := 0; finally DefColWidths.Free; MeasWidths.Free; MinWidths.Free; Heights.Free; end; Result := Point(Extent.X, Extent.Y); end; function TKMemoTable.WordMouseAction(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AAction: TKMemoMouseAction; const APoint: TPoint; AShift: TShiftState): Boolean; var P: TPoint; R: TRect; I, J: Integer; Row: TKMemoTableRow; Cell: TKMemoTableCell; begin Result := False; P := APoint; R := Rect(0, 0, Width, Height); OffsetPoint(P, -Left - RealLeftOffset, -Top - RealTopOffset - FWordTopPadding); if PtInRect(R, P) then begin OffsetPoint(P, -FBlockStyle.AllPaddingsLeft, -FBlockStyle.AllPaddingsTop); for I := 0 to RowCount - 1 do begin Row := Rows[I]; for J := 0 to Row.CellCount - 1 do begin Cell := Row.Cells[J]; if (Cell.ColSpan > 0) and (Cell.RowSpan > 0) then begin Result := Result or Cell.WordMouseAction(ACanvas, 0, AAction, P, AShift); end; end; Dec(P.Y, Row.Height); end; end; end; function TKMemoTable.WordPointToIndex(ACanvas: TCanvas; const APoint: TPoint; AWordIndex: TKMemoWordIndex; AOutOfArea, ASelectionExpanding: Boolean; out APosition: TKMemoLinePosition): TKMemoSelectionIndex; var P: TPoint; R: TRect; I, J: Integer; Len: TKMemoSelectionIndex; Row: TKMemoTableRow; Cell: TKMemoTableCell; begin Result := -1; P := APoint; R := Rect(0, 0, Width, Height); OffsetPoint(P, -Left - RealLeftOffset, -Top - RealTopOffset - FWordTopPadding); if PtInRect(R, P) or (AOutOfArea and (P.X >= R.Left) and (P.X < R.Right)) then begin OffsetPoint(P, -FBlockStyle.AllPaddingsLeft, -FBlockStyle.AllPaddingsTop); Len := 0; I := 0; while (Result < 0) and (I < RowCount) do begin Row := Rows[I]; J := 0; while (Result < 0) and (J < Row.CellCount) do begin Cell := Row.Cells[J]; if (Cell.ColSpan > 0) and (Cell.RowSpan > 0) then begin Result := Cell.PointToIndex(ACanvas, P, I = 0, I + Cell.RowSpan >= RowCount, AOutOfArea, ASelectionExpanding, APosition); if Result < 0 then Inc(Len, Cell.ContentLength); end; Inc(J); end; Dec(P.Y, Row.Height); Inc(I); end; if Result >= 0 then Inc(Result, Len); end; end; { TKMemoMeasState } procedure TKMemoMeasState.Assign(AState: TKMemoMeasState); begin Assert(AState <> nil); PosX := AState.PosX; PosY := AState.PosY; RightX := AState.RightX; CurIndex := AState.CurIndex; CurBlockIndex := AState.CurBlockIndex; CurWordIndex := AState.CurWordIndex; CurTotalWord := AState.CurTotalWord; LineHeight := AState.LineHeight; ParaWidth := AState.ParaWidth; ParaPosY := AState.ParaPosY; LastIndex := AState.LastIndex; LastBlockIndex := AState.LastBlockIndex; LastWordIndex := AState.LastWordIndex; LastTotalWord := AState.LastTotalWord; RequiredWidth := AState.RequiredWidth; IsBreakable := AState.IsBreakable; IsParagraph := AState.IsParagraph; CurParaStyle := AState.CurParaStyle; CurParagraph := AState.CurParagraph; end; procedure TKMemoMeasState.Clear; begin PosX := 0; PosY := 0; RightX := 0; CurBlockIndex := 0; CurIndex := 0; CurWordIndex := 0; CurTotalWord := 0; LineHeight := 0; ParaWidth := 0; ParaPosY := 0; LastBlockIndex := 0; LastIndex := 0; LastWordIndex := 0; LastTotalWord := 0; RequiredWidth := 0; IsBreakable := False; IsParagraph := False; CurParaStyle := nil; CurParagraph := nil; end; function TKMemoMeasState.Initialized: Boolean; begin Result := CurParaStyle <> nil; end; { TKMemoBlocks } constructor TKMemoBlocks.Create; begin inherited; OwnsObjects := True; FBackState := TKMemoMeasState.Create; FBackState.Clear; FExtent := CreateEmptyPoint; FIgnoreParaMark := False; FLines := TKMemoLines.Create; FMemoNotifier := nil; FParent := nil; FRelPos := TKMemoIndexObjectList.Create; FSelEnd := 0; FSelStart := 0; FState := TKMemoMeasState.Create; FState.Clear; FOnUpdate := nil; Update([muContent]); end; destructor TKMemoBlocks.Destroy; begin FOnUpdate := nil; if FMemoNotifier <> nil then FMemoNotifier.BlocksFreeNotification(Self); FreeAndNil(FLines); FreeAndNil(FRelPos); FBackState.Free; FState.Free; Inc(FUpdateLock); // prevent calls of UpdateAttributes inherited; end; procedure TKMemoBlocks.DoUpdate(AReasons: TKMemoUpdateReasons); begin if Assigned(FOnUpdate) then FOnUpdate(AReasons); end; function TKMemoBlocks.AddAt(AObject: TKMemoBlock; At: TKMemoBlockIndex): TKMemoBlockIndex; begin if AObject <> nil then begin // check if parent can add this item if (FParent = nil) or FParent.CanAdd(AObject) then begin if Empty and (Count > 0) then inherited Delete(0); if (At < 0) or (At >= Count) then begin Result := inherited Add(AObject); end else begin inherited Insert(At, AObject); Result := At; end; end else begin AObject.Free; Result := -1; end; end else Result := -1; end; function TKMemoBlocks.AddContainer(At: TKMemoBlockIndex): TKMemoContainer; begin LockUpdate; try Result := TKMemoContainer.Create; AddAt(Result, At); finally UnlockUpdate; end; end; function TKMemoBlocks.AddHyperlink(ABlock: TKMemoHyperlink; At: TKMemoBlockIndex): TKMemoHyperlink; begin Result := ABlock; Result.TextStyle.Assign(LastTextStyle(At)); Result.DefaultStyle; AddAt(Result, At); end; function TKMemoBlocks.AddHyperlink(const AText, AURL: TKString; At: TKMemoBlockIndex): TKMemoHyperlink; begin Result := TKMemoHyperLink.Create; Result.TextStyle.Assign(LastTextStyle(At)); Result.DefaultStyle; Result.Text := AText; Result.URL := AURL; AddAt(Result, At); end; function TKMemoBlocks.AddImageBlock(AImage: TPicture; At: TKMemoBlockIndex): TKMemoImageBlock; begin Result := TKMemoImageBlock.Create; if AImage <> nil then Result.Image := AImage.Graphic; AddAt(Result, At); end; function TKMemoBlocks.AddImageBlock(const APath: TKString; At: TKMemoBlockIndex): TKMemoImageBlock; begin Result := TKMemoImageBlock.Create; if APath <> '' then Result.LoadFromFile(APath); AddAt(Result, At); end; function TKMemoBlocks.AddParagraph(At: TKMemoBlockIndex): TKMemoParagraph; var PA: TKMemoParagraph; begin Result := TKMemoParagraph.Create; PA := GetNearestParagraphBlock(At); if PA <> nil then begin Result.AssignAttributes(PA); if PA.ParaStyle.NumberStartAt > 0 then begin PA.ParaStyle.NumberStartAt := 0; end; end else begin Result.TextStyle.Assign(LastTextStyle(At)); Result.ParaStyle.Assign(GetDefaultParaStyle); end; AddAt(Result, At); end; function TKMemoBlocks.AddTable(At: TKMemoBlockIndex): TKMemoTable; begin Result := TKMemoTable.Create; AddAt(Result, At); end; function TKMemoBlocks.AddTextBlock(const AText: TKString; At: TKMemoBlockIndex): TKMemoTextBlock; begin Result := TKMemoTextBlock.Create; Result.TextStyle.Assign(LastTextStyle(At)); Result.Text := AText; AddAt(Result, At); end; procedure TKMemoBlocks.Assign(ASource: TKObjectList); begin inherited; if ASource is TKMemoBlocks then begin IgnoreParaMark := TKMemoBlocks(ASource).IgnoreParaMark; end; end; function TKMemoBlocks.BlockIndexToBlock(ABlockIndex: TKMemoBlockIndex): TKMemoBlock; begin if (ABlockIndex >= 0) and (ABlockIndex < Count) then Result := Items[ABlockIndex] else Result := nil; end; procedure TKMemoBlocks.CallAfterUpdate; begin if FUpdateReasons <> [] then begin Update(FUpdateReasons); FUpdateReasons := []; end; end; procedure TKMemoBlocks.CallBeforeUpdate; begin FUpdateReasons := []; end; procedure TKMemoBlocks.Clear; begin LockUpdate; try inherited; FSelEnd := -1; FSelStart := -1; finally UnlockUpdate; end; end; procedure TKMemoBlocks.ClearSelection(ATextOnly: Boolean); var I, First, Last: Integer; Block: TKMemoBlock; Changed: Boolean; begin LockUpdate; try I := 0; First := -1; Last := -1; Changed := False; while I < Count do begin Block := Items[I]; if (Block.SelStart >= 0) and (Block.SelLength > 0) then begin if ATextOnly and (Block is TKMemoContainer) then begin TKMemoContainer(Block).ClearSelection(ATextOnly); end else begin if Block.ContentLength = 0 then begin Delete(I); Changed := True; end else begin if Block.SelLength = Block.SelectableLength(True) then begin Delete(I); Changed := True; Dec(I); end else begin if First < 0 then First := I else Last := I; end; end; end; end; Inc(I); end; if Last >= 0 then begin Items[Last].ClearSelection(ATextOnly); Changed := True; end; if First >= 0 then begin Items[First].ClearSelection(ATextOnly); Changed := True; end; if FSelStart < FSelEnd then FSelEnd := FSelStart else FSelStart := FSelEnd; FSelStart := MinMax(FSelStart, 0, FSelectableLength); FSelEnd := MinMax(FSelEnd, 0, FSelectableLength); if Changed then FixEmptyBlocks; finally UnlockUpdate; end; end; procedure TKMemoBlocks.ConcatEqualBlocks; var I: Integer; Block, LastBlock: TKMemoBlock; begin // concat equal text blocks LockUpdate; try LastBlock := nil; for I := 0 to Count - 1 do begin Block := Items[I]; if Block is TKMemoContainer then TKmemoContainer(Block).Blocks.ConcatEqualBlocks else if (Block is TKMemoTextBlock) and (LastBlock is TKMemoTextBlock) and not (Block is TKMemoParagraph) then begin if TKmemoTextBlock(Block).TextStyle.EqualProperties(TKMemoTextBlock(LastBlock).TextStyle) then begin TKMemoTextBlock(LastBlock).Concat(TKmemoTextBlock(Block)); TKmemoTextBlock(Block).Text := ''; end; end; LastBlock := Block; end; // and delete empty blocks I := 0; while I < Count do begin Block := Items[I]; if (Block is TKMemoTextBlock) and (Items[I].ContentLength = 0) then Delete(I) else Inc(I); end; finally UnlockUpdate; end; end; procedure TKMemoBlocks.DeleteBOL(At: TKMemoSelectionIndex); var LineStart: TKMemoSelectionIndex; TmpPos: TKMemoLinePosition; begin LineStart := LineStartIndexByIndex(At, True, TmpPos); Select(LineStart, At - LineStart); ClearSelection; end; procedure TKMemoBlocks.DeleteChar(At: TKMemoSelectionIndex); var NextIndex: TKMemoSelectionIndex; begin if SelLength <> 0 then ClearSelection else if not IndexAtEndOfContainer(At, True) then begin NextIndex := NextIndexByCharCount(At, 1); Select(At, NextIndex - At, True, True); ClearSelection; end; end; procedure TKMemoBlocks.DeleteEOL(At: TKMemoSelectionIndex); var LineEnd: TKMemoSelectionIndex; TmpPos: TKMemoLinePosition; begin LineEnd := LineEndIndexByIndex(At, True, True, TmpPos); Select(At, LineEnd - At); ClearSelection; end; procedure TKMemoBlocks.DeleteLastChar(At: TKMemoSelectionIndex); var LastIndex: TKMemoSelectionIndex; begin if SelLength <> 0 then ClearSelection else if not IndexAtBeginningOfContainer(At, True) then begin LastIndex := NextIndexByCharCount(At, -1); Select(LastIndex, At - LastIndex, True, True); ClearSelection; end; end; procedure TKMemoBlocks.DeleteLine(At: TKMemoSelectionIndex); var LineStart, LineEnd: TKMemoSelectionIndex; TmpPos: TKMemoLinePosition; begin LineStart := LineStartIndexByIndex(At, True, TmpPos); LineEnd := LineEndIndexByIndex(At, True, True, TmpPos); Select(LineStart, LineEnd - LineStart); ClearSelection; end; function TKMemoBlocks.EOLToNormal(var AIndex: TKMemoSelectionIndex): Boolean; begin Result := False; if GetLinePosition = eolEnd then begin Dec(AIndex); Result := True; end; end; procedure TKMemoBlocks.FixEmptyBlocks; var I: TKMemoBlockIndex; SelectableCnt: Integer; Block: TKMemoBlock; begin // do not leave empty blocks, always add single paragraph SelectableCnt := 0; for I := 0 to Count - 1 do begin Block := Items[I]; if (Block.Position = mbpText) and not (Block is TKMemoContainer) then Inc(SelectableCnt); end; if SelectableCnt = 0 then begin AddParagraph; end; end; procedure TKMemoBlocks.FixEOL(AIndex: TKMemoSelectionIndex; AAdjust: Boolean; var ALinePos: TKMemoLinePosition); var Block: TKMemoBlock; LineIndex: TKMemoLineIndex; LocalIndex: TKMemoSelectionIndex; begin if SelLength = 0 then begin if AAdjust then EOLToNormal(AIndex); if AIndex < 0 then ALinePos := eolInside else begin Block := IndexToBlock(AIndex, LocalIndex); if Block is TKMemoContainer then begin TKMemoContainer(Block).Blocks.FixEOL(LocalIndex, False, ALinePos); end else begin LineIndex := IndexToLineIndex(AIndex); if (LineIndex >= 0) and (AIndex >= LineEndIndex[LineIndex]) then begin Block := Items[FLines[LineIndex].EndBlock]; if Block is TKMemoParagraph then begin ALinePos := eolInside; end else if AIndex > LineEndIndex[LineIndex] then ALinePos := eolEnd; end; end; end; if ALinePos = eolInside then begin FSelStart := Min(FSelStart, FSelectableLength - 1); FSelEnd := Min(FSelEnd, FSelectableLength - 1); end; end; end; function TKMemoBlocks.GetBoundsRect: TRect; begin Result := Rect(0, 0, Width, Height); end; function TKMemoBlocks.GetDefaultTextStyle: TKMemoTextStyle; begin if FParent <> nil then Result := FParent.DefaultTextStyle else if FMemoNotifier <> nil then Result := FMemoNotifier.GetDefaultTextStyle else Result := nil; end; function TKMemoBlocks.GetDefaultParaStyle: TKMemoParaStyle; begin if FParent <> nil then Result := FParent.DefaultParaStyle else if FMemoNotifier <> nil then Result := FMemoNotifier.GetDefaultParaStyle else Result := nil; end; function TKMemoBlocks.GetEmpty: Boolean; begin Result := Count = 0; end; function TKMemoBlocks.GetFirstBlock: TKMemoBlock; begin if Count > 0 then Result := Items[0] else Result := nil; end; function TKMemoBlocks.GetItem(Index: TKMemoBlockIndex): TKMemoBlock; begin Result := TKMemoBlock(inherited GetItem(Index)); end; function TKMemoBlocks.GetLastBlock: TKMemoBlock; begin if Count > 0 then Result := Items[Count - 1] else Result := nil; end; function TKMemoBlocks.GetLastBlockByClass(ABlockIndex: TKMemoBlockIndex; AClass: TKMemoBlockClass): TKMemoBlock; begin Result := nil; while (ABlockIndex > 0) and (Result = nil) and not (Items[ABlockIndex - 1] is TKMemoParagraph) do begin Dec(ABlockIndex); if Items[ABlockIndex] is AClass then Result := Items[ABlockIndex]; end; end; function TKMemoBlocks.GetLineBottom(ALineIndex: TKMemoLineIndex): Integer; begin Result := 0; if (ALineIndex >= 0) and (ALineIndex < LineCount) then Result := FLines[ALineIndex].Position.Y + FLines[ALineIndex].Extent.Y; end; function TKMemoBlocks.GetLineCount: Integer; begin Result := FLines.Count; end; function TKMemoBlocks.GetLineEndIndex(ALineIndex: TKMemoLineIndex): TKMemoSelectionIndex; begin Result := -1; if (ALineIndex >= 0) and (ALineIndex < LineCount) then begin Result := FLines[ALineIndex].EndIndex; end; end; function TKMemoBlocks.GetLineFloat(ALineIndex: TKMemoLineIndex): Boolean; var I: TKMemoBlockIndex; Block: TKMemoBlock; begin Result := True; if (ALineIndex >= 0) and (ALineIndex < LineCount) then begin for I := FLines[ALineIndex].StartBlock to FLines[ALineIndex].EndBlock do begin Block := Items[I]; if Block.WrapMode = wrNone then begin Result := False; Break; end; end; end; end; function TKMemoBlocks.GetLineHeight(ALineIndex: TKMemoLineIndex): Integer; begin if (ALineIndex >= 0) and (ALineIndex < LineCount) then Result := FLines[ALineIndex].Extent.Y else Result := 0; end; function TKMemoBlocks.GetLineInfo(ALineIndex: TKMemoLineIndex): TKMemoLine; begin if (ALineIndex >= 0) and (ALineIndex < LineCount) then Result := FLines[ALineIndex] else Result := nil; end; function TKMemoBlocks.GetLineLeft(ALineIndex: TKMemoLineIndex): Integer; begin Result := 0; if (ALineIndex >= 0) and (ALineIndex < LineCount) then Result := FLines[ALineIndex].Position.X; end; function TKMemoBlocks.GetLinePosition: TKMemoLinePosition; begin if FMemoNotifier <> nil then Result := FMemoNotifier.GetLinePosition else Result := eolInside; end; function TKMemoBlocks.GetLineRect(ALineIndex: TKMemoLineIndex): TRect; begin if (ALineIndex >= 0) and (ALineIndex < LineCount) then FLines[ALineIndex].LineRect else Result := CreateEmptyRect; end; function TKMemoBlocks.GetLineRight(ALineIndex: TKMemoLineIndex): Integer; begin Result := 0; if (ALineIndex >= 0) and (ALineIndex < LineCount) then Result := FLines[ALineIndex].Position.X + FLines[ALineIndex].Extent.X; end; function TKMemoBlocks.GetLineText(ALineIndex: TKMemoLineIndex): TKString; var BlockIndex: TKMemoBlockIndex; WordIndex, St, En: TKMemoWordIndex; Block: TKMemoBlock; begin Result := ''; if (ALineIndex >= 0) and (ALineIndex < LineCount) then begin for BlockIndex := FLines[ALineIndex].StartBlock to FLines[ALineIndex].EndBlock do begin Block := Items[BlockIndex]; if Block.Position = mbpText then begin GetWordIndexes(BlockIndex, ALineIndex, St, En); for WordIndex := St to En do Result := Result + Items[BlockIndex].Words[WordIndex]; end; end; end; end; function TKMemoBlocks.GetLineSize(ALineIndex: TKMemoLineIndex): Integer; var BlockIndex: TKMemoBlockIndex; WordIndex, St, En: TKMemoWordIndex; Block: TKMemoBlock; begin Result := 0; if (ALineIndex >= 0) and (ALineIndex < LineCount) then begin for BlockIndex := FLines[ALineIndex].StartBlock to FLines[ALineIndex].EndBlock do begin Block := Items[BlockIndex]; if Block.Position = mbpText then begin GetWordIndexes(BlockIndex, ALineIndex, St, En); for WordIndex := St to En do Inc(Result, Items[BlockIndex].WordLength[WordIndex]); end; end; end; end; function TKMemoBlocks.GetLineStartIndex(ALineIndex: TKMemoLineIndex): TKMemoSelectionIndex; begin Result := -1; if (ALineIndex >= 0) and (ALineIndex < LineCount) then begin Result := FLines[ALineIndex].StartIndex; end; end; function TKMemoBlocks.GetLineTop(ALineIndex: TKMemoLineIndex): Integer; begin Result := 0; if (ALineIndex >= 0) and (ALineIndex < LineCount) then Result := FLines[ALineIndex].Position.Y; end; function TKMemoBlocks.GetLineWidth(ALineIndex: TKMemoLineIndex): Integer; begin if (ALineIndex >= 0) and (ALineIndex < LineCount) then Result := FLines[ALineIndex].Extent.X else Result := 0; end; function TKMemoBlocks.GetMaxWordLength: TKMemoSelectionIndex; begin if FMemoNotifier <> nil then Result := FMemoNotifier.GetMaxWordLength else Result := cMaxWordLengthDef; end; function TKMemoBlocks.GetNearestAnchorBlockIndex(ABlockIndex: TKMemoBlockIndex): TKMemoBlockIndex; begin Result := -1; if ABlockIndex >= 0 then while (Result < 0) and (ABlockIndex >= 0) do begin if Items[ABlockIndex] is TKMemoParagraph then Result := ABlockIndex; Dec(ABlockIndex); end; end; function TKMemoBlocks.GetNearestParagraphBlockIndex(ABlockIndex: TKMemoBlockIndex): TKMemoBlockIndex; var Block: TKMemoBlock; begin Result := -1; if ABlockIndex >= 0 then while (Result < 0) and (ABlockIndex < Count) do begin Block := Items[ABlockIndex]; if Block is TKMemoParagraph then Result := ABlockIndex; Inc(ABlockIndex); end; end; function TKMemoBlocks.GetNearestParagraphBlock(ABlockIndex: TKMemoBlockIndex): TKMemoParagraph; var BlockIndex: TKMemoBlockIndex; begin BlockIndex := GetNearestParagraphBlockIndex(ABlockIndex); if BlockIndex >= 0 then Result := BlockIndexToBlock(BlockIndex) as TKMemoParagraph else Result := nil; end; function TKMemoBlocks.GetNearestWordIndexes(AIndex: TKMemoSelectionIndex; AAdjust: Boolean; AIncludeWhiteSpaces: Boolean; out AStart, AEnd: TKMemoSelectionIndex): Boolean; var I, BackupBlock, CurBlock: TKMemoBlockIndex; J, BackupWord, CurWord: TKMemoWordIndex; CurIndex, LastIndex, WLen, WLenWOWS: TKMemoSelectionIndex; IsBreakable: Boolean; Block: TKMemoBlock; begin Result := False; if AAdjust then EOLToNormal(AIndex); if AIndex >= 0 then begin CurBlock := -1; CurWord := -1; I := 0; CurIndex := 0; LastIndex := 0; while (CurBlock < 0) and (I < Count) do begin Block := Items[I]; LastIndex := CurIndex; Inc(CurIndex, Block.SelectableLength); if (AIndex >= LastIndex) and (AIndex < CurIndex) then begin CurBlock := I; if Block is TKMemoContainer then begin Result := TKMemoContainer(Block).Blocks.GetNearestWordIndexes(AIndex - LastIndex, False, AIncludeWhiteSpaces, AStart, AEnd); if Result then begin Inc(AStart, LastIndex); Inc(AEnd, LastIndex); end; end else begin J := 0; while (CurWord < 0) and (J < Block.WordCount) and (LastIndex <= AIndex) do begin WLen := Block.WordLength[J]; if AIncludeWhiteSpaces then WLenWOWS := WLen else WLenWOWS := Block.WordLengthWOWS[J]; if (AIndex >= LastIndex) and (AIndex < LastIndex + WLenWOWS) then CurWord := J else Inc(LastIndex, WLen); Inc(J); end; end; end; Inc(I); end; if (CurBlock >= 0) and (CurWord >= 0) then begin Result := True; BackupBlock := CurBlock; BackupWord := CurWord; AStart := LastIndex; AEnd := LastIndex; // we've found the word // go back and find first nonbreakable word Dec(CurWord); if CurWord < 0 then Dec(CurBlock); IsBreakable := False; while not IsBreakable and (CurBlock >= 0) do begin Block := Items[CurBlock]; if CurWord < 0 then CurWord := Block.WordCount - 1; if not (Block is TKMemoTextBlock) then IsBreakable := True else begin while not IsBreakable and (CurWord >= 0) do begin IsBreakable := Block.WordBreakable[CurWord]; if not Isbreakable then begin Dec(AStart, Block.WordLength[CurWord]); Dec(CurWord); end; end; CurWord := -1; Dec(CurBlock); end; end; // go forward and find first nonbreakable word CurBlock := BackupBlock; CurWord := BackupWord; IsBreakable := False; while not IsBreakable and (CurBlock < Count) do begin Block := Items[CurBlock]; if not (Block is TKMemoTextBlock) then IsBreakable := True else begin while not IsBreakable and (CurWord < Block.WordCount) do begin IsBreakable := Block.WordBreakable[CurWord]; if not IsBreakable or AIncludeWhiteSpaces then WLen := Block.WordLength[CurWord] else WLen := Block.WordLengthWOWS[CurWord]; if not (Block is TKMemoParagraph) then Inc(AEnd, WLen); Inc(CurWord); end; CurWord := 0; Inc(CurBlock); end; end; end; end; end; function TKMemoBlocks.GetNextBlockByClass(ABlockIndex: TKMemoBlockIndex; AClass: TKMemoBlockClass): TKMemoBlock; begin Result := nil; while (ABlockIndex < Count - 1) and (Result = nil) and not (Items[ABlockIndex + 1] is TKMemoParagraph) do begin Inc(ABlockIndex); if Items[ABlockIndex] is AClass then Result := Items[ABlockIndex]; end; end; function TKMemoBlocks.GetPageCount(APageHeight: Integer): Integer; var I, J, MaxLine: TKMemoTotalLineIndex; TmpPageBegin: Integer; R: TRect; begin Result := 1; // always at least one page if FLines.Count > 0 then TmpPageBegin := FLines[TKMemoLineIndex(0)].Position.Y else TmpPageBegin := 0; I := 0; J := -1; MaxLine := TotalLineCount - 1; while I <= MaxLine do begin if I <> J then begin R := TotalLineRect[I]; J := I; end; if R.Bottom - TmpPageBegin > APageHeight then begin TmpPageBegin := R.Top; if R.Bottom - R.Top > APageHeight then Inc(TmpPageBegin, APageHeight) else Inc(I); Inc(Result); end else Inc(I); end; end; procedure TKMemoBlocks.GetPageData(APageHeight, APage: Integer; out AOffset, AHeight: Integer); var I, J, MaxLine: TKMemoTotalLineIndex; TmpPageBegin, TmpPage: Integer; R: TRect; begin TmpPage := 0; if FLines.Count > 0 then TmpPageBegin := FLines[TKMemoLineIndex(0)].Position.Y else TmpPageBegin := 0; I := 0; J := -1; MaxLine := TotalLineCount - 1; while (I <= MaxLine) and (TmpPage <= APage) do begin if I <> J then begin R := TotalLineRect[I]; J := I; end; if R.Bottom - TmpPageBegin > APageHeight then begin if TmpPage < APage then begin TmpPageBegin := R.Top; if R.Bottom - R.Top > APageHeight then Inc(TmpPageBegin, APageHeight) else Inc(I); Inc(TmpPage); end else begin // finished measuring current page R.Bottom := R.Top; // take bottom coord of previous line Break; end; end else Inc(I); end; AOffset := TmpPageBegin; AHeight := Min(R.Bottom - TmpPageBegin, APageHeight); end; function TKMemoBlocks.GetParentBlocks: TKMemoBlocks; begin if FParent is TKMemoContainer then Result := TKMemoContainer(FParent).ParentBlocks else Result := nil; end; function TKMemoBlocks.GetParentBlocksForBlock( ABlock: TKMemoBlock): TKMemoBlocks; var I: Integer; Block: TKMemoBlock; begin Result := nil; for I := 0 to Count - 1 do begin Block := Items[I]; if ABlock = Block then begin Result := Self; Exit; end else if Block is TKMemoContainer then begin Result := TKMemoContainer(Block).Blocks.GetParentBlocksForBlock(ABlock); if Result <> nil then Exit; end; end; end; function TKMemoBlocks.GetParentMemo: TKCustomMemo; begin if FMemoNotifier <> nil then Result := FMemoNotifier.GetMemo else Result := nil; end; function TKMemoBlocks.GetRealSelEnd: TKMemoSelectionIndex; begin if FSelStart <= FSelEnd then Result := FSelEnd else Result := FSelStart; end; function TKMemoBlocks.GetRealSelLength: TKMemoSelectionIndex; begin Result := RealSelEnd - RealSelStart; end; function TKMemoBlocks.GetRealSelStart: TKMemoSelectionIndex; begin if FSelStart <= FSelEnd then Result := FSelStart else Result := FSelEnd; end; procedure TKMemoBlocks.GetSelColors(out TextColor, Background: TColor); begin if FMemoNotifier <> nil then FMemoNotifier.GetSelColors(TextColor, Background); end; function TKMemoBlocks.GetSelectionHasPara: Boolean; var I: TKMemoBlockIndex; CurIndex, LastIndex, TmpSelEnd, TmpSelStart: TKMemoSelectionIndex; Block: TKMemoBlock; begin Result := False; if SelLength > 0 then begin TmpSelEnd := RealSelEnd; TmpSelStart := RealSelStart; I := 0; CurIndex := 0; while not Result and (I < Count) do begin Block := Items[I]; LastIndex := CurIndex; Inc(CurIndex, Block.SelectableLength); if (LastIndex <= TmpSelEnd) and (TmpSelStart < CurIndex) then begin if Block is TKMemoContainer then Result := TKMemoContainer(Block).Blocks.SelectionHasPara else if Block is TKMemoParagraph then Result := True; end; Inc(I); end; end end; function TKMemoBlocks.GetSelectionParaStyle: TKMemoParaStyle; var Block: TKMemoBlock; BlockIndex: TKMemoBlockIndex; LocalIndex: TKMemoSelectionIndex; begin BlockIndex := IndexToBlockIndex(RealSelEnd, LocalIndex); if BlockIndex >= 0 then begin Block := Items[BlockIndex]; if Block is TKMemoContainer then Result := TKMemoContainer(Block).Blocks.SelectionParaStyle else begin Block := GetNearestParagraphBlock(BlockIndex); if Block <> nil then Result := Block.ParaStyle else Result := nil; end; end else Result := nil; end; function TKMemoBlocks.GetSelectionTextStyle: TKMemoTextStyle; var Block, LastBlock: TKmemoBlock; BlockIndex: TKMemoBlockIndex; LocalIndex: TKMemoSelectionIndex; begin Result := nil; BlockIndex := IndexToBlockIndex(RealSelEnd, LocalIndex); if BlockIndex >= 0 then begin if BlockIndex > 0 then LastBlock := Items[BlockIndex - 1] else LastBlock := nil; if (LocalIndex > 0) or (LastBlock is TKMemoParagraph) or not (LastBlock is TKMemoTextBlock) then begin Block := Items[BlockIndex]; if Block is TKMemoContainer then Result := TKMemoContainer(Block).Blocks.SelectionTextStyle else if Block is TKMemoTextBlock then Result := TKMemoTextBlock(Block).TextStyle; end else if LastBlock <> nil then begin Result := TKMemoTextBlock(LastBlock).TextStyle end; end; end; function TKMemoBlocks.GetSelLength: TKMemoSelectionIndex; begin Result := FSelEnd - FSelStart; end; function TKMemoBlocks.GetSelText: TKString; var I: TKMemoBlockIndex; Block: TKMemoBlock; begin Result := ''; for I := 0 to Count - 1 do begin Block := Items[I]; if Block.SelLength > 0 then Result := Result + Block.SelText; end; Result := UnicodeStringReplace(Result, NewLineChar, cEOL, [rfReplaceAll]); end; function TKMemoBlocks.GetShowFormatting: Boolean; begin if FMemoNotifier <> nil then Result := FMemoNotifier.GetShowFormatting else Result := False; end; function TKMemoBlocks.GetText: TKString; var I: TKMemoBlockIndex; Block: TKMemoBlock; begin Result := ''; for I := 0 to Count - 1 do begin Block := Items[I]; Result := Result + Block.Text; end; Result := UnicodeStringReplace(Result, NewLineChar, cEOL, [rfReplaceAll]); end; function TKMemoBlocks.GetTotalLeftOffset: Integer; begin if FParent <> nil then begin Result := FParent.Left + FParent.LeftOffset; if FParent is TKMemoContainer then Inc(Result, TKMemoContainer(FParent).BlockStyle.AllPaddingsLeft + TKMemoContainer(FParent).ParentBlocks.TotalLeftOffset); end else Result := 0; end; function TKMemoBlocks.GetTotalLineCount: Integer; var I: TKMemoLineIndex; Line: TKMemoLine; Block: TKMemoBlock; begin Result := 0; for I := 0 to FLines.Count - 1 do begin Line := FLines[I]; Block := Items[Line.StartBlock]; if Block is TKMemoContainer then Inc(Result, TKMemoContainer(Block).TotalLineCount) else Inc(Result); end; end; function TKMemoBlocks.GetTotalLineRect(Index: TKMemoTotalLineIndex): TRect; var I: TKMemoLineIndex; TmpIndex, TmpCount: TKMemoTotalLineIndex; Line: TKMemoLine; Block: TKMemoBlock; R: TRect; begin Result := CreateEmptyRect; TmpIndex := 0; for I := 0 to FLines.Count - 1 do begin Line := FLines[I]; Block := Items[Line.StartBlock]; if Block is TKMemoContainer then begin TmpCount := TKMemoContainer(Block).TotalLineCount; if (Index >= TmpIndex) and (Index < TmpIndex + TmpCount) then begin R := TKMemoContainer(Block).TotalLineRect[Index - TmpIndex]; if R.Bottom = R.Top then // empty line info Result := Line.LineRect else Result := R; Break; end else Inc(TmpIndex, TmpCount); end else begin if Index = TmpIndex then begin Result := Line.LineRect; Break; end else Inc(TmpIndex); end; end; end; function TKMemoBlocks.GetTotalTopOffset: Integer; begin if FParent <> nil then begin Result := FParent.Top + FParent.TopOffset + FParent.WordTopPadding[0]; if FParent is TKMemoContainer then Inc(Result, TKMemoContainer(FParent).BlockStyle.AllPaddingsTop + TKMemoContainer(FParent).ParentBlocks.TotalTopOffset); end else Result := 0; end; procedure TKMemoBlocks.GetWordIndexes(ABlockIndex: TKMemoBlockIndex; ALineIndex: TKMemoLineIndex; out AStart, AEnd: TKMemoWordIndex); begin if ABlockIndex = FLines[ALineIndex].StartBlock then AStart := FLines[ALineIndex].StartWord else AStart := 0; if ABlockIndex = FLines[ALineIndex].EndBlock then AEnd := FLines[ALineIndex].EndWord else AEnd := Items[ABlockIndex].WordCount - 1; end; function TKMemoBlocks.IndexAboveLastLine(AIndex: TKMemoSelectionIndex; AAdjust: Boolean): Boolean; var Block: TKMemoBlock; LineIndex: TKMemoLineIndex; LocalIndex: TKMemoSelectionIndex; begin if AAdjust then EOLToNormal(AIndex); LineIndex := IndexToLineIndex(AIndex); Result := LineIndex < FLines.Count - 1; if not Result then begin Block := IndexToBlock(AIndex, LocalIndex); if Block is TKMemoContainer then Result := TKMemoContainer(Block).Blocks.IndexAboveLastLine(LocalIndex, False) end; end; function TKMemoBlocks.IndexToInnerBlock(AIndex: TKMemoSelectionIndex): TKMemoBlock; var LocalIndex: TKMemoSelectionIndex; begin Result := IndexToBlock(AIndex, LocalIndex); if Result is TKMemoContainer then Result := TKMemoContainer(Result).Blocks.IndexToInnerBlock(LocalIndex); end; function TKMemoBlocks.IndexAtBeginningOfContainer(AIndex: TKMemoSelectionIndex; AAdjust: Boolean): Boolean; var Block: TKMemoBlock; LocalIndex: TKMemoSelectionIndex; begin if AAdjust then EOLToNormal(AIndex); Block := IndexToBlock(AIndex, LocalIndex); if Block is TKMemoContainer then Result := TKMemoContainer(Block).Blocks.IndexAtBeginningOfContainer(LocalIndex, False) else begin NormalToEOL(AIndex); Result := AIndex <= 0; end; end; function TKMemoBlocks.IndexAtEndOfContainer(AIndex: TKMemoSelectionIndex; AAdjust: Boolean): Boolean; var Block: TKMemoBlock; LocalIndex: TKMemoSelectionIndex; begin if AAdjust then EOLToNormal(AIndex); Block := IndexToBlock(AIndex, LocalIndex); if Block is TKMemoContainer then Result := TKMemoContainer(Block).Blocks.IndexAtEndOfContainer(LocalIndex, False) else begin NormalToEOL(AIndex); Result := AIndex >= FSelectableLength; end; end; function TKMemoBlocks.IndexBelowFirstLine(AIndex: TKMemoSelectionIndex; AAdjust: Boolean): Boolean; var Block: TKMemoBlock; LineIndex: TKMemoLineIndex; LocalIndex: TKMemoSelectionIndex; begin if AAdjust then EOLToNormal(AIndex); LineIndex := IndexToLineIndex(AIndex); Result := LineIndex > 0; if not Result then begin Block := IndexToBlock(AIndex, LocalIndex); if Block is TKMemoContainer then Result := TKMemoContainer(Block).Blocks.IndexBelowFirstLine(LocalIndex, False) end; end; function TKMemoBlocks.IndexToBlockIndex(AIndex: TKMemoSelectionIndex; out ALocalIndex: TKMemoSelectionIndex): TKMemoBlockIndex; var I: TKMemoBlockIndex; CurIndex, LastIndex: TKMemoSelectionIndex; begin Result := -1; ALocalIndex := -1; if AIndex >= 0 then begin if AIndex < FSelectableLength then begin I := 0; CurIndex := 0; while (Result < 0) and (I < Count) do begin LastIndex := CurIndex; Inc(CurIndex, Items[I].SelectableLength); if (AIndex >= LastIndex) and (AIndex < CurIndex) then begin Result := I; ALocalIndex := AIndex - LastIndex; end; Inc(I); end; end else if Count > 0 then begin Result := Count - 1; ALocalIndex := Items[Result].SelectableLength; end; end end; function TKMemoBlocks.IndexToBlocks(AIndex: TKMemoSelectionIndex; out ALocalIndex: TKMemoSelectionIndex): TKMemoBlocks; var Block: TKMemoBlock; LocalIndex: TKMemoSelectionIndex; begin Block := IndexToBlock(AIndex, LocalIndex); if Block is TKMemoContainer then Result := TKMemoContainer(Block).Blocks.IndexToBlocks(LocalIndex, ALocalIndex) else begin Result := Self; ALocalIndex := AIndex; end; end; function TKMemoBlocks.IndexToBlock(AIndex: TKMemoSelectionIndex; out ALocalIndex: TKMemoSelectionIndex): TKMemoBlock; var BlockIndex: TKMemoBlockIndex; begin BlockIndex := IndexToBlockIndex(AIndex, ALocalIndex); if BlockIndex >= 0 then Result := Items[BlockIndex] else Result := nil; end; function TKMemoBlocks.IndexToLineIndex(AIndex: TKMemoSelectionIndex): TKMemoLineIndex; var I: TKMemoLineIndex; begin Result := -1; if (AIndex >= 0) and (AIndex < FSelectableLength) then begin for I := 0 to LineCount - 1 do begin if (AIndex >= FLines[I].StartIndex) and (AIndex <= FLines[I].EndIndex) then begin Result := I; Break; end; end; end else if AIndex = FSelectableLength then Result := LineCount - 1; end; function TKMemoBlocks.IndexToRect(ACanvas: TCanvas; AIndex: TKMemoSelectionIndex; ACaret, AAdjust: Boolean): TRect; var LineIndex: TKMemoLineIndex; Tmp: Integer; begin LineIndex := IndexToLineIndex(AIndex); if LineIndex >= 0 then begin Result := LineToRect(ACanvas, AIndex, LineIndex, ACaret); if AAdjust then begin // move the rectangle to the right Tmp := Result.Right - Result.Left; Result.Left := Result.Right; Result.Right := Result.Left + Tmp; end; if not ACaret then begin // expand rect to enable vertical caret movement if (LineIndex > 0) and (Result.Top = LineTop[LineIndex]) then begin Tmp := LineTop[LineIndex] - LineBottom[LineIndex - 1]; if Tmp > 0 then Dec(Result.Top, Tmp); end; if (LineIndex < LineCount - 1) and (Result.Bottom = LineBottom[LineIndex]) then begin Tmp := LineTop[LineIndex + 1] - LineBottom[LineIndex]; if Tmp > 0 then Inc(Result.Bottom, Tmp); end; end; end else Result := Rect(0, 0, 0, Abs(GetDefaultTextStyle.Font.Height)); end; procedure TKMemoBlocks.InsertChar(At: TKMemoSelectionIndex; const AValue: TKChar; AOverWrite: Boolean; ATextStyle: TKMemoTextStyle); var NextIndex: TKMemoSelectionIndex; begin if SelLength <> 0 then begin ClearSelection; At := FSelEnd; end else if AOverwrite then DeleteChar(At); if InsertString(At, True, AValue, ATextStyle) then begin NextIndex := NextIndexByCharCount(At, 1); Select(NextIndex, 0, True, True); end; end; procedure TKMemoBlocks.InsertNewLine(At: TKMemoSelectionIndex); var NextIndex: TKMemoSelectionIndex; AtEnd: Boolean; begin if SelLength > 0 then begin ClearSelection; At := FSelEnd; end; AtEnd := IndexAtEndOfContainer(At, True); // always insert (don't overwrite) if InsertParagraph(At, True) and not AtEnd then begin NextIndex := NextIndexByCharCount(At, 1); Select(NextIndex, 0, True, True); end; end; function TKMemoBlocks.InsertParagraph(AIndex: TKMemoSelectionIndex; AAdjust: Boolean): Boolean; var BlockIndex: TKMemoBlockIndex; LocalIndex: TKMemoSelectionIndex; Block: TKMemoBlock; begin if AAdjust then EOLToNormal(AIndex); LockUpdate; try BlockIndex := IndexToBlockIndex(AIndex, LocalIndex); if BlockIndex >= 0 then begin Block := Items[BlockIndex]; if not (Block is TKMemoContainer) then NormalToEOL(LocalIndex); Result := Block.InsertParagraph(LocalIndex); end else begin AddParagraph; Result := True; end; finally UnlockUpdate; end; end; procedure TKMemoBlocks.InsertPlainText(AIndex: TKMemoSelectionIndex; const AValue: TKString); var I, Ln, St: Integer; S: TKString; begin LockUpdate; try St := 1; I := 1; Ln := Length(Avalue); while I <= Ln do begin if AValue[I] = cLF then begin if I > St then begin S := Copy(AValue, St, I - St); S := UnicodeStringReplace(S, cCR, '', [rfReplaceAll]); // on Unix systems if (S <> '') and InsertString(AIndex, False, S) then begin Inc(AIndex, StringLength(S)); UpdateAttributes; // drb, November 2019 end; end; if InsertParagraph(AIndex, True) then Inc(AIndex); UpdateAttributes; St := I + 1; end; Inc(I); end; if I > St then begin S := Copy(AValue, St, I - St + 1); if S <> '' then if InsertString(AIndex, True, S) then UpdateAttributes; // drb, November 2019 end; finally UnlockUpdate; end; end; function TKMemoBlocks.InsertString(AIndex: TKMemoSelectionIndex; AAdjust: Boolean; const AValue: TKString; ATextStyle: TKMemoTextStyle): Boolean; var BlockIndex: TKMemoBlockIndex; LocalIndex: TKMemoSelectionIndex; Block, NewBlock, LastBlock, NextBlock: TKMemoBlock; begin Result := False; if AAdjust then EOLToNormal(AIndex); LockUpdate; try BlockIndex := IndexToBlockIndex(AIndex, LocalIndex); if BlockIndex >= 0 then begin Block := Items[BlockIndex]; if not (Block is TKMemoContainer) then NormalToEOL(LocalIndex); NewBlock := nil; // get last Block if BlockIndex > 0 then LastBlock := Items[BlockIndex - 1] else LastBlock := nil; // proceed with adding text if ATextStyle <> nil then begin if LocalIndex = 0 then begin // insert new text BlockIndex NewBlock := AddTextBlock(AValue, BlockIndex); end else begin // split current block to add new block with different text style in between NextBlock := Block.Split(LocalIndex); AddAt(NextBlock, BlockIndex + 1); NewBlock := AddTextBlock(AValue, BlockIndex + 1); end; end else if LocalIndex = 0 then begin // we are at local position 0 so we can use previous text block or add new one if (LastBlock is TKMemoTextBlock) and LastBlock.CanAddText then begin // insert character at the end of last BlockIndex Result := LastBlock.InsertString(AValue); end else if Block.CanAddText then begin // insert character at the beginning of current block if previous one cannot be used Result := Block.InsertString(AValue, LocalIndex); end else begin // insert new text block if current block cannot add text NewBlock := AddTextBlock(AValue, BlockIndex); end; end else begin // we are in the middle of current block if Block.CanAddText then begin // current block can insert text, so do it at given location Result := Block.InsertString(AValue, LocalIndex); end else if LocalIndex = Block.ContentLength then begin // current block cannot insert text, so insert new text block // but only when we are at the end of the current block NewBlock := AddTextBlock(AValue, BlockIndex + 1); end; end; if NewBlock <> nil then begin BlockIndex := IndexOf(NewBlock); // get last and next items if BlockIndex > 0 then LastBlock := Items[BlockIndex - 1] else LastBlock := nil; if BlockIndex < Count - 1 then NextBlock := Items[BlockIndex + 1] else NextBlock := nil; // assign attributes from last or next block if LastBlock is TKMemoParagraph then begin // beginning of new line, so take from next text block and, // if there is none, take from last or next paragraph Block := GetNextBlockByClass(BlockIndex, TKMemoTextBlock); if Block <> nil then NewBlock.AssignAttributes(Block) else if NextBlock is TKMemoParagraph then NewBlock.AssignAttributes(NextBlock) else NewBlock.AssignAttributes(LastBlock); end else begin // otherwise take from last text block and, if there is none, // take from next text block Block := GetLastBlockByClass(BlockIndex, TKMemoTextBlock); if Block <> nil then NewBlock.AssignAttributes(Block) else begin Block := GetNextBlockByClass(BlockIndex, TKMemoTextBlock); if Block <> nil then NewBlock.AssignAttributes(Block) else if NextBlock is TKMemoParagraph then NewBlock.AssignAttributes(NextBlock); end; end; if (ATextStyle <> nil) and (NewBlock is TKMemoTextBlock) then TKMemoTextBlock(NewBlock).TextStyle.Assign(ATextStyle); Result := True; end; end else begin AddTextBlock(AValue); Result := True; end; finally UnlockUpdate; end; end; function TKMemoBlocks.InsideOfTable: Boolean; begin if FParent is TKMemoTable then Result := True else if FParent is TKMemoContainer then Result := TKMemoContainer(FParent).ParentBlocks.InsideOfTable else Result := False; end; function TKMemoBlocks.BlockToIndex(ABlock: TKMemoBlock): TKMemoSelectionIndex; var I: TKMemoBlockIndex; LastIndex: TKMemoSelectionIndex; Block: TKMemoBlock; begin Result := -1; if ABlock.Position = mbpText then begin LastIndex := 0; for I := 0 to Count - 1 do begin Block := Items[I]; if ABlock = Block then begin Result := LastIndex; Exit; end else if Block is TKMemoContainer then begin Result := TKMemoContainer(Block).Blocks.BlockToIndex(ABlock); if Result >= 0 then begin Inc(Result, LastIndex); Exit; end; end; Inc(LastIndex, Block.SelectableLength); end; end; end; function TKMemoBlocks.LastTextStyle(ABlockIndex: TKMemoBlockIndex): TKMemoTextStyle; var Block: TKMemoBlock; begin Block := GetLastBlockByClass(ABlockIndex, TKMemoTextBlock); if Block is TKMemoTextBlock then Result := TKMemoTextBlock(Block).TextStyle else Result := DefaultTextStyle; end; function TKMemoBlocks.LineEndIndexByIndex(AIndex: TKMemoSelectionIndex; AAdjust, ASelectionExpanding: Boolean; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; var Block: TKMemoBlock; LineIndex: TKMemoLineIndex; LocalIndex: TKMemoSelectionIndex; begin Result := -1; if AAdjust then EOLToNormal(AIndex); ALinePos := eolInside; Block := IndexToBlock(AIndex, LocalIndex); if Block is TKMemoContainer then begin Result := TKMemoContainer(Block).Blocks.LineEndIndexByIndex(LocalIndex, False, ASelectionExpanding, ALinePos); if Result >= 0 then Inc(Result, AIndex - LocalIndex); end; if Result < 0 then begin LineIndex := IndexToLineIndex(AIndex); if LineIndex >= 0 then begin Result := LineEndIndex[LineIndex]; Block := Items[FLines[LineIndex].EndBlock]; if ASelectionExpanding or not (Block is TKMemoParagraph) then begin ALinePos := eolEnd; Inc(Result); end; end else Result := 0; end; end; function TKMemoBlocks.LineStartIndexByIndex(AIndex: TKMemoSelectionIndex; AAdjust: Boolean; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; var Block: TKMemoBlock; LineIndex: TKMemoLineIndex; LocalIndex: TKMemoSelectionIndex; begin Result := -1; if AAdjust then EOLToNormal(AIndex); ALinePos := eolInside; Block := IndexToBlock(AIndex, LocalIndex); if Block is TKMemoContainer then begin Result := TKMemoContainer(Block).Blocks.LineStartIndexByIndex(LocalIndex, False, ALinePos); if Result >= 0 then Inc(Result, AIndex - LocalIndex); end; if Result < 0 then begin LineIndex := IndexToLineIndex(AIndex); if LineIndex >= 0 then Result := LineStartIndex[LineIndex] else Result := 0; end; end; function TKMemoBlocks.LineToRect(ACanvas: TCanvas; AIndex: TKMemoSelectionIndex; ALineIndex: TKMemoLineIndex; ACaret: Boolean): TRect; var BlockIndex: TKMemoBlockIndex; WordIndex, St, En: TKMemoWordIndex; LastIndex, CurIndex: TKMemoSelectionIndex; Block: TKMemoBlock; TmpRect: TRect; Found, TmpFound: Boolean; begin Result := CreateEmptyRect; if (ALineIndex >= 0) and (ALineIndex < LineCount) then begin Found := False; TmpFound := False; CurIndex := FLines[ALineIndex].StartIndex; BlockIndex := Flines[ALineIndex].StartBlock; while not Found and (BlockIndex <= FLines[ALineIndex].EndBlock) do begin Block := Items[BlockIndex]; if Block.Position = mbpText then begin GetWordIndexes(BlockIndex, ALineIndex, St, En); WordIndex := St; while not Found and (WordIndex <= En) do begin LastIndex := CurIndex; Inc(CurIndex, Block.WordLength[WordIndex]); if (AIndex = CurIndex) and (Block is TKMemoTextBlock) then begin // take rectangle from last WordIndex TmpRect := Block.WordIndexToRect(ACanvas, WordIndex, AIndex - LastIndex - 1, ACaret); TmpFound := not IsRectEmpty(TmpRect); end else if (AIndex >= LastIndex) and (AIndex < CurIndex) then begin Result := Block.WordIndexToRect(ACanvas, WordIndex, AIndex - LastIndex, ACaret); if TmpFound and ACaret then begin // simulate caret height from last WordIndex // it is better for subscripts and superscripts Result.Top := TmpRect.Top; Result.Bottom := TmpRect.Bottom; end; Found := True; end; Inc(WordIndex); end; end; Inc(BlockIndex); end; end; end; procedure TKMemoBlocks.ListChanged(AList: TKMemoList; ALevel: TKMemoListLevel); var I: TKMemoBlockIndex; Block: TKMemoBlock; PA: TKMemoParagraph; begin // update indentation for all list bound paragraphs according to list level info if (AList <> nil) and (ALevel <> nil) then begin LockUpdate; try for I := 0 to Count - 1 do begin Block := Items[I]; if Block is TKMemoParagraph then begin PA := TKmemoParagraph(Block); if (PA.NumberingList = AList) and (ALevel = PA.NumberingListLevel) then begin PA.ParaStyle.FirstIndent := ALevel.FirstIndent; PA.ParaStyle.LeftPadding := ALevel.LeftIndent; end; end else if Block is TKMemoContainer then TKmemoContainer(Block).Blocks.ListChanged(AList, ALevel); end; finally UnlockUpdate; end; end; end; procedure TKMemoBlocks.LoadFromRTFStream(AStream: TStream; AtIndex: TKMemoSelectionIndex); var Reader: TKMemoRTFReader; begin Reader := TKMemoRTFReader.Create(ParentMemo); try Reader.LoadFromStream(AStream, Self, AtIndex); finally Reader.Free; end; end; procedure TKMemoBlocks.MeasureExtent(ACanvas: TCanvas; ARequiredWidth: Integer); function GetParaStyle(AParagraph: TKMemoParagraph): TKMemoParaStyle; begin if AParagraph <> nil then Result := AParagraph.ParaStyle else Result := DefaultParaStyle; end; function RectCollidesWithNonText(const ARect: TRect; var ACollisionRect: TRect): Boolean; var I: Integer; Block: TKMemoBlock; DoCheck: Boolean; begin Result := False; I := 0; while not Result and (I < FRelPos.Count) do begin Block := Items[FRelPos[I].Index]; //if (Block.Position = mbpAbsolute) or (CurBlock > FRelPos[I].Index) then begin ACollisionRect := Block.BoundsRect; KFunctions.OffsetRect(ACollisionRect, Block.LeftOffset, Block.TopOffset); DoCheck := True; case Block.WrapMode of wrAround, wrTight:; wrAroundLeft, wrTightLeft: ACollisionRect.Right := FState.RightX; wrAroundRight, wrTightRight: ACollisionRect.Left := FState.CurParaStyle.LeftPadding; wrTopBottom: begin ACollisionRect.Left := FState.CurParaStyle.LeftPadding; ACollisionRect.Right := FState.RightX; end; else DoCheck := False; end; if DoCheck then Result := RectInRect(ACollisionRect, ARect); end; Inc(I); end; end; function AddLine: Boolean; var NumberBlock: TKmemoTextBlock; procedure MoveWordsOnLine(ALineIndex: TKMemoLineIndex; AStartPos, AEndPos, ADelta: Integer; var AChunkCnt: Integer); var BlockIndex: TKMemoBlockIndex; WordIndex, St, En: TKMemoWordIndex; Block: TKMemoBlock; begin for BlockIndex := FLines[ALineIndex].StartBlock to FLines[ALineIndex].EndBlock do begin Block := Items[BlockIndex]; if Block.Position = mbpText then begin GetWordIndexes(BlockIndex, ALineIndex, St, En); for WordIndex := St to En do begin if (Block.WordLeft[WordIndex] >= AStartPos) and (Block.WordLeft[WordIndex] + Block.WordWidth[WordIndex] <= AEndPos) then Block.WordLeft[WordIndex] := Block.WordLeft[WordIndex] + ADelta; end; end; end; if (AChunkCnt = 0) and (NumberBlock <> nil) then begin for WordIndex := 0 to NumberBlock.WordCount - 1 do begin NumberBlock.WordLeft[WordIndex] := NumberBlock.WordLeft[WordIndex] + ADelta; end; end; Inc(AChunkCnt); end; var Line, LastLine: TKMemoLine; EndBlock, Block: TKMemoBlock; BlockIndex, CurBlockIndexCopy: TKMemoBlockIndex; CurWordIndexCopy, WordIndex, St, En: TKMemoWordIndex; LineIndex: TKMemoLineIndex; CurIndexCopy: TKMemoSelectionIndex; I, W, Delta, FirstIndent, ChunkCnt, LineLeft, LineRight, BaseLine, StPosX, ParaMarkWidth, BottomPadding, TopPadding: Integer; WasParagraph: Boolean; R, RW: TRect; begin Result := False; if FState.LastTotalWord <> FState.CurTotalWord then begin FBackState.Assign(FState); FState.LastTotalWord := FState.CurTotalWord; // create new line if FLines.Count > 0 then LastLine := FLines[TKMemoLineIndex(FLines.Count - 1)] else LastLine := nil; CurIndexCopy := FState.CurIndex; CurWordIndexCopy := FState.CurWordIndex; CurBlockIndexCopy := FState.CurBlockIndex; if (CurWordIndexCopy <= 0) or (CurBlockIndexCopy >= Count) or (Items[CurBlockIndexCopy].Position <> mbpText) then begin I := 0; while (CurBlockIndexCopy > FState.LastBlockIndex) and ((CurBlockIndexCopy >= Count) or (I = 0) or (Items[CurBlockIndexCopy].Position <> mbpText)) do begin Dec(CurBlockIndexCopy); Inc(I); end; CurWordIndexCopy := Items[CurBlockIndexCopy].WordCount - 1; end else begin Dec(CurWordIndexCopy); end; Dec(CurIndexCopy); Line := TKMemoLine.Create; LineIndex := FLines.Add(Line); Line.StartBlock := FState.LastBlockIndex; Line.EndBlock := CurBlockIndexCopy; Line.StartIndex := FState.LastIndex; Line.EndIndex := CurIndexCopy; Line.StartWord := FState.LastWordIndex; Line.EndWord := CurWordIndexCopy; EndBlock := Items[Line.EndBlock]; // get vertical paddings for this line and width of the paragraph mark (this cannot be included into line width) WasParagraph := (LastLine = nil) or (Items[LastLine.EndBlock] is TKMemoParagraph); if WasParagraph then begin FirstIndent := FState.CurParaStyle.FirstIndent; TopPadding := FState.CurParaStyle.TopPadding; if FState.CurParagraph <> nil then NumberBlock := FState.CurParagraph.NumberBlock else NumberBlock := nil; end else begin FirstIndent := 0; TopPadding := 0; NumberBlock := nil; end; if EndBlock is TKMemoParagraph then begin BottomPadding := FState.CurParaStyle.BottomPadding; ParaMarkWidth := EndBlock.WordWidth[EndBlock.WordCount - 1]; end else begin BottomPadding := 0; ParaMarkWidth := 0; end; // get dominant base line BaseLine := 0; for BlockIndex := Line.StartBlock to Line.EndBlock do begin Block := Items[BlockIndex]; if Block.Position = mbpText then BaseLine := Max(BaseLine, Block.CalcAscent(ACanvas)); end; if NumberBlock <> nil then BaseLine := Max(BaseLine, NumberBlock.CalcAscent(ACanvas)); // adjust line and paragraph heights case FState.CurParaStyle.LineSpacingMode of lsmFactor: begin FState.LineHeight := Round(FState.CurParaStyle.LineSpacingFactor * FState.LineHeight); end; lsmValue: begin if FState.CurParaStyle.LineSpacingValue > 0 then FState.LineHeight := Max(FState.LineHeight, FState.CurParaStyle.LineSpacingValue) else if FState.CurParaStyle.LineSpacingValue < 0 then FState.LineHeight := -FState.CurParaStyle.LineSpacingValue; end; end; Inc(FState.LineHeight, TopPadding + BottomPadding); // adjust all words horizontally if FState.CurParaStyle.HAlign in [halCenter, halRight] then begin // reposition all line chunks like MS WordIndex does it FState.PosX := FState.CurParaStyle.LeftPadding + FirstIndent; StPosX := FState.PosX; W := 0; ChunkCnt := 0; for BlockIndex := Line.StartBlock to Line.EndBlock do begin Block := Items[BlockIndex]; if Block.Position = mbpText then begin GetWordIndexes(BlockIndex, LineIndex, St, En); for WordIndex := St to En do begin if Block.WordLeft[WordIndex] > FState.PosX then begin // space here, get colliding rect RW := Rect(FState.PosX, FState.PosY, FState.PosX + Block.WordWidth[WordIndex], FState.PosY + FState.LineHeight); if RectCollidesWithNonText(RW, R) then begin Delta := R.Left - StPosX - W; case FState.CurParaStyle.HAlign of halCenter: Delta := Delta div 2; end; MoveWordsOnLine(LineIndex, StPosX, R.Left, Delta, ChunkCnt); end; FState.PosX := Block.WordLeft[WordIndex]; StPosX := FState.PosX; W := 0; end; Inc(FState.PosX, Block.WordWidth[WordIndex]); Inc(W, Block.WordWidth[WordIndex]); end; end; end; RW := Rect(StPosX, FState.PosY, FState.RightX + ParaMarkWidth, FState.PosY + FState.LineHeight); if RectCollidesWithNonText(RW, R) then Delta := R.Left - StPosX - W else Delta := FState.RightX + ParaMarkWidth - StPosX - W; case FState.CurParaStyle.HAlign of halCenter: Delta := Delta div 2; end; MoveWordsOnLine(LineIndex, StPosX, FState.RightX + ParaMarkWidth, Delta, ChunkCnt); end; // adjust all words vertically, compute line extent LineRight := FState.CurParaStyle.LeftPadding; LineLeft := FState.RightX; for BlockIndex := Line.StartBlock to Line.EndBlock do begin Block := Items[BlockIndex]; if Block.Position = mbpText then begin GetWordIndexes(BlockIndex, LineIndex, St, En); for WordIndex := St to En do begin Block.WordBaseLine[WordIndex] := BaseLine; Block.WordBottomPadding[WordIndex] := BottomPadding; Block.WordHeight[WordIndex] := FState.LineHeight; Block.WordTopPadding[WordIndex] := TopPadding; R := Block.WordBoundsRect[WordIndex]; LineLeft := Min(LineLeft, R.Left); LineRight := Max(LineRight, R.Right); end; end; end; if NumberBlock <> nil then begin for WordIndex := 0 to NumberBlock.WordCount - 1 do begin NumberBlock.WordBaseLine[WordIndex] := BaseLine; NumberBlock.WordBottomPadding[WordIndex] := BottomPadding; NumberBlock.WordHeight[WordIndex] := FState.LineHeight; NumberBlock.WordTopPadding[WordIndex] := TopPadding; R := NumberBlock.WordBoundsRect[WordIndex]; LineLeft := Min(LineLeft, R.Left); LineRight := Max(LineRight, R.Right); end; end; // adjust paragraph extent if LineRight > ARequiredWidth then Dec(LineRight, ParaMarkWidth); FState.ParaWidth := Max(FState.ParaWidth, LineRight - LineLeft); if EndBlock is TKMemoParagraph then begin TKMemoParagraph(EndBlock).Top := FState.ParaPosY; TKmemoParagraph(EndBlock).Width := FState.ParaWidth; TKmemoParagraph(EndBlock).Height := FState.PosY + FState.LineHeight - FState.ParaPosY - FState.CurParaStyle.BottomPadding; FState.CurParagraph := GetNearestParagraphBlock(FState.CurBlockIndex); FState.CurParaStyle := GetParaStyle(FState.CurParagraph); FState.ParaWidth := 0; FState.ParaPosY := FState.PosY + FState.LineHeight + FState.CurParaStyle.TopPadding; end; // adjust line extent Line.Extent := Point(LineRight - LineLeft, FState.LineHeight); Line.Position := Point(LineLeft, FState.PosY); // other tasks FExtent.X := Max(FExtent.X, LineRight); FState.PosX := FState.CurParaStyle.LeftPadding; if EndBlock is TKMemoParagraph then begin Inc(FState.PosX, FState.CurParaStyle.FirstIndent); end; FState.RightX := ARequiredWidth - FState.CurParaStyle.RightPadding; Inc(FState.PosY, FState.LineHeight); FExtent.Y := Max(FExtent.Y, FState.PosY); FState.LastBlockIndex := FState.CurBlockIndex; FState.LastWordIndex := FState.CurWordIndex; FState.LastIndex := FState.CurIndex; FState.LineHeight := 0; Result := True; end; end; procedure DeleteLine; begin if FLines.Count > 0 then begin FLines.Delete(FLines.Count - 1); FState.Assign(FBackState); end; end; procedure MoveWordToFreeSpace(AWordWidth, AWordHeight: Integer); var TmpHeight: Integer; R: TRect; begin if AWordWidth <> 0 then begin TmpHeight := Max(FState.LineHeight, AWordHeight); while RectCollidesWithNonText(Rect(FState.PosX, FState.PosY, FState.PosX + AWordWidth, FState.PosY + TmpHeight), R) do begin FState.PosX := R.Right; if FState.PosX + AWordWidth > FState.RightX then begin if not AddLine then Inc(FState.PosY, 5); FState.PosX := FState.CurParaStyle.LeftPadding; end; end; end; end; function MeasureNextWords(ACanvas: TCanvas; ACurBlock: TKMemoBlockIndex; ACurWord: TKMemoWordIndex; ARequiredWidth: Integer; IsBreakable: Boolean; var ANBExtent: TPoint): TPoint; var Block: TKMemoBlock; Extent: TPoint; WLen, MaxWLen: Integer; begin Block := Items[ACurBlock]; Result := Block.WordMeasureExtent(ACanvas, ACurWord, ARequiredWidth); ANBExtent := Result; if not IsBreakable then begin Inc(ACurWord); if ACurWord >= Block.WordCount then begin ACurWord := 0; Inc(ACurBlock); end; WLen := 0; MaxWLen := getMaxWordLength; while not IsBreakable and (ACurBlock < Count) and (WLen < MaxWLen) do begin Block := Items[ACurBlock]; if (Block is TKMemoParagraph) or not (Block is TKMemoTextBlock) then IsBreakable := True else begin while not IsBreakable and (ACurWord < Block.WordCount) do begin IsBreakable := Block.WordBreakable[ACurWord]; Extent := Block.WordMeasureExtent(ACanvas, ACurWord, ARequiredWidth); Inc(ANBExtent.X, Extent.X); ANBExtent.Y := Max(ANBExtent.Y, Extent.Y); Inc(WLen, Block.WordLength[ACurWord]); Inc(ACurWord); end; ACurWord := 0; Inc(ACurBlock); end; end; end; end; var Extent, NBExtent: TPoint; I, FirstIndent, WLen, PrevPosX, PrevPosY: Integer; WordIndex: TKMemoWordIndex; OutSide, WasBreakable, WasParagraph: Boolean; Block: TKMemoBlock; NextParagraph: TKMemoParagraph; NextParaStyle: TKMemoParaStyle; S: TKString; begin // this is the main WordIndex processing calculation FExtent := CreateEmptyPoint; if not (FState.Initialized and (FUpdateReasons = [muContentAddOnly]) and (ARequiredWidth = FState.RequiredWidth)) then begin // measure everything, needed after most modifications FLines.Clear; FBackState.Clear; FState.Clear; FState.RequiredWidth := ARequiredWidth; FState.CurParagraph := GetNearestParagraphBlock(0); FState.CurParaStyle := GetParaStyle(FState.CurParagraph); FState.PosX := FState.CurParaStyle.LeftPadding + FState.CurParaStyle.FirstIndent; FState.ParaPosY := FState.CurParaStyle.TopPadding; FState.RightX := ARequiredWidth - FState.CurParaStyle.RightPadding; FState.IsBreakable := True; FState.IsParagraph := False; end else begin // here we don't start from beginning and measure just // the newly added blocks; // it can be used only for blocks added at the end and // placed in text if not FState.IsParagraph then DeleteLine; // continue on previous line when no paragraph was added end; // first measure all absolutely positioned items for I := 0 to FRelPos.Count - 1 do begin Block := Items[FRelPos.Items[I].Index]; Block.MeasureExtent(ACanvas, ARequiredWidth); end; // then measure all other items while FState.CurBlockIndex < Count do begin FState.CurWordIndex := 0; if FState.IsParagraph or (FState.CurBlockIndex = 0) then begin NextParagraph := GetNearestParagraphBlock(FState.CurBlockIndex); NextParaStyle := GetParaStyle(NextParagraph); if NextParagraph <> nil then Block := NextParagraph.NumberBlock else Block := nil; if Block <> nil then begin // we must include the nonselectable bullet/number block into normal text flow AddLine; FState.IsParagraph := False; NBExtent.X := 0; for WordIndex := 0 to Block.WordCount - 1 do begin Extent := Block.WordMeasureExtent(ACanvas, WordIndex, 0); // align the text following the bullet/number within paragraph, if possible S := Block.Words[WordIndex]; if (S = cTab) and (NBExtent.X < -NextParaStyle.FirstIndent) then begin Extent.X := -NextParaStyle.FirstIndent - NBExtent.X; Block.WordWidth[WordIndex] := Extent.X; Block.WordClipped[WordIndex] := True; end; if FRelPos.Count > 0 then MoveWordToFreeSpace(Extent.X, Extent.Y); Block.WordLeft[WordIndex] := FState.PosX; Block.WordTop[WordIndex] := FState.PosY; Inc(FState.PosX, Extent.X); FState.LineHeight := Max(FState.LineHeight, Extent.Y); Inc(NBExtent.X, Extent.X); end; end end else NextParaStyle := FState.CurParaStyle; Block := Items[FState.CurBlockIndex]; case Block.Position of mbpText: begin while FState.CurWordIndex < Block.WordCount do begin WasParagraph := FState.IsParagraph; FState.IsParagraph := (Block is TKMemoParagraph) and (FState.CurWordIndex = Block.WordCount - 1); WLen := Block.WordLength[FState.CurWordIndex]; WasBreakable := FState.IsBreakable or not (Block is TKMemoTextBlock); FState.IsBreakable := Block.WordBreakable[FState.CurWordIndex]; if WasParagraph then FirstIndent := NextParaStyle.FirstIndent else FirstIndent := 0; Extent := MeasureNextWords(ACanvas, FState.CurBlockIndex, FState.CurWordIndex, ARequiredWidth - NextParaStyle.LeftPadding - NextParaStyle.RightPadding - FirstIndent, FState.IsBreakable, NBExtent); OutSide := FState.CurParaStyle.WordWrap and not FState.IsParagraph and WasBreakable and (FState.PosX + NBExtent.X > FState.RightX); if OutSide or WasParagraph then AddLine; if FRelPos.Count > 0 then MoveWordToFreeSpace(NBExtent.X, NBExtent.Y); Block.WordLeft[FState.CurWordIndex] := FState.PosX; Block.WordTop[FState.CurWordIndex] := FState.PosY; Inc(FState.PosX, Extent.X); FState.LineHeight := Max(FState.LineHeight, Extent.Y); Inc(FState.CurWordIndex); Inc(FState.CurIndex, WLen); Inc(FState.CurTotalWord); end; end; mbpRelative: begin // position relative block correctly PrevPosX := FState.PosX; PrevPosY := FState.PosY; try // starting position for relative object is currently always: X by column (currently always 0), Y by paragraph // the object position offsets (LeftOffset, TopOffset) are always counted from this default position FState.PosX := 0; FState.PosY := FState.ParaPosY; //MoveWordToFreeSpace(Block.Width, Block.Height); Block.WordLeft[0] := FState.PosX; Block.WordTop[0] := FState.PosY; FExtent.X := Max(FExtent.X, FState.PosX + Block.Width + Block.LeftOffset); FExtent.Y := Max(FExtent.Y, FState.PosY + Block.Height + Block.TopOffset); finally FState.PosX := PrevPosX; FState.PosY := PrevPosY; end; // always place object anchor to the beginning of new paragraph if FState.IsParagraph then begin AddLine; FState.IsParagraph := False; end; end; mbpAbsolute: begin FExtent.X := Max(FExtent.X, Block.Width + Block.LeftOffset); FExtent.Y := Max(FExtent.Y, Block.Height + Block.TopOffset); end; end; Inc(FState.CurBlockIndex); end; if FState.CurIndex > FState.LastIndex then begin FState.CurWordIndex := 0; AddLine; end; end; function TKMemoBlocks.MouseAction(AAction: TKMemoMouseAction; ACanvas: TCanvas; const APoint: TPoint; AShift: TShiftState): Boolean; var LineIndex: TKMemoLineIndex; BlockIndex: TKmemoBlockIndex; WordIndex, St, En: TKMemoWordIndex; I: Integer; Block: TKmemoBlock; begin Result := False; for LineIndex := 0 to LineCount - 1 do begin if (LineTop[LineIndex] <= APoint.Y) and (APoint.Y < LineBottom[LineIndex]) or (AAction in [maLeftUp, maRightUp, maMidUp]) then begin for BlockIndex := FLines[LineIndex].StartBlock to FLines[LineIndex].EndBlock do begin Block := Items[BlockIndex]; if Block.Position = mbpText then begin GetWordIndexes(BlockIndex, LineIndex, St, En); for WordIndex := St to En do begin Result := Block.WordMouseAction(ACanvas, WordIndex, AAction, APoint, AShift); if Result then Exit; end; end; end; end; end; for I := FRelPos.Count - 1 downto 0 do // reversed Z-order here begin Block := Items[FRelPos[I].Index]; Result := Block.WordMouseAction(ACanvas, 0, AAction, APoint, AShift); if Result then Exit; end; end; function TKMemoBlocks.NextIndexByCharCount(AIndex: TKMemoSelectionIndex; ACharCount: Integer): TKMemoSelectionIndex; begin Result := AIndex + ACharCount; end; function TKMemoBlocks.NextIndexByHorzExtent(ACanvas: TCanvas; AIndex: TKMemoSelectionIndex; AWidth: Integer; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; var R: TRect; P: TPoint; begin R := IndexToRect(ACanvas, AIndex, True, EOLToNormal(AIndex)); Result := PointToIndex(ACanvas, Point(R.Left + AWidth, R.Top), True, False, ALinePos); if AIndex = Result then begin R := IndexToRect(ACanvas, AIndex, False, EOLToNormal(AIndex)); if AWidth > 0 then P := Point(R.Right, R.Top) else P := Point(R.Left - 1, R.Top); Result := PointToIndex(ACanvas, P, True, False, ALinePos); end; end; function TKMemoBlocks.NextIndexByRowDelta(ACanvas: TCanvas; AIndex: TKMemoSelectionIndex; ARowDelta, ALeftPos: Integer; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; var R: TRect; Y: Integer; begin R := IndexToRect(ACanvas, AIndex, False, EOLToNormal(AIndex)); if ARowDelta >= 0 then Y := R.Bottom else Y := R.Top - 1; Result := PointToIndex(ACanvas, Point(ALeftPos, Y), True, False, ALinePos); end; function TKMemoBlocks.NextIndexByVertExtent(ACanvas: TCanvas; AIndex: TKMemoSelectionIndex; AHeight, ALeftPos: Integer; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; var R: TRect; P: TPoint; begin R := IndexToRect(ACanvas, AIndex, True, EOLToNormal(AIndex)); Result := PointToIndex(ACanvas, Point(ALeftPos, R.Top + AHeight), True, False, ALinePos); if AIndex = Result then begin R := IndexToRect(ACanvas, AIndex, False, EOLToNormal(AIndex)); if AHeight > 0 then P := Point(ALeftPos, R.Bottom) else P := Point(ALeftPos, R.Top - 1); Result := PointToIndex(ACanvas, P, True, False, ALinePos); end; end; function TKMemoBlocks.NextIndexByVertValue(ACanvas: TCanvas; AValue, ALeftPos: Integer; ADirection: Boolean; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; var Y: Integer; R: TRect; begin R := CreateEmptyRect; Y := AValue; repeat if ADirection then Dec(Y, R.Bottom - R.Top) else Inc(Y, R.Bottom - R.Top); Result := PointToIndex(ACanvas, Point(ALeftPos, Y), True, False, ALinePos); R := IndexToRect(ACanvas, Result, True, False); until (ADirection and (R.Bottom <= AValue)) or (not ADirection and (R.Top >= AValue)); end; function TKMemoBlocks.NormalToEOL(var AIndex: TKMemoSelectionIndex): Boolean; begin Result := False; if GetLinePosition = eolEnd then begin Inc(AIndex); Result := True; end; end; procedure TKMemoBlocks.Notify(Ptr: Pointer; Action: TListNotification); var BlockIndex: TKMemoBlockIndex; begin inherited; case Action of lnAdded: begin // allow much faster incremental measurement of blocks // it can be used only for top level blocks added at the end // with position in text if (TKMemoBlock(Ptr).Position = mbpText) and (TKMemoBlock(Ptr).ParentRootBlocks = TKMemoBlock(Ptr).ParentBlocks) then begin BlockIndex := IndexOf(Ptr); if BlockIndex = Count - 1 then Update([muContentAddOnly]) else Update([muContent]); end else Update([muContent]); end else Update([muContent]); end; end; procedure TKMemoBlocks.NotifyDefaultParaChange; var BlockIndex: TKMemoBlockIndex; begin for BlockIndex := 0 to Count - 1 do Items[BlockIndex].NotifyDefaultParaChange; end; procedure TKMemoBlocks.NotifyDefaultTextChange; var BlockIndex: TKMemoBlockIndex; begin for BlockIndex := 0 to Count - 1 do Items[BlockIndex].NotifyDefaultTextChange; end; procedure TKMemoBlocks.NotifyOptionsChange; var BlockIndex: TKMemoBlockIndex; begin for BlockIndex := 0 to Count - 1 do Items[BlockIndex].NotifyOptionsChange; end; procedure TKMemoBlocks.NotifyPrintBegin; var BlockIndex: TKMemoBlockIndex; begin for BlockIndex := 0 to Count - 1 do Items[BlockIndex].NotifyPrintBegin; end; procedure TKMemoBlocks.NotifyPrintEnd; var BlockIndex: TKMemoBlockIndex; begin for BlockIndex := 0 to Count - 1 do Items[BlockIndex].NotifyPrintEnd; end; procedure TKMemoBlocks.PaintLineBackground(ACanvas: TCanvas; ALineIndex: TKMemoLineIndex; ALeft, ATop: Integer); var R, RClip: TRect; PA: TKMemoParagraph; PrevRgn: HRGN; //Tmp: TRect; begin PA := GetNearestParagraphBlock(FLines[ALineIndex].StartBlock); if (PA <> nil) and ((PA.ParaStyle.Brush.Style <> bsClear) or (PA.ParaStyle.BorderWidth > 0) or PA.ParaStyle.BorderWidths.NonZero) then begin R := Rect(0, 0, Max(FState.RequiredWidth, PA.Width), PA.Height); KFunctions.OffsetRect(R, PA.Left, PA.Top); RClip := R; RClip.Top := Max(RClip.Top, LineTop[ALineIndex]); RClip.Bottom := Min(RClip.Bottom, LineBottom[ALineIndex]); KFunctions.OffsetRect(R, ALeft, ATop); KFunctions.OffsetRect(RClip, ALeft, ATop); //GetCLipBox(ACanvas.Handle, Tmp); // debug line //TranslateRectToDevice(ACanvas.Handle, Tmp); // debug line TranslateRectToDevice(ACanvas.Handle, RClip); PrevRgn := RgnCreateAndGet(ACanvas.Handle); try if ExtSelectClipRect(ACanvas.Handle, RClip, RGN_AND, PrevRgn) then PA.ParaStyle.PaintBox(ACanvas, R); finally RgnSelectAndDelete(ACanvas.Handle, PrevRgn); end; ACanvas.Refresh; end; end; procedure TKMemoBlocks.PaintLineInfo(ACanvas: TCanvas; ALineIndex: TKMemoLineIndex; ALeft, ATop: Integer); var R: TRect; begin R := LineRect[ALineIndex]; KFunctions.OffsetRect(R, ALeft, ATop); ACanvas.Brush.Style := bsClear; ACanvas.Font.Size := 8; ACanvas.Font.Color := clWindowText; ACanvas.Font.Style := []; ACanvas.Rectangle(R); ACanvas.TextOut(R.Right, R.Top, IntToStr(Flines[ALineIndex].StartBlock)); ACanvas.TextOut(R.Right + 20, R.Top, IntToStr(Flines[ALineIndex].EndBlock)); ACanvas.TextOut(R.Right + 40, R.Top, IntToStr(Flines[ALineIndex].StartWord)); ACanvas.TextOut(R.Right + 60, R.Top, IntToStr(Flines[ALineIndex].EndWord)); end; procedure TKMemoBlocks.PaintToCanvas(ACanvas: TCanvas; ALeft, ATop: Integer; const ARect: TRect); var BlockIndex: TKMemoBlockIndex; LineIndex: TKMemoLineIndex; WordIndex, St, En: TKMemoWordIndex; I: Integer; R: TRect; Block: TKMemoBlock; begin // paint text blocks for LineIndex := 0 to LineCount - 1 do begin if (LineBottom[LineIndex] + ATop >= ARect.Top) and (LineTop[LineIndex] + ATop < ARect.Bottom) then begin // fill areas under paragraphs if LineFloat[LineIndex] then begin PaintLineBackground(ACanvas, LineIndex, ALeft, ATop); end; // then paint text blocks for BlockIndex := FLines[LineIndex].StartBlock to FLines[LineIndex].EndBlock do begin Block := Items[BlockIndex]; if Block.Position = mbpText then begin GetWordIndexes(BlockIndex, LineIndex, St, En); for WordIndex := St to En do Block.WordPaintToCanvas(ACanvas, WordIndex, ALeft, ATop); end; end; // paint LineIndex info, only for debug purposes //PaintLineInfo(ACanvas, LineIndex, ALeft, ATop); end; end; // paint numbering blocks for BlockIndex := 0 to Count - 1 do begin Block := Items[BlockIndex]; if Block is TKMemoParagraph then begin Block := TKMemoParagraph(Block).NumberBlock; if Block <> nil then begin R := Block.BoundsRect; KFunctions.OffsetRect(R, ALeft, ATop); if RectInRect(ARect, R) then Block.PaintToCanvas(ACanvas, ALeft, ATop); end; end; end; // paint relative or absolute blocks for I := 0 to FRelPos.Count - 1 do begin Block := Items[FRelPos[I].Index]; R := Block.BoundsRect; KFunctions.OffsetRect(R, Block.LeftOffset + ALeft, Block.TopOffset + ATop); if RectInRect(ARect, R) then Block.PaintToCanvas(ACanvas, ALeft, ATop); end; end; function TKMemoBlocks.PointToIndex(ACanvas: TCanvas; const APoint: TPoint; AOutOfArea, ASelectionExpanding: Boolean; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; var LineIndex: TKMemoLineIndex; BeforeFirst, AfterLast, InBetween: Boolean; begin Result := -1; if LineCount > 0 then begin LineIndex := 0; while (Result < 0) and (LineIndex < LineCount) do begin BeforeFirst := (LineIndex = 0) and (APoint.Y < LineTop[LineIndex]); // point below first LineIndex AfterLast := (LineIndex = LineCount - 1) and (APoint.Y >= LineBottom[LineIndex]); // point after last LineIndex InBetween := (LineIndex > 0) and (APoint.Y < LineTop[LineIndex]) and (Apoint.Y >= LineBottom[LineIndex - 1]); // point between two lines if (APoint.Y >= LineTop[LineIndex]) and (APoint.Y < LineBottom[LineIndex]) or AOutOfArea and (BeforeFirst or AfterLast or InBetween) then begin Result := PointToIndexOnLine(ACanvas, LineIndex, APoint, AOutOfArea, ASelectionExpanding, ALinePos) end; Inc(LineIndex); end; end; end; function TKMemoBlocks.PointToIndexOnLine(ACanvas: TCanvas; ALineIndex: TKMemoLineIndex; const APoint: TPoint; AOutOfArea, ASelectionExpanding: Boolean; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; var BlockIndex: TKMemoBlockIndex; WordIndex, St, En: TKMemoWordIndex; Index, LocalIndex: TKMemoSelectionIndex; X, XOld: Integer; Block: TKMemoBlock; begin Result := -1; ALinePos := eolInside; if (ALineIndex >= 0) and (ALineIndex < LineCount) then begin Index := FLines[ALineIndex].StartIndex; BlockIndex := FLines[ALineIndex].StartBlock; X := LineLeft[ALineIndex]; while (Result < 0) and (BlockIndex <= FLines[ALineIndex].EndBlock) do begin Block := Items[BlockIndex]; if Block.Position = mbpText then begin GetWordIndexes(BlockIndex, ALineIndex, St, En); WordIndex := St; while (Result < 0) and (WordIndex <= En) do begin XOld := X; X := Block.WordLeft[WordIndex]; LocalIndex := Block.WordPointToIndex(ACanvas, APoint, WordIndex, AOutOfArea, ASelectionExpanding, ALinePos); if LocalIndex >= 0 then begin Result := Index + LocalIndex; end else if (XOld <= APoint.X) and (APoint.X < X) then begin // the point lies between words Result := Index; end; Inc(Index, Block.WordLength[WordIndex]); Inc(WordIndex); end; end; Inc(BlockIndex); end; if (Result < 0) and AOutOfArea then begin if (APoint.X >= LineRight[ALineIndex]) then begin Result := LineEndIndex[ALineIndex]; Block := Items[FLines[ALineIndex].EndBlock]; if ASelectionExpanding or not ((Block is TKMemoContainer) or (Block is TKMemoParagraph)) then begin ALinePos := eolEnd; Inc(Result); end; end else if (APoint.X < LineLeft[ALineIndex]) then begin Result := LineStartIndex[ALineIndex]; end else begin // this should not happen but we must handle this case Result := (LineStartIndex[ALineIndex] + LineEndIndex[ALineIndex]) div 2; end; end; end; end; function TKMemoBlocks.PointToBlocks(const APoint: TPoint): TKMemoBlocks; var BlockIndex: TKMemoBlockIndex; I: Integer; Block: TKMemoBlock; R: TRect; P: TPoint; begin Result := nil; for I := 0 to FRelPos.Count - 1 do begin Block := Items[FRelPos[I].Index]; if Block is TKMemoContainer then begin R := Block.BoundsRect; KFunctions.OffsetRect(R, Block.LeftOffset, Block.TopOffset); if PtInRect(R, APoint) then begin Result := TKMemoContainer(Block).Blocks; Break; end; end; end; if Result = nil then begin for BlockIndex := 0 to Count - 1 do begin Block := Items[BlockIndex]; if Block is TKMemoContainer then begin P := APoint; OffsetPoint(P, -TKMemoContainer(Block).Left - TKMemoContainer(Block).BlockStyle.AllPaddingsLeft, -TKMemoContainer(Block).Top - TKMemoContainer(Block).BlockStyle.AllPaddingsTop); Result := TKMemoContainer(Block).Blocks.PointToBlocks(P); if Result <> nil then break; end; end; end; end; function TKMemoBlocks.PointToRelativeBlock(const APoint: TPoint): TKMemoBlock; var Block: TKMemoBlock; I: Integer; R: TRect; begin Result := nil; for I := 0 to FRelPos.Count - 1 do begin Block := Items[FRelPos[I].Index]; R := Block.BoundsRect; KFunctions.OffsetRect(R, Block.LeftOffset, Block.TopOffset); if PtInRect(R, APoint) then begin Result := Block; Exit; end; end; end; procedure TKMemoBlocks.RestoreUpdateState(AValue: TKMemoUpdateReasons); begin FUpdateReasons := AValue; end; procedure TKMemoBlocks.SaveToRTFStream(AStream: TStream; ASelectedOnly: Boolean); var Writer: TKMemoRTFWriter; begin Writer := TKMemoRTFWriter.Create(ParentMemo); try Writer.SaveToStream(AStream, ASelectedOnly, Self); finally Writer.Free; end; end; function TKMemoBlocks.SaveUpdateState: TKMemoUpdateReasons; begin Result := FUpdateReasons; end; function TKMemoBlocks.Select(ASelStart, ASelLength: TKMemoSelectionIndex; ADoScroll: Boolean; ATextOnly: Boolean): Boolean; var BlockIndex: TKMemoBlockIndex; LastIndex, CurIndex, NewSelEnd, MaxIndex, LocalSelLength: TKMemoSelectionIndex; Block: TKMemoBlock; begin NewSelEnd := ASelStart + ASelLength; if FLines.Count > 0 then Block := Items[FLines[TKMemoLineIndex(FLines.Count - 1)].EndBlock] else Block := nil; if (ASelLength <> 0) or not (Block is TKMemoParagraph) then MaxIndex := FSelectableLength else MaxIndex := FSelectableLength - 1; NewSelEnd := MinMax(NewSelEnd, -1, MaxIndex); ASelStart := MinMax(ASelStart, -1, MaxIndex); if (ASelStart <> FSelStart) or (NewSelEnd <> FSelEnd) then begin FSelStart := ASelStart; FSelEnd := NewSelEnd; CurIndex := 0; LockUpdate; try // children have always FSelEnd >= FSelStart if NewSelEnd < ASelStart then KFunctions.Exchange(Integer(ASelStart), Integer(NewSelEnd)); for BlockIndex := 0 to Count - 1 do begin Block := Items[BlockIndex]; if Block.Position = mbpText then begin LastIndex := CurIndex; Inc(CurIndex, Block.SelectableLength); if (ASelStart >= LastIndex) and (NewSelEnd < CurIndex) then begin // selection within the same block Block.Select(ASelStart - LastIndex, NewSelEnd - ASelStart, ADoScroll); end else if (ASelStart >= LastIndex) and (ASelStart < CurIndex) and (NewSelEnd >= CurIndex) then // selection starts in this block Block.Select(ASelStart - LastIndex, CurIndex - ASelStart, ADoScroll) else if (ASelStart < LastIndex) and (NewSelEnd >= LastIndex) and (NewSelEnd < CurIndex) then // selection ends in this block Block.Select(0, NewSelEnd - LastIndex, ADoScroll) else if (ASelStart <= LastIndex) and (NewSelEnd >= CurIndex) then begin // selection goes through this block if not ATextOnly and ((ASelLength <> 0) and (Block.Position <> mbpText)) then LocalSelLength := Block.SelectableLength(True) else LocalSelLength := CurIndex - LastIndex; Block.Select(0, LocalSelLength, ADoScroll) end else Block.Select(-1, 0, ADoScroll); end; end; if ADoScroll then begin Exclude(FUpdateReasons, muSelection); Include(FUpdateReasons, muSelectionScroll) end else begin Include(FUpdateReasons, muSelection); Exclude(FUpdateReasons, muSelectionScroll); end; finally UnlockUpdate; end; Result := True end else Result := False; end; procedure TKMemoBlocks.SetExtent(AWidth, AHeight: Integer); begin FExtent := Point(AWidth, AHeight); end; procedure TKMemoBlocks.SetRangeParaStyle(AFrom, ATo: TKMemoSelectionIndex; AStyle: TKMemoParaStyle); var BlockIndex: TKMemoBlockIndex; CurIndex, LastIndex: TKMemoSelectionIndex; Block: TKMemoBlock; WasRange: Boolean; begin if AFrom > ATo then Exchange(AFrom, ATo); LockUpdate; try WasRange := False; CurIndex := 0; for BlockIndex := 0 to Count - 1 do begin Block := Items[BlockIndex]; LastIndex := CurIndex; Inc(CurIndex, Block.SelectableLength); if (LastIndex <= ATo) and (AFrom < CurIndex) then begin WasRange := True; if Block is TKMemoParagraph then // selection through this block TKMemoParagraph(Block).ParaStyle.Assign(AStyle) else if Block is TKMemoContainer then TKMemoContainer(Block).Blocks.SetRangeParaStyle(AFrom - LastIndex, ATo - LastIndex, AStyle) end else if WasRange and (Block is TKMemoParagraph) then begin // this is the nearest paragraph TKMemoParagraph(Block).ParaStyle.Assign(AStyle); WasRange := False; end; end; finally UnlockUpdate; end; end; procedure TKMemoBlocks.SetRangeTextStyle(AFrom, ATo: TKMemoSelectionIndex; AStyle: TKMemoTextStyle); var BlockIndex: TKMemoBlockIndex; CurIndex, LastIndex: TKMemoSelectionIndex; Block, Block1, Block2: TKMemoBlock; begin if AFrom > ATo then Exchange(AFrom, ATo); LockUpdate; try BlockIndex := 0; CurIndex := 0; while BlockIndex < Count do begin Block := Items[BlockIndex]; LastIndex := CurIndex; Inc(CurIndex, Block.SelectableLength); if Block is TKMemoContainer then begin if (LastIndex <= ATo) and (AFrom < CurIndex) then TKMemoContainer(Block).Blocks.SetRangeTextStyle(AFrom - LastIndex, ATo - LastIndex, AStyle) end else if Block is TKMemoTextBlock then begin if (AFrom <= LastIndex) and (ATo >= CurIndex) then begin // selection goes through this block TKMemoTextBlock(Block).TextStyle.Assign(AStyle); end else if (AFrom > LastIndex) and (ATo < CurIndex) then begin // selection within the same block, split it to three parts Block1 := Block.Split(AFrom - LastIndex); if Block1 <> nil then begin Inc(BlockIndex); AddAt(Block1, BlockIndex); Block2 := Block1.Split(ATo - AFrom); if Block2 <> nil then begin Inc(BlockIndex); AddAt(Block2, BlockIndex); end; TKMemoTextBlock(Block1).TextStyle.Assign(AStyle); end; end else if (AFrom > LastIndex) and (AFrom < CurIndex) and (ATo >= CurIndex) then begin // selection starts in this block, split it to two parts Block1 := Block.Split(AFrom - LastIndex); if Block1 <> nil then begin Inc(BlockIndex); AddAt(Block1, BlockIndex); TKMemoTextBlock(Block1).TextStyle.Assign(AStyle); end; end else if (AFrom <= LastIndex) and (ATo > LastIndex) and (ATo < CurIndex) then begin // selection ends in this block, split it to two parts Block1 := Block.Split(ATo - LastIndex); if Block1 <> nil then begin Inc(BlockIndex); AddAt(Block1, BlockIndex); TKMemoTextBlock(Block).TextStyle.Assign(AStyle); end; end; end; Inc(BlockIndex); end; finally UnlockUpdate; end; end; procedure TKMemoBlocks.SetIgnoreParaMark(const Value: Boolean); begin if Value <> FIgnoreParaMark then begin FIgnoreParaMark := Value; Update([muExtent]); end; end; procedure TKMemoBlocks.SetItem(Index: TKMemoBlockIndex; const Value: TKMemoBlock); begin inherited SetItem(Index, Value); end; procedure TKMemoBlocks.SetLineText(ALineIndex: TKMemoLineIndex; const AValue: TKString); var St, Len: TKMemoSelectionIndex; PA: TKMemoParagraph; begin if (ALineIndex >= 0) and (ALineIndex < LineCount) then begin LockUpdate; try St := FLines[ALineIndex].StartIndex; Len := FLines[ALineIndex].EndIndex - FLines[ALineIndex].StartIndex; Select(St, Len); ClearSelection; AddTextBlock(AValue, St); PA := AddParagraph(St + 1); PA.ParaStyle.WordWrap := False; // to allow multiple lines to be added finally UnlockUpdate; end; end; end; procedure TKMemoBlocks.SetMemoNotifier(const Value: IKMemoNotifier); var BlockIndex: TKMemoBlockIndex; begin FMemoNotifier := Value; for BlockIndex := 0 to Count - 1 do if Items[BlockIndex] is TKMemoContainer then TKMemoContainer(Items[BlockIndex]).Blocks.MemoNotifier := FMemoNotifier; end; procedure TKMemoBlocks.SetSelectionParaStyle(const Value: TKMemoParaStyle); begin if (SelLength <> 0) or (FSelEnd >= 0) and (FSelStart >= 0) then SetRangeParaStyle(RealSelStart, RealSelEnd, Value); end; procedure TKMemoBlocks.SetSelectionTextStyle(const Value: TKMemoTextStyle); begin if (SelLength <> 0) or (FSelEnd >= 0) and (FSelStart >= 0) then SetRangeTextStyle(RealSelStart, RealSelEnd, Value); end; procedure TKMemoBlocks.SetText(const AValue: TKString); begin LockUpdate; try Clear; InsertPlainText(0, AValue); FixEmptyBlocks; finally UnlockUpdate; end; end; function TKMemoBlocks.SplitForInsert(AAtIndex: TKMemoSelectionIndex; out ABlockIndex: TKMemoBlockIndex): TKMemoBlocks; var ContLocalIndex, BlockLocalIndex: TKMemoSelectionIndex; Block, NewBlock: TKMemoBlock; begin if AAtIndex < 0 then begin Result := Self; ABlockIndex := Count; // just append new blocks end else begin Result := IndexToBlocks(AAtIndex, ContLocalIndex); // get active inner blocks if Result <> nil then begin ABlockIndex := Result.IndexToBlockIndex(ContLocalIndex, BlockLocalIndex); // get block index within active blocks if ABlockIndex >= 0 then begin // if active block is splittable do it and make space for new blocks Block := Result.Items[ABlockIndex]; NewBlock := Block.Split(BlockLocalIndex); if NewBlock <> nil then begin Inc(ABlockIndex); Result.AddAt(NewBlock, ABlockIndex); end; end else ABlockIndex := Result.Count; // just append new blocks to active blocks end else begin Result := Self; ABlockIndex := Result.Count; // just append new blocks to active blocks end; end; end; procedure TKMemoBlocks.Update(AReasons: TKMemoUpdateReasons); begin if UpdateUnlocked then begin if AReasons * [muContent, muContentAddOnly] <> [] then UpdateAttributes; DoUpdate(AReasons); end else FUpdateReasons := FUpdateReasons + AReasons; end; procedure TKMemoBlocks.UpdateAttributes; function NumberToText(ANumber: Integer; AStyle: TKMemoParaNumbering): TKString; begin Result := ''; case AStyle of pnuArabic: Result := IntToStr(ANumber); pnuLetterLo, pnuLetterHi: Result := IntToLatin(ANumber, AStyle = pnuLetterHi); pnuRomanLo, pnuRomanHi: Result := IntToRoman(ANumber, AStyle = pnuRomanHi); end; end; procedure FormatNumberString(AListTable: TKMemoListTable; AStyle: TKMemoParaStyle; ANumberBlock: TKMemoTextBlock); var I, MaxLevel, LevelCount, LevelCounter: Integer; Item: TKMemoNumberingFormatItem; Numbering: TKMemoParaNumbering; List: TKMemoList; ListLevel, ItemLevel: TKMemoListLevel; S: TKString; begin // format using the numbering format List := AListTable.FindByID(AStyle.NumberingList); if List <> nil then begin S := ''; MaxLevel := -1; ListLevel := List.Levels[AStyle.NumberingListLevel]; LevelCount := ListLevel.NumberingFormat.LevelCount; for I := 0 to ListLevel.NumberingFormat.Count - 1 do begin Item := ListLevel.NumberingFormat.Items[I]; if (Item.Level >= 0) and (Item.Text = '') then begin ItemLevel := List.Levels[Item.Level]; Numbering := ItemLevel.Numbering; if not (Numbering in [pnuNone, pnuBullets, pnuArrowTwoBullets, pnuArrowOneBullets, pnuCircleBullets, pnuTriangleBullets]) then begin LevelCounter := ItemLevel.LevelCounter; if AStyle.NumberStartAt > 0 then LevelCounter := AStyle.NumberStartAt else if Item.Level >= LevelCount - 1 then // we only increase the last level Inc(LevelCounter); S := S + NumberToText(LevelCounter, Numbering); ItemLevel.LevelCounter := LevelCounter; MaxLevel := Item.Level; end; end else S := S + Item.Text; end; if Maxlevel >= 0 then // set all counters for subordinated list levels to zero List.Levels.ClearLevelCounters(MaxLevel + 1); S := S + cTab; ANumberBlock.Text := S; if ListLevel.NumberingFontChanged then ANumberBlock.TextStyle.Font.Assign(ListLevel.NumberingFont); end; end; var BlockIndex: TKMemoBlockIndex; Block: TKMemoBlock; PA: TKMemoParagraph; NumberBlock: TKMemoTextBlock; ListTable: TKMemoListTable; State: TKMemoUpdateReasons; begin State := SaveUpdateState; Inc(FUpdateLock); try if MemoNotifier <> nil then ListTable := MemoNotifier.GetListTable else ListTable := nil; if State <> [muContentAddOnly] then begin FRelPos.Clear; FSelectableLength := 0; if ListTable <> nil then ListTable.ClearLevelCounters; BlockIndex := 0; end else begin BlockIndex := FState.LastBlockIndex; end; while BlockIndex < Count do begin Block := Items[BlockIndex]; if Block.Position = mbpText then begin if Block is TKMemoParagraph then begin PA := TKMemoParagraph(Block); PA.LockUpdate; try PA.AssignAttributes(GetLastBlockByClass(BlockIndex, TKMemoTextBlock)); // TODO: make this line optional if ListTable <> nil then begin NumberBlock := PA.NumberBlock; if NumberBlock <> nil then begin NumberBlock.TextStyle.Assign(PA.TextStyle); FormatNumberString(ListTable, PA.ParaStyle, NumberBlock); end; end; finally PA.UnlockUpdate; end; end; Inc(FSelectableLength, Block.SelectableLength); end else begin FRelPos.AddItem(BlockIndex); end; Inc(BlockIndex); end; finally Dec(FUpdateLock); RestoreUpdateState(State); end; if Count > 0 then begin FSelStart := MinMax(FSelStart, 0, FSelectableLength); FSelEnd := MinMax(FSelEnd, 0, FSelectableLength); end else begin FSelStart := -1; FSelEnd := -1; end; end; { TKMemoEditAction } function TKMemoEditAction.HandlesTarget(Target: TObject): Boolean; begin Result := Target is TKCustomMemo; end; procedure TKMemoEditAction.ExecuteTarget(Target: TObject); begin TKMemo(Target).ExecuteCommand(GetEditCommand); end; procedure TKMemoEditAction.UpdateTarget(Target: TObject); begin Enabled := TKMemo(Target).CommandEnabled(GetEditCommand); end; { TKMemoEditSelectAllAction } function TKMemoEditSelectAllAction.GetEditCommand: TKEditCommand; begin Result := ecSelectAll; end; { TKMemoEditCopyAction } function TKMemoEditCopyAction.GetEditCommand: TKEditCommand; begin Result := ecCopy; end; { TKMemoEditCutAction } function TKMemoEditCutAction.GetEditCommand: TKEditCommand; begin Result := ecCut; end; { TKMemoEditPasteAction } function TKMemoEditPasteAction.GetEditCommand: TKEditCommand; begin Result := ecPaste; end; end. tomboy-ng_0.34-1/kcontrols/source/kprintsetup.dfm0000644000175000017500000002232014125207534022013 0ustar dbannondbannonobject KPrintSetupForm: TKPrintSetupForm Left = 808 Top = 247 ActiveControl = CBFitToPage BorderStyle = bsDialog Caption = 'Page setup' ClientHeight = 377 ClientWidth = 464 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = True Position = poScreenCenter OnCloseQuery = FormCloseQuery OnCreate = FormCreate OnDestroy = FormDestroy OnShow = FormShow DesignSize = ( 464 377) PixelsPerInch = 96 TextHeight = 13 object GBFileToPrint: TGroupBox Left = 8 Top = 8 Width = 449 Height = 45 Caption = 'Title of printed document:' TabOrder = 0 object EDTitle: TEdit Left = 8 Top = 16 Width = 432 Height = 21 TabOrder = 0 Text = 'EDTitle' end end object GBPrintOptions: TGroupBox Left = 8 Top = 109 Width = 249 Height = 119 Caption = 'Print options:' TabOrder = 1 object Label1: TLabel Left = 162 Top = 23 Width = 29 Height = 13 Caption = 'Scale:' Color = clBtnFace FocusControl = EDPrintScale ParentColor = False end object CBFitToPage: TCheckBox Left = 8 Top = 21 Width = 70 Height = 17 Caption = '&Fit to page' TabOrder = 0 OnClick = EDTopExit end object CBPageNumbers: TCheckBox Left = 8 Top = 40 Width = 86 Height = 17 Caption = 'Pa&ge numbers' TabOrder = 1 OnClick = CBPageNumbersClick end object CBUseColor: TCheckBox Left = 8 Top = 59 Width = 62 Height = 17 Caption = '&Use color' TabOrder = 2 OnClick = CBPageNumbersClick end object EDPrintScale: TEdit Left = 162 Top = 39 Width = 48 Height = 21 TabOrder = 3 OnExit = EDTopExit end object CBPaintSelection: TCheckBox Left = 8 Top = 78 Width = 87 Height = 17 Caption = 'Pa&int selection' TabOrder = 4 OnClick = CBPageNumbersClick end object CBPrintTitle: TCheckBox Left = 8 Top = 97 Width = 61 Height = 17 Caption = 'Print tit&le' TabOrder = 5 OnClick = CBPageNumbersClick end object CBLineNumbers: TCheckBox Left = 146 Top = 78 Width = 100 Height = 17 Caption = '&Line numbers' TabOrder = 6 OnClick = CBPageNumbersClick end object CBWrapLines: TCheckBox Left = 146 Top = 97 Width = 100 Height = 17 Caption = 'Wrap lines' TabOrder = 7 OnClick = CBPageNumbersClick end end object BUPrint: TButton Left = 89 Top = 345 Width = 74 Height = 25 Anchors = [akLeft, akBottom] Caption = '&Print' TabOrder = 4 OnClick = BUPrintClick end object BUCancel: TButton Left = 383 Top = 345 Width = 74 Height = 25 Anchors = [akLeft, akBottom] Cancel = True Caption = 'Cancel' ModalResult = 2 TabOrder = 5 end object GBMargins: TGroupBox Left = 264 Top = 109 Width = 193 Height = 228 Caption = 'Margins:' TabOrder = 3 object LBMarginUnits: TLabel Left = 8 Top = 23 Width = 62 Height = 13 Caption = 'Margin u&nits:' Color = clBtnFace FocusControl = CoBMarginUnits ParentColor = False end object LBLeft: TLabel Left = 14 Top = 103 Width = 23 Height = 13 Caption = 'Left:' Color = clBtnFace FocusControl = EDLeft ParentColor = False end object LBRight: TLabel Left = 114 Top = 103 Width = 29 Height = 13 Caption = 'Right:' Color = clBtnFace FocusControl = EDRight ParentColor = False end object LBTop: TLabel Left = 63 Top = 65 Width = 22 Height = 13 Caption = 'Top:' Color = clBtnFace FocusControl = EDTop ParentColor = False end object LBBottom: TLabel Left = 62 Top = 147 Width = 38 Height = 13 Caption = 'Bottom:' Color = clBtnFace FocusControl = EDBottom ParentColor = False end object LBUnitsLeft: TLabel Left = 64 Top = 122 Width = 7 Height = 13 Caption = 'A' Color = clBtnFace ParentColor = False end object LBUnitsTop: TLabel Left = 112 Top = 84 Width = 7 Height = 13 Caption = 'A' Color = clBtnFace ParentColor = False end object LBUnitsRight: TLabel Left = 164 Top = 122 Width = 7 Height = 13 Caption = 'A' Color = clBtnFace ParentColor = False end object LBUnitsBottom: TLabel Left = 112 Top = 166 Width = 7 Height = 13 Caption = 'A' Color = clBtnFace ParentColor = False end object CoBMarginUnits: TComboBox Left = 8 Top = 39 Width = 176 Height = 21 Style = csDropDownList TabOrder = 0 OnChange = CoBMarginUnitsChange Items.Strings = ( 'milimeters' 'centimeters' 'inches' 'hundredths of inches') end object CBMirrorMargins: TCheckBox Left = 8 Top = 198 Width = 86 Height = 17 Caption = '&Mirror margins' TabOrder = 5 OnClick = CBPageNumbersClick end object EDLeft: TEdit Left = 14 Top = 119 Width = 48 Height = 21 TabOrder = 1 OnExit = EDTopExit end object EDRight: TEdit Left = 114 Top = 119 Width = 48 Height = 21 TabOrder = 2 OnExit = EDTopExit end object EDTop: TEdit Left = 62 Top = 81 Width = 48 Height = 21 TabOrder = 3 OnExit = EDTopExit end object EDBottom: TEdit Left = 62 Top = 163 Width = 48 Height = 21 TabOrder = 4 OnExit = EDTopExit end end object GBPageSelection: TGroupBox Left = 8 Top = 232 Width = 249 Height = 105 Caption = 'Page selection:' TabOrder = 2 object LBRangeTo: TLabel Left = 163 Top = 51 Width = 14 Height = 13 Caption = 'to:' Color = clBtnFace ParentColor = False end object LBCopies: TLabel Left = 8 Top = 78 Width = 87 Height = 13 Caption = 'Number of &copies:' Color = clBtnFace FocusControl = EDCopies ParentColor = False end object RBAll: TRadioButton Left = 8 Top = 22 Width = 61 Height = 17 Caption = '&All pages' Checked = True TabOrder = 0 TabStop = True OnClick = RBAllClick end object RBRange: TRadioButton Left = 8 Top = 48 Width = 78 Height = 17 Caption = '&Range from:' TabOrder = 1 OnClick = RBAllClick end object RBSelectedOnly: TRadioButton Left = 128 Top = 22 Width = 82 Height = 17 Caption = 'Selected &only' TabOrder = 2 OnClick = RBAllClick end object EDRangeFrom: TEdit Left = 108 Top = 46 Width = 48 Height = 21 TabOrder = 3 OnExit = EDTopExit end object EDRangeTo: TEdit Left = 193 Top = 46 Width = 48 Height = 21 TabOrder = 4 OnExit = EDTopExit end object EDCopies: TEdit Left = 126 Top = 73 Width = 48 Height = 21 TabOrder = 5 end object CBCollate: TCheckBox Left = 179 Top = 75 Width = 51 Height = 17 Caption = 'Collate' TabOrder = 6 OnClick = CBPageNumbersClick end end object BUPreview: TButton Left = 8 Top = 345 Width = 75 Height = 25 Anchors = [akLeft, akBottom] Caption = 'Previe&w...' TabOrder = 6 OnClick = BUPreviewClick end object BUOk: TButton Left = 303 Top = 345 Width = 74 Height = 25 Anchors = [akLeft, akBottom] Caption = 'OK' Default = True ModalResult = 1 TabOrder = 7 end object GBPrinter: TGroupBox Left = 8 Top = 56 Width = 449 Height = 50 Caption = 'Printer settings' TabOrder = 8 object LBPrinterName: TLabel Left = 8 Top = 20 Width = 65 Height = 13 Caption = 'Printer name:' Color = clBtnFace FocusControl = EDCopies ParentColor = False end object CoBPrinterName: TComboBox Left = 112 Top = 17 Width = 206 Height = 21 TabOrder = 0 Text = 'CoBPrinterName' OnChange = EDTopExit end object BUConfigure: TButton Left = 328 Top = 15 Width = 113 Height = 25 Caption = 'Configure...' TabOrder = 1 OnClick = BUConfigureClick end end end tomboy-ng_0.34-1/kcontrols/source/kedits.pas0000644000175000017500000020715114125207534020732 0ustar dbannondbannon{ @abstract(This file is part of the KControls component suite for Delphi and Lazarus.) @author(Tomas Krysl) Copyright (c) 2020 Tomas Krysl

License:
This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } unit kedits; // lowercase name because of Lazarus/Linux {$include kcontrols.inc} {$WEAKPACKAGEUNIT ON} interface uses {$IFDEF FPC} LCLType, LCLIntf, LMessages, LCLProc, LResources, {$ELSE} Windows, Messages, {$ENDIF} SysUtils, Classes, Controls, Forms, Graphics, StdCtrls, ComCtrls, Dialogs, KFunctions, KControls, KDialogs, KLog {$IFDEF USE_THEMES} , Themes {$IFNDEF FPC} , UxTheme {$ENDIF} {$ENDIF} ; const KM_NE_UPDATEUPDOWN = KM_BASE + 101; type TKLabelPosition = ( lpAbove, lpBelow, lpLeft, lpRight ); TKNumberEditAcceptedFormat = ( neafAscii, neafBin, neafDec, neafFloat, neafHex, neafOct ); TKNumberEditAcceptedFormats = set of TKNumberEditAcceptedFormat; TKNumberEditDisplayedFormat = ( nedfAsInput, nedfAscii, nedfBin, nedfDec, nedfFloat, nedfHex, nedfOct ); TKNumberEditHexPrefix = ( nehpC, nehpPascal ); TKNumberEditOption = ( neoKeepEmpty, neoLowerCase, neoUnsigned, neoUseLabel, neoUsePrefix, neoUseUpDown, neoWarning, neoClampToMinMax ); TKNumberEditOptions = set of TKNumberEditOption; const DefaultNumberEditOptions = [neoLowerCase, neoUseLabel, neoUsePrefix, neoUseUpDown, neoWarning, neoClampToMinMax]; type { TKNumberValue } TKNumberValue = class private FIVal: Int64; FFVal: Extended; FHasInt: Boolean; function GetFVal: Extended; function GetIVal: Int64; function GetUIVal: UInt64; procedure SetHasInt(const Value: Boolean); procedure SetIVal(const AValue: Int64); procedure SetFVal(const AValue: Extended); procedure SetUIVal(const AValue: UInt64); public constructor CreateEmpty; constructor CreateI(const AValue: Int64); constructor CreateF(const AValue: Extended); procedure Assign(const AValue: TKNumberValue); procedure Clear(AHasIntState: Boolean); function Clamp(const AMinimum, AMaximum: TKNumberValue; ASigned: Boolean = True): Boolean; function EqualsTo(const AValue: TKNumberValue): Boolean; function GreaterThan(const AValue: TKNumberValue; ASigned: Boolean = True): Boolean; function LowerThan(const AValue: TKNumberValue; ASigned: Boolean = True): Boolean; property IVal: Int64 read GetIVal write SetIVal; property FVal: Extended read GetFVal write SetFVal; property HasInt: Boolean read FHasInt write SetHasInt; property UIVal: UInt64 read GetUIVal write SetUIVal; end; { TKCustomNumberEdit } TKCustomNumberEdit = class(TCustomEdit) private FAcceptedFormats: TKNumberEditAcceptedFormats; FCustomSuffix: string; FDecimalSeparator: Char; FDisplayedFormat: TKNumberEditDisplayedFormat; {$IFDEF FPC} FFlat: Boolean; {$ENDIF} FFixedWidth: Integer; FHexPrefix: TKNumberEditHexPrefix; FLabel: TLabel; FLabelPosition: TKLabelPosition; FLabelSpacing: Cardinal; FLastInputFormat: TKNumberEditDisplayedFormat; FLog: TKLog; FMax: TKNumberValue; FMin: TKNumberValue; FOptions: TKNumberEditOptions; FPrecision: Integer; FRealUpDownStep: Extended; FUpdateUpDown: Boolean; FUpDown: TUpDown; FUpdownChanging: Boolean; FUpDownStep: Extended; FValue: TKNumberValue; FWarningColor: TColor; FOnUpDownChange: TNotifyEvent; procedure CMEnabledChanged(var Msg: TLMessage); message CM_ENABLEDCHANGED; procedure CMVisibleChanged(var Msg: TLMessage); message CM_VISIBLECHANGED; procedure CMBiDiModeChanged(var Msg: TLMessage); message CM_BIDIMODECHANGED; procedure KMNEUpdateUpDown(var Msg: TLMessage); message KM_NE_UPDATEUPDOWN; procedure WMPaste(var Msg: TLMPaste); message LM_PASTE; procedure WMKillFocus(var Msg: TLMKillFocus); message LM_KILLFOCUS; procedure WMMove(var Msg: TLMMove); message LM_MOVE; procedure WMSetFocus(var Msg: TLMSetFocus); message LM_SETFOCUS; procedure WMSize(var Msg: TLMSize); message LM_SIZE; protected procedure Change; override; {$IFDEF FPC} procedure CreateWnd; override; procedure DoOnChangeBounds; override; {$ENDIF} procedure DoWarning(AValue: TKNumberValue); virtual; function GetCaption: TCaption; virtual; procedure GetFormat(AText: string; var Fmt: TKNumberEditDisplayedFormat; AValue: TKNumberValue); virtual; function GetMax: Extended; virtual; function GetMaxAsInt: Int64; function GetMin: Extended; virtual; function GetMinAsInt: Int64; virtual; procedure GetPrefixSuffix(Format: TKNumberEditDisplayedFormat; out Prefix, Suffix: string); virtual; function GetRealSelStart: Integer; virtual; function GetRealSelLength: Integer; virtual; function GetSigned: Boolean; virtual; function GetValue: Extended; virtual; function GetValueAsInt: Int64; virtual; function GetValueAsText: string; virtual; function InspectInputChar(Key: Char): Char; virtual; function IsCaptionStored: Boolean; virtual; function IsCustomSuffixStored: Boolean; virtual; function IsMaxStored: Boolean; virtual; function IsMinStored: Boolean; virtual; function IsUpDownStepStored: Boolean; virtual; function IsValueStored: Boolean; virtual; procedure KeyPress(var Key: Char); override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure SafeSetFocus; virtual; procedure SetAcceptedFormats(AValue: TKNumberEditAcceptedFormats); virtual; procedure SetCaption(const AValue: TCaption); virtual; procedure SetCustomSuffix(const AValue: string); virtual; procedure SetDecimalSeparator(Value: Char); virtual; procedure SetDisplayedFormat(AValue: TKNumberEditDisplayedFormat); virtual; procedure SetFixedWidth(AValue: Integer); virtual; {$IFDEF FPC} procedure SetFlat(Value: Boolean); virtual; {$ENDIF} function SetFormat(AValue: TKNumberValue): string; virtual; procedure SetHexPrefix(AValue: TKNumberEditHexPrefix); virtual; procedure SetLabelPosition(Value: TKLabelPosition); virtual; procedure SetLabelSpacing(Value: Cardinal); virtual; procedure SetMax(AMax: Extended); virtual; procedure SetMaxAsInt(AMax: Int64); virtual; procedure SetMin(AMin: Extended); virtual; procedure SetMinAsInt(AMin: Int64); virtual; procedure SetName(const Value: TComponentName); override; procedure SetOptions(AValue: TKNumberEditOptions); virtual; procedure SetParent(AParent: TWinControl); override; procedure SetPrecision(AValue: Integer); virtual; procedure SetUpDownStep(AValue: Extended); virtual; procedure SetValue(AValue: Extended); virtual; procedure SetValueAsInt(AValue: Int64); virtual; procedure SetValueAsText(const AValue: string); virtual; procedure TextToValue; virtual; procedure UpdateFormats; virtual; procedure UpdateLabel; virtual; procedure UpdateMaxMin; virtual; procedure UpdateUpDown(AValue: TKNumberValue); virtual; procedure UpdateUpDownPos; virtual; procedure UpDownChange; virtual; procedure UpDownChangingEx(Sender: TObject; var AllowChange: Boolean; NewValue: {$IFDEF COMPILER19_UP}Integer{$ELSE}SmallInt{$ENDIF}; Direction: TUpDownDirection); procedure ValueToText; virtual; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function Empty: Boolean; virtual; procedure Validate; virtual; property AcceptedFormats: TKNumberEditAcceptedFormats read FAcceptedFormats write SetAcceptedFormats default [neafDec]; property Caption: TCaption read GetCaption write SetCaption stored IsCaptionStored; property CustomSuffix: string read FCustomSuffix write SetCustomSuffix stored IsCustomSuffixStored; property DecimalSeparator: Char read FDecimalSeparator write SetDecimalSeparator; property DisplayedFormat: TKNumberEditDisplayedFormat read FDisplayedFormat write SetDisplayedFormat default nedfAsInput; property FixedWidth: Integer read FFixedWIdth write SetFixedWidth default 0; property HexPrefix: TKNumberEditHexPrefix read FHexPrefix write SetHexPrefix default nehpC; property LabelPosition: TKLabelPosition read FLabelPosition write SetLabelPosition default lpAbove; property LabelSpacing: Cardinal read FLabelSpacing write SetLabelSpacing default 3; property LastInputFormat: TKNumberEditDisplayedFormat read FLastInputFormat write FLastInputFormat; property Log: TKLog read FLog write FLog; property Max: Extended read GetMax write SetMax stored IsMaxStored; property MaxAsInt: Int64 read GetMaxAsInt write SetMaxAsInt; property Min: Extended read GetMin write SetMin stored IsMinStored; property MinAsInt: Int64 read GetMinAsInt write SetMinAsInt; property Options: TKNumberEditOptions read FOptions write SetOptions default DefaultNumberEditOptions; property Precision: Integer read FPrecision write SetPrecision default 2; property Signed: Boolean read GetSigned; property UpDownStep: Extended read FUpDownStep write SetUpDownStep stored IsUpDownStepStored; property Value: Extended read GetValue write SetValue stored IsValueStored; property ValueAsInt: Int64 read GetValueAsInt write SetValueAsInt; property ValueAsText: string read GetValueAsText write SetValueAsText; property WarningColor: TColor read FWarningColor write FWarningColor default clRed; property OnUpDownChange: TNotifyEvent read FOnUpDownChange write FOnUpDownChange; end; { TKNumberEdit } TKNumberEdit = class(TKCustomNumberEdit) published property AcceptedFormats; property Caption; property CustomSuffix; property DecimalSeparator; property DisplayedFormat; property FixedWidth; property HexPrefix; property LabelPosition; property LabelSpacing; property Log; property Max; property MaxAsInt; property Min; property MinAsInt; property Options; property Precision; property UpDownStep; property Value; property ValueAsInt; property WarningColor; property OnUpDownChange; property Anchors; property AutoSelect; property AutoSize; property BiDiMode; property BorderStyle; property Color; property Constraints; {$IFDEF FPC} { Specifies the same as Ctl3D in Delphi. } property Flat: Boolean read FFlat write SetFlat default False; {$ELSE} { Inherited property - see Delphi help. } property Ctl3D; {$ENDIF} property DragCursor; property DragKind; property DragMode; property Enabled; property Font; property HideSelection; property MaxLength; property ParentBiDiMode; property ParentColor; property ParentFont; property ParentShowHint; property PopupMenu; property ReadOnly; property ShowHint; property TabOrder; property TabStop; property Visible; property OnChange; property OnClick; property OnContextPopup; property OnDblClick; property OnDragDrop; property OnDragOver; property OnEndDock; property OnEndDrag; property OnEnter; property OnExit; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMouseDown; {$IFDEF COMPILER9_UP} property OnMouseEnter; property OnMouseLeave; {$ENDIF} property OnMouseMove; property OnMouseUp; property OnStartDock; property OnStartDrag; end; TKFileNameEditButtonStyle = (fbNone, fbButton, fbBitBtn, fbSpeedBtn, fbUser); TKFileNameEditButtonAlign = (fbaRight, fbaLeft, fbaLeftDown, fbaRightDown); TKFileNameEditOption = (foFolderOnly, foSaveDialog, foAlwaysInitialDir, foAddToList, foCheckPath, foCorrectPath, foPathMustExist, foAddInitialDir, foCheckWithInitialDir, foWarning); TKFileNameEditOptions = set of TKFileNameEditOption; TKFileNameEditDlgProperties = class(TPersistent) private FInitialDir: TFolder; FDefaultExt: string; FFilter: string; FFilterIndex: Integer; FOpenOptions: TOpenOptions; FBrowseOptions: TKBrowseFolderOptions; FBrowseDlgLabel: string; function IsOpenOptionsStored: Boolean; function IsBrowseOptionsStored: Boolean; protected public constructor Create; published property BrowseDlgLabel: string read FBrowseDlgLabel write FBrowseDlgLabel; property BrowseOptions: TKBrowseFolderOptions read FBrowseOptions write FBrowseOptions stored IsBrowseOptionsStored; property DefaultExt: string read FDefaultExt write FDefaultExt; property Filter: string read FFilter write FFilter stored True; property FilterIndex: Integer read FFilterIndex write FFilterIndex default 1; property InitialDir: TFolder read FInitialDir write FInitialDir; property OpenOptions: TOpenOptions read FOpenOptions write FOpenOptions stored IsOpenOptionsStored; end; { TKFileNameEdit } TKFileNameEdit = class(TCustomComboBox) private FButton: TControl; FButtonAlign: TKFileNameEditButtonAlign; FButtonStyle: TKFileNameEditButtonStyle; FButtonText: TCaption; FButtonWidth: Integer; FButtonDist: Integer; {$IFDEF FPC} FFlat: Boolean; {$ENDIF} FLog: TKLog; FOptions: TKFileNameEditOptions; FWarningColor: TColor; FBtnOnClick: TNotifyEvent; FDlgProperties: TKFileNameEditDlgProperties; function GetFileName: TFileName; procedure SetFileName(const Value: TFileName); procedure SetButton(Value: TControl); function IsButtonStored: Boolean; procedure SetButtonAlign(Value: TKFileNameEditButtonAlign); procedure SetButtonStyle(Value: TKFileNameEditButtonStyle); procedure SetButtonText(const Value: TCaption); function IsButtonTextStored: Boolean; procedure SetButtonWidth(Value: Integer); procedure SetButtonDist(Value: Integer); function GetWholeWidth: Integer; function GetWholeLeft: Integer; {$IFDEF FPC} procedure SetFlat(Value: Boolean); {$ENDIF} procedure SetWholeWidth(Value: Integer); procedure SetWholeLeft(const Value: Integer); procedure SetOptions(Value: TKFileNameEditOptions); procedure UpdateButton; procedure CMEnabledChanged(var Msg: TLMessage); message CM_ENABLEDCHANGED; procedure CMVisibleChanged(var Msg: TLMessage); message CM_VISIBLECHANGED; procedure CMBiDiModeChanged(var Msg: TLMessage); message CM_BIDIMODECHANGED; procedure WMMove(var Msg: TLMMove); message LM_MOVE; procedure WMSize(var Msg: TLMSize); message LM_SIZE; protected procedure ButtonClick(Sender: TObject); virtual; procedure ButtonExit(Sender: TObject); virtual; procedure DoEnter; override; procedure DoExit; override; procedure DropDown; override; procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure SetParent(AParent: TWinControl); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; published property Style; {Must be published before Items} property Anchors; property AutoSize; property BiDiMode; property Button: TControl read FButton write SetButton stored IsButtonStored; property ButtonAlign: TKFileNameEditButtonAlign read FButtonAlign write SetButtonAlign default fbaRight; property ButtonDist: Integer read FButtonDist write SetButtonDist default 8; property ButtonStyle: TKFileNameEditButtonStyle read FButtonStyle write SetButtonStyle default fbButton; property ButtonText: TCaption read FButtonText write SetButtonText stored IsButtonTextStored; property ButtonWidth: Integer read FButtonWidth write SetButtonWidth default 70; property CharCase; property Color; property Constraints; {$IFDEF FPC} { Specifies the same as Ctl3D in Delphi. } property Flat: Boolean read FFlat write SetFlat default False; {$ELSE} { Inherited property - see Delphi help. } property Ctl3D; {$ENDIF} property DlgProperties: TKFileNameEditDlgProperties read FDlgProperties; property DragCursor; property DragKind; property DragMode; property DropDownCount; property Enabled; property FileName: TFileName read GetFileName write SetFileName; property Font; property ItemHeight; property Log: TKLog read FLog write FLog; property MaxLength; property Options: TKFileNameEditOptions read FOptions write SetOptions default [foAddToList, foCheckPath, foWarning]; property ParentBiDiMode; property ParentColor; property ParentFont; property ParentShowHint; property PopupMenu; property ShowHint; property Sorted; property TabOrder; property TabStop; property Visible; property WarningColor: TColor read FWarningColor write FWarningColor default clRed; property WholeLeft: Integer read GetWholeLeft write SetWholeLeft stored False; property WholeWidth: Integer read GetWholeWidth write SetWholeWidth stored False; property OnChange; property OnClick; property OnContextPopup; property OnDblClick; property OnDragDrop; property OnDragOver; property OnDrawItem; property OnDropDown; property OnEndDock; property OnEndDrag; property OnEnter; property OnExit; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMeasureItem; property OnMouseDown; {$IFDEF COMPILER9_UP} property OnMouseEnter; property OnMouseLeave; {$ENDIF} property OnMouseMove; property OnMouseUp; property OnStartDock; property OnStartDrag; property Items; { Must be published after OnMeasureItem } end; function CorrectPath(const S, InitialDir: TFileName; Options: TKFileNameEditOptions; out Err: Boolean; Log: TKLog): TFileName; function CorrectSubDirName(var S: string; out Warn: Boolean; Log: TKLog): Boolean; implementation uses ClipBrd, Buttons, Math, Types, TypInfo, KMessageBox, KRes; const IdStartCharSet = ['_', 'a'..'z', 'A'..'Z']; IdCharSet = ['0'..'9'] + IdStartCharSet; SubDirIllegalCharSet = [#0..#31, '<', '>', ':', '"', '/', '\', '|', '*', '?']; function CorrectPath(const S, InitialDir: TFileName; Options: TKFileNameEditOptions; out Err: Boolean; Log: TKLog): TFileName; function FindCharFromPos(const S: string; AChar: Char; ALen: Integer; var APos: Integer): Boolean; var Bk: Integer; begin {ignore multiple backslashes} while (APos < ALen) and (S[APos] = AChar) do Inc(APos); Bk := APos; while (Bk < ALen) and (S[Bk] <> AChar) do Inc(Bk); Result := Bk < ALen; end; var I, Len, K: Integer; B0, B, B1, B2, Warn, DirAdded: Boolean; T, T1: string; begin T := S; Err := False; DirAdded := False; Len := Length(T); K := 1; B0 := False; B := False; B1 := False; B2 := False; for I := 1 to Len do if T[I] = '/' then T[I] := '\'; if Len > 0 then begin {check drive} if CharInSetEx(UpCase(T[1]), ['A'..'Z']) and (T[2] = ':') then begin if (T[3] <> '\') then begin Insert('\', T, 3); Inc(Len); end; K := 4; end else if (S[1] = '.') and (S[2] = '\') then //check current dir K := 3 else if (S[1] = '.') and (S[2] = '.') and (S[3] = '\') then //check parent dir K := 4 { else //check protocol - not enabled begin I := 0; while not (S[I] in [':', '\']) do Inc(I); if (I <> 0) and (S[I] = ':') then begin T1 := LowerCase(Copy(S, 1, I - 1)); if (T1 = 'http') or (T1 = 'ftp') or (T1 = 'gopher') or (T1 = 'mailto') or (T1 = 'nntp') then K := Length(T1) + 2; end; end}; if K = 1 then begin if Options * [foCorrectPath, foAddInitialDir] <> [] then while CharInSetEx(T[1], SubDirIllegalCharSet) do Delete(T, 1, 1); if foAddInitialDir in Options then begin if InitialDir[Length(InitialDir)] = '\' then T := Format('%s%s', [InitialDir, T]) else T := Format('%s\%s', [InitialDir, T]); Len := Length(T); K := Length(InitialDir) + 2; B0 := True; if Assigned(Log) then Log.Log(lgNote, Format(sEDCurrentDirAdded, [S])); DirAdded := True; end; end; {check subdirectories} while (K < Len) and (FindCharFromPos(T, '\', Len, K) or (foFolderOnly in Options)) do begin {check or correct next subdirectory} if K < Len then begin I := K; while (I < Len) and (T[I] <> '\') do Inc(I); if T[I] <> '\' then Inc(I); T1 := Copy(T, K, I - K); if CorrectSubDirName(T1, Warn, nil) then begin if Warn then B := True; if (foCorrectPath in Options) or not Warn then begin Delete(T, K, I - K); Insert(T1, T, K); Len := Length(T); Inc(K, Length(T1) + 1); end else Inc(K, I - K + 1); end else Inc(K, Length(T1) + 1); end; end; {check file name} if not (foFolderOnly in Options) then begin if K < Len then begin T1 := Copy(T, K, Len - K + 1); if CorrectSubDirName(T1, Warn, nil) then begin if Warn then B := True; if (foCorrectPath in Options) or not Warn then begin Delete(T, K, Len - K); T := T + T1; end; end; end else B1 := True; end; {check for path presence} if foPathMustExist in Options then if foFolderOnly in Options then begin if not DirectoryExists(T) then B2 := True; end else if not B1 then begin if not (foCheckWithInitialDir in Options) or DirAdded then T1 := T else if (InitialDir = '') or (ExtractFilePath(T) <> '') then T1 := T else if InitialDir[Length(InitialDir)] = '\' then T1 := InitialDir + T else T1 := Format('%s\%s', [InitialDir, T]); if not FileExists(T1) then B2 := True; end; {log errors} if Assigned(Log) then begin if B then if foFolderOnly in Options then begin if foCorrectPath in Options then Log.Log(lgInputError, Format(sEDBadDirCorr, [S, T])) else if foCheckPath in Options then Log.Log(lgWarning, Format(sEDBadDir, [T])); end else if foCorrectPath in Options then Log.Log(lgInputError, Format(sEDBadPathCorr, [S, T])) else if foCheckPath in Options then Log.Log(lgWarning, Format(sEDBadPath, [T])); if B1 and (Options * [foCheckPath, foCorrectPath] <> []) then Log.Log(lgWarning, sEDMissingFileName); if B2 then if foFolderOnly in Options then Log.Log(lgWarning, Format(sEDNoExistingDir, [T])) else Log.Log(lgWarning, Format(sEDNoExistingPath, [T])); end; end; Err := B0 or B or B1 or B2; Result := T; end; function CorrectSubDirName(var S: string; out Warn: Boolean; Log: TKLog): Boolean; function IsSpecialName(const S: string): Boolean; var T: string; begin if S[4] = '.' then T := Copy(S, 1, 3) else T := S; Result := (T = 'AUX') or (T = 'PRN') or (T = 'CON'); end; var I, Len: Integer; T: string; begin Result := False; Warn := True; T := S; if Length(S) > 0 then begin if CharInSetEx(S[1], SubDirIllegalCharSet) then begin S[1] := '_'; Result := True; end; I := 2; Len := Length(S); while (I <= Len) do begin if CharInSetEx(S[I], SubDirIllegalCharSet) then begin Delete(S, I, 1); Dec(Len); Dec(I); Result := True; end; Inc(I); end; if IsSpecialName(UpperCase(S)) then begin S := '_' + S; Inc(Len); Result := True; end; while S[Len] = '.' do begin Delete(S, Len, 1); Dec(Len); Result := True; Warn := False; end; if S = '.' then begin S[1] := '_'; Result := True; end; end else begin S := '_'; Result := True; end; if Result and Warn and Assigned(Log) then Log.Log(lgInputError, Format(sEDBadSubDirName, [T, S])); end; { TKNumberValue } procedure TKNumberValue.Clear(AHasIntState: Boolean); begin if AHasIntState then IVal := 0 else FVal := 0; end; constructor TKNumberValue.CreateEmpty; begin IVal := 0; end; constructor TKNumberValue.CreateF(const AValue: Extended); begin FVal := AValue; end; constructor TKNumberValue.CreateI(const AValue: Int64); begin IVal := AValue; end; procedure TKNumberValue.Assign(const AValue: TKNumberValue); begin FFVal := AValue.FFVal; FIVal := AValue.FIVal; FHasInt := AValue.FHasInt; end; function TKNumberValue.Clamp(const AMinimum, AMaximum: TKNumberValue; ASigned: Boolean): Boolean; begin Result := False; if LowerThan(AMinimum, ASigned) then begin Assign(AMinimum); Result := True; end else if GreaterThan(AMaximum, ASigned) then begin Assign(AMaximum); Result := True; end; end; function TKNumberValue.EqualsTo(const AValue: TKNumberValue): Boolean; begin if FHasInt then Result := IVal = AValue.IVal else Result := FVal = AValue.FVal; end; function TKNumberValue.GetFVal: Extended; begin if FHasInt then Result := FIVal else Result := FFVal end; function TKNumberValue.GetIVal: Int64; const cMaxInt64F = 9.223372036854775807E+18; cMinInt64F = -9.223372036854775808E+18; {$IF DEFINED(FPC) OR DEFINED(COMPILER12_UP)} // maybe incorrect version, I don't know which Delphi version does not complain anymore cMaxInt64 = 9223372036854775807; cMinInt64 = -9223372036854775808; {$IFEND} begin if FHasInt then Result := FIVal else begin try try Result := Round(FFVal) except // try to clamp the value to Int64 limits // this requires the Extended type with sufficient precision, at least 10 bytes // might be not accurate when Extended is mapped to Double etc. {$IF DEFINED(FPC) OR DEFINED(COMPILER12_UP)} if FFVal > cMaxInt64F then Result := cMaxInt64 else if FFVal < cMinInt64F then Result := cMinInt64 else {$IFEND} Result := 0; end; except Result := 0; end; end; end; function TKNumberValue.GetUIVal: UInt64; const cMaxUInt64F = 1.8446744073709551615E+19; cMinUInt64F = 0E+01; // maybe incorrect version, I don't know which Delphi version does not complain anymore {$IF DEFINED(FPC) OR DEFINED(COMPILER12_UP)} cMaxUInt64 = 18446744073709551615; cMinUInt64 = 0; {$IFEND} begin if FHasInt then Result := UInt64(FIVal) else begin try try Result := Round(FFVal) except // try to clamp the value to UInt64 limits // this requires the Extended type with sufficient precision, at least 10 bytes // might be not accurate when Extended is mapped to Double etc. {$IF DEFINED(FPC) OR DEFINED(COMPILER12_UP)} if FFVal > cMaxUInt64F then Result := cMaxUInt64 else if FFVal < cMinUInt64F then Result := cMinUInt64 else {$IFEND} Result := 0; end; except Result := 0; end; end; end; function TKNumberValue.GreaterThan(const AValue: TKNumberValue; ASigned: Boolean): Boolean; begin if FHasInt then begin if ASigned then Result := IVal > AValue.IVal else Result := UIVal > AValue.UIVal end else Result := FVal > AValue.FVal; end; function TKNumberValue.LowerThan(const AValue: TKNumberValue; ASigned: Boolean): Boolean; begin if FHasInt then begin if ASigned then Result := IVal < AValue.IVal else Result := UIVal < AValue.UIVal end else Result := FVal < AValue.FVal; end; procedure TKNumberValue.SetFVal(const AValue: Extended); begin FFVal := AValue; FHasInt := False; end; procedure TKNumberValue.SetHasInt(const Value: Boolean); begin if Value <> HasInt then begin if Value then IVal := IVal else FVal := FVal; end; end; procedure TKNumberValue.SetIVal(const AValue: Int64); begin FIVal := AValue; FHasInt := True; end; procedure TKNumberValue.SetUIVal(const AValue: UInt64); begin FIVal := Int64(AValue); FHasInt := True; end; { TKNumberEdit } constructor TKCustomNumberEdit.Create(AOwner: TComponent); begin inherited; FMin := TKNumberValue.CreateI(0); FMax := TKNumberValue.CreateI(1000); FValue := TKNumberValue.CreateI(0); Text := ''; FWarningColor := clRed; FOptions := [neoLowerCase, neoUseLabel, neoUsePrefix, neoUseUpDown, neoWarning, neoClampToMinMax]; FAcceptedFormats := [neafDec]; FDecimalSeparator := GetFormatSettings.DecimalSeparator; FDisplayedFormat := nedfAsInput; FLastInputFormat := nedfDec; FFixedWidth := 0; FPrecision := 2; FCustomSuffix := ''; FLabelPosition := lpAbove; FLabelSpacing := 3; FLog := nil; FUpDown := TUpDown.Create(Self); FUpDown.TabStop := False; FUpDown.OnChangingEx := UpDownChangingEx; FUpDownStep := 1; FUpdownChanging := False; FUpdateUpDown := True; FLabel := TLabel.Create(Self); FLabel.FocusControl := Self; FOnUpDownChange := nil; end; destructor TKCustomNumberEdit.Destroy; begin FMin.Free; FMax.Free; FValue.Free; inherited; end; procedure TKCustomNumberEdit.Change; begin inherited; TextToValue; UpdateUpDown(FValue); end; {$IFDEF FPC} procedure TKCustomNumberEdit.CreateWnd; begin inherited; UpdateUpDownPos; UpdateLabel; end; procedure TKCustomNumberEdit.DoOnChangeBounds; begin inherited; UpdateUpDownPos; UpdateLabel; end; {$ENDIF} procedure TKCustomNumberEdit.DoWarning(AValue: TKNumberValue); var Fmt: TKNumberEditDisplayedFormat; begin if (ComponentState * [csLoading, csDesigning] = []) and HasParent then begin if neoWarning in FOptions then Font.Color := FWarningColor; if Assigned(FLog) then begin if FDisplayedFormat = nedfAsInput then Fmt := FLastInputFormat else Fmt := FDisplayedFormat; case Fmt of nedfDec: FLog.Log(lgInputError, Format(sEDBadIntValueAsStr, [SetFormat(FMin), SetFormat(FMax), SetFormat(AValue)])); nedfFloat: FLog.Log(lgInputError, Format(sEDBadFloatValueAsStr, [SetFormat(FMin), SetFormat(FMax), SetFormat(AValue)])); nedfHex: FLog.Log(lgInputError, Format(sEDBadHexValueAsStr, [SetFormat(FMin), SetFormat(FMax), SetFormat(AValue)])); end; end; end; end; function TKCustomNumberEdit.Empty: Boolean; begin Result := (Text = '') or (Text = '-'); end; function TKCustomNumberEdit.GetCaption: TCaption; begin Result := FLabel.Caption; end; procedure TKCustomNumberEdit.GetFormat(AText: string; var Fmt: TKNumberEditDisplayedFormat; AValue: TKNumberValue); var I: Int64; D: Extended; Code: Integer; W: Byte; K: Integer; begin AValue.Clear(True); if AText = '' then Exit; if FCustomSuffix <> '' then begin K := Pos(FCustomSuffix, AText); if (K > 0) and (K = Length(AText) - Length(FCustomSuffix) + 1) then Delete(AText, K, Length(CustomSuffix)); while (AText <> '') and (AText[Length(AText)] = ' ') do SetLength(AText, Length(AText) - 1); end; if AText = '' then Exit; // decimal integer - most probable if neafDec in FAcceptedFormats then begin I := DecStrToInt(AText, Code); if (Code = 0) then begin Fmt := nedfDec; AValue.IVal := I; Exit; end; end; // hexadecimal integer if neafHex in FAcceptedFormats then begin if FFixedWidth > 0 then W := FFixedWidth else W := 8; // 32 bit I := HexStrToInt(AText, W, Signed, Code); if (Code = 0) then begin Fmt := nedfHex; AValue.IVal := I; Exit; end; end; // binary integer if neafBin in FAcceptedFormats then begin if FFixedWidth > 0 then W := FFixedWidth else W := 16; // 16 bit I := BinStrToInt(AText, W, Signed, Code); if (Code = 0) then begin Fmt := nedfBin; AValue.IVal := I; Exit; end; end; // octal integer if neafOct in FAcceptedFormats then begin I := OctStrToInt(AText, Code); if (Code = 0) then begin Fmt := nedfBin; AValue.IVal := I; Exit; end; end; // double - custom suffix only if neafFloat in FAcceptedFormats then begin K := Pos('.', AText); if K = 0 then K := Pos(',', AText); if K = 0 then K := Pos(DecimalSeparator, AText); if K > 0 then AText[K] := '.'; Val(AText, D, Code); if (Code = 0) then begin Fmt := nedfFloat; AValue.FVal := D; Exit; end; end; // ascii - least probable if neafAscii in FAcceptedFormats then begin if FFixedWidth > 0 then W := FFixedWidth else W := 4; // 32 bit AValue.IVal := AsciiToInt(AText, W); Fmt := nedfAscii; end; end; function TKCustomNumberEdit.GetMax: Extended; begin Result := FMax.FVal; end; function TKCustomNumberEdit.GetMaxAsInt: Int64; begin Result := FMax.IVal; end; function TKCustomNumberEdit.GetMin: Extended; begin Result := FMin.FVal; end; function TKCustomNumberEdit.GetMinAsInt: Int64; begin Result := FMin.IVal; end; procedure TKCustomNumberEdit.GetPrefixSuffix(Format: TKNumberEditDisplayedFormat; out Prefix, Suffix: string); begin Prefix := ''; Suffix := ''; case Format of nedfBin: if neoLowerCase in FOptions then Suffix := 'b' else Suffix := 'B'; nedfHex: if neoUsePrefix in FOptions then case FHexPrefix of nehpPascal: Prefix := '$'; nehpC: Prefix := '0x'; end else if neoLowerCase in FOptions then Suffix := 'h' else Suffix := 'H'; nedfOct: if neoLowerCase in FOptions then Suffix := 'o' else Suffix := 'O'; end; end; function TKCustomNumberEdit.GetRealSelLength: Integer; begin if Sellength >= 0 then Result := SelLength else Result := -SelLength; end; function TKCustomNumberEdit.GetRealSelStart: Integer; begin if Sellength >= 0 then Result := SelStart else Result := SelStart - SelLength; end; function TKCustomNumberEdit.GetSigned: Boolean; begin Result := not (neoUnsigned in FOptions); end; function TKCustomNumberEdit.GetValue: Extended; begin TextToValue; Result := FValue.FVal; end; function TKCustomNumberEdit.GetValueAsInt: Int64; begin TextToValue; Result := FValue.IVal; end; function TKCustomNumberEdit.GetValueAsText: string; begin TextToValue; Result := SetFormat(FValue); end; function TKCustomNumberEdit.InspectInputChar(Key: Char): Char; var S: string; KeyDec, KeyHex, KeyBin, KeyOct, KeyFLoat, KeySuffix: Char; begin S := Copy(Text, 1, GetRealSelStart) + Copy(Text, GetRealSelStart + GetRealSelLength + 1, Length(Text)); if neafAscii in FAcceptedFormats then Result := Key else begin Result := #0; if neafDec in FAcceptedFormats then begin KeyDec := Key; if CharInSetEx(KeyDec, ['0'..'9','-',#8]) then begin if (KeyDec = '-') and (SelStart <> 0) then KeyDec := #0; if (Pos('0', S) = 1) and (neafOct in FAcceptedFormats) then KeyDec := #0; end else KeyDec := #0; end else KeyDec := #0; if neafHex in FAcceptedFormats then begin KeyHex := Key; if CharInSetEx(KeyHex, ['0'..'9', 'a'..'f', 'A'..'F', #8, 'x', 'X', 'h', 'H']) then begin if CharInSetEx(KeyHex, ['x', 'X']) and ((SelStart > 1) or (Pos('x', S) <> 0) or (Pos('X', S) <> 0)) then KeyHex := #0; if CharInSetEx(KeyHex, ['h', 'H']) and ((SelStart < Length(S)) or (Pos('h', S) <> 0) or (Pos('H', S) <> 0)) then KeyHex := #0; if neoLowerCase in FOptions then begin if CharInSetEx(KeyHex, ['A'..'F', 'X']) then Inc(KeyHex, Ord('a') - Ord('A')); end else if CharInSetEx(KeyHex, ['a'..'f', 'x']) then Inc(KeyHex, Ord('A') - Ord('a')); end else KeyHex := #0; end else KeyHex := #0; if neafBin in FAcceptedFormats then begin KeyBin := Key; if CharInSetEx(KeyBin, ['0'..'1', 'b', 'B', #8]) then begin if CharInSetEx(KeyBin, ['b', 'B']) and ((SelStart < Length(S)) or (Pos('b', S) <> 0) or (Pos('B', S) <> 0)) then KeyBin := #0; end else KeyBin := #0; end else KeyBin := #0; if neafOct in FAcceptedFormats then begin KeyOct := Key; if CharInSetEx(KeyOct, ['0'..'7', #8]) then begin if (Pos('0', S) > 1) then KeyOct := #0; end else KeyOct := #0; end else KeyOct := #0; if neafFloat in FAcceptedFormats then begin KeyFloat := Key; if CharInSetEx(KeyFLoat, ['0'..'9','-', '.', ',', 'e', 'E', DecimalSeparator, #8]) then begin if (KeyFloat = '-') and (SelStart <> 0) then KeyFloat := #0; if CharInSetEx(KeyFLoat, ['.', ',', DecimalSeparator]) and ((Pos('.', S) <> 0) or (Pos(',', S) <> 0) or (Pos(DecimalSeparator, S) <> 0)) then KeyFloat := #0; end else KeyFloat := #0; end else KeyFLoat := #0; if FCustomSuffix <> '' then begin if (Pos(Key, FCustomSuffix) <> 0) or (Key = ' ') then KeySuffix := Key else KeySuffix := #0; end else KeySuffix := #0; if KeyFloat <> #0 then Result := KeyFLoat; if KeyBin <> #0 then Result := KeyBin; if KeyHex <> #0 then Result := KeyHex; if KeyDec <> #0 then Result := KeyDec; if KeyOct <> #0 then Result := KeyOct; if KeySuffix <> #0 then Result := KeySuffix; end; end; function TKCustomNumberEdit.IsCaptionStored: Boolean; begin Result := FLabel.Caption <> Name; end; function TKCustomNumberEdit.IsCustomSuffixStored: Boolean; begin Result := FCustomSuffix <> ''; end; function TKCustomNumberEdit.IsMaxStored: Boolean; begin Result := FMax.IVal <> 1000; end; function TKCustomNumberEdit.IsMinStored: Boolean; begin Result := FMin.IVal <> 0; end; function TKCustomNumberEdit.IsUpDownStepStored: Boolean; begin Result := FUpDownStep <> 1; end; function TKCustomNumberEdit.IsValueStored: Boolean; begin Result := GetValue <> 0; end; procedure TKCustomNumberEdit.KeyPress(var Key: Char); begin inherited; if Key >= #32 then begin Key := InspectInputChar(Key); if Key <> #0 then Font.Color := clWindowText; end end; procedure TKCustomNumberEdit.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if Operation = opRemove then if AComponent = FUpDown then FUpDown := nil else if AComponent = FLabel then FLabel := nil; end; procedure TKCustomNumberEdit.SafeSetFocus; var Form: TCustomForm; begin Form := GetParentForm(Self); if (Form <> nil) and Form.Visible and Form.Enabled and Visible and Enabled then Form.ActiveControl := Self; end; procedure TKCustomNumberEdit.SetAcceptedFormats(AValue: TKNumberEditAcceptedFormats); begin if AValue <> FAcceptedFormats then begin TextToValue; FAcceptedFormats := AValue; UpdateFormats; UpdateMaxMin; ValueToText; end; end; procedure TKCustomNumberEdit.SetCaption(const AValue: TCaption); begin FLabel.SetTextBuf(PChar(AValue)); end; procedure TKCustomNumberEdit.SetCustomSuffix(const AValue: string); begin if AValue <> FCustomSuffix then begin TextToValue; FCustomSuffix := AValue; ValueToText; end; end; procedure TKCustomNumberEdit.SetDecimalSeparator(Value: Char); begin if Value <> FDecimalSeparator then begin FDecimalSeparator := Value; SetValue(GetValue); end; end; procedure TKCustomNumberEdit.SetDisplayedFormat(AValue: TKNumberEditDisplayedFormat); begin if FDisplayedFormat <> AValue then begin TextToValue; FDisplayedFormat := AValue; UpdateFormats; UpdateMaxMin; ValueToText; end; end; procedure TKCustomNumberEdit.SetFixedWidth(AValue: Integer); begin if FFixedWidth <> AValue then begin TextToValue; FFixedWidth := AValue; ValueToText; end; end; {$IFDEF FPC} procedure TKCustomNumberEdit.SetFlat(Value: Boolean); begin if Value <> FFlat then begin FFlat := Value; Invalidate; end; end; {$ENDIF} function TKCustomNumberEdit.SetFormat(AValue: TKNumberValue): string; var Prefix, Suffix: string; A: ShortString; W: Byte; J: Integer; F, G: Extended; Fmt: TKNumberEditDisplayedFormat; begin Result := ''; if FDisplayedFormat = nedfAsInput then begin if Frac(AValue.FVal) <> 0 then Fmt := nedfFloat else Fmt := FLastInputFormat; end else Fmt := FDisplayedFormat; GetPrefixSuffix(Fmt, Prefix, Suffix); case Fmt of nedfAscii: begin if FFixedWidth > 0 then W := FFixedWidth else W := 4; Result := IntToAscii(AValue.IVal, W); end; nedfBin: begin if FFixedWidth > 0 then W := FFixedWidth else W := 16; Result := IntToBinStr(AValue.IVal, W, Suffix); end; nedfDec: begin if Signed then Result := IntToDecStr(AValue.IVal, FFixedWidth) else Result := UIntToDecStr(AValue.IVal, FFixedWidth) end; nedfFloat: begin if FPrecision < 0 then begin Result := FloatToStrF(AValue.FVal, ffGeneral, 15, 15); end else if FPrecision > 0 then begin Str(AValue.FVal:FFixedWidth:FPrecision, A); Result := string(A); end else begin // determine number of valid decimal digits W := 0; F := AValue.FVal; G := Frac(F); while not (IsZero(G, 1E-10) or IsZero(1 - G, 1E-10)) do begin F := F * 10; G := Frac(F); Inc(W); end; Str(AValue.FVal:FFixedWidth:W, A); Result := string(A); end; J := Pos('.', Result); if J = 0 then J := Pos(',', Result); if J > 0 then Result[J] := FDecimalSeparator; end; nedfHex: begin if FFixedWidth > 0 then W := FFixedWidth else W := 8; Result := IntToHexStr(AValue.IVal, W, Prefix, Suffix, neoLowerCase in FOptions); end; nedfOct: begin Result := IntToOctStr(AValue.IVal); end; end; if (Result <> '') and (FCustomSuffix <> '') then Result := Result + ' ' + FCustomSuffix; end; procedure TKCustomNumberEdit.SetHexPrefix(AValue: TKNumberEditHexPrefix); begin if FHexPrefix <> AValue then begin TextToValue; FHexPrefix := AValue; ValueToText; end; end; procedure TKCustomNumberEdit.SetLabelPosition(Value: TKLabelPosition); begin if Value <> FLabelPosition then begin FLabelPosition := Value; UpdateLabel; end; end; procedure TKCustomNumberEdit.SetLabelSpacing(Value: Cardinal); begin if Value < 1 then Value := 1; if Value <> FLabelSpacing then begin FLabelSpacing := Value; UpdateLabel; end; end; procedure TKCustomNumberEdit.SetMax(AMax: Extended); begin if AMax <> FMax.FVal then begin TextToValue; FMax.FVal := AMax; UpdateMaxMin; ValueToText; end; end; procedure TKCustomNumberEdit.SetMaxAsInt(AMax: Int64); begin if AMax <> FMax.IVal then begin TextToValue; FMax.IVal := AMax; UpdateMaxMin; ValueToText; end; end; procedure TKCustomNumberEdit.SetMin(AMin: Extended); begin if AMin <> FMin.FVal then begin TextToValue; FMin.FVal := AMin; UpdateMaxMin; ValueToText; end; end; procedure TKCustomNumberEdit.SetMinAsInt(AMin: Int64); begin if AMin <> FMin.IVal then begin TextToValue; FMin.IVal := AMin; UpdateMaxMin; ValueToText; end; end; procedure TKCustomNumberEdit.SetName(const Value: TComponentName); var S: string; begin S := Name; inherited; if (Text = S) or (Text = Value) or (FLabel.Caption = S) then begin if (Text = S) or (Text = Value) then Text := '0'; if (FLabel <> nil) and (csSetCaption in ControlStyle) then FLabel.SetTextBuf(PChar(Name)); end; end; procedure TKCustomNumberEdit.SetOptions(AValue: TKNumberEditOptions); begin if FOptions <> AValue then begin TextToValue; FOptions := AValue; UpdateLabel; UpdateMaxMin; ValueToText; end; end; procedure TKCustomNumberEdit.SetParent(AParent: TWinControl); begin inherited; UpdateUpDown(FValue); UpdateLabel; end; procedure TKCustomNumberEdit.SetPrecision(AValue: Integer); begin if FPrecision <> AValue then begin TextToValue; FPrecision := AValue; ValueToText; end; end; procedure TKCustomNumberEdit.SetUpDownStep(AValue: Extended); begin if FUpDownStep <> AValue then begin TextToValue; FUpDownStep := AValue; ValueToText; end; end; procedure TKCustomNumberEdit.SetValue(AValue: Extended); var Warn: Boolean; begin Font.Color := clWindowText; FValue.FVal := AValue; if neoClampToMinMax in FOptions then Warn := FValue.Clamp(FMin, FMax, Signed) else Warn := False; ValueToText; UpdateUpDown(FValue); if Warn then DoWarning(FValue); end; procedure TKCustomNumberEdit.SetValueAsInt(AValue: Int64); var Warn: Boolean; begin Font.Color := clWindowText; FValue.IVal := AValue; if neoClampToMinMax in FOptions then Warn := FValue.Clamp(FMin, FMax, Signed) else Warn := False; ValueToText; UpdateUpDown(FValue); if Warn then DoWarning(FValue); end; procedure TKCustomNumberEdit.SetValueAsText(const AValue: string); var Fmt: TKNumberEditDisplayedFormat; Warn: Boolean; begin Font.Color := clWindowText; Fmt := nedfAsInput; GetFormat(AValue, Fmt, FValue); if neoClampToMinMax in FOptions then Warn := FValue.Clamp(FMin, FMax, Signed) else Warn := False; ValueToText; UpdateUpDown(FValue); if Warn then DoWarning(FValue); end; procedure TKCustomNumberEdit.TextToValue; begin GetFormat(Text, FLastInputFormat, FValue); if neoClampToMinMax in FOptions then if FValue.Clamp(FMin, FMax, Signed) then DoWarning(FValue); end; procedure TKCustomNumberEdit.UpdateFormats; var Fmt: TKNumberEditDisplayedFormat; Fmts: set of TKNumberEditDisplayedFormat; begin if FAcceptedFormats = [] then FAcceptedFormats := [neafDec]; Fmts := []; Fmt := nedfAsInput; if (neafAscii in FAcceptedFormats) then begin Include(Fmts, nedfAscii); Fmt := nedfAscii end; if (neafBin in FAcceptedFormats) then begin Include(Fmts, nedfBin); Fmt := nedfBin end; if (neafOct in FAcceptedFormats) then begin Include(Fmts, nedfOct); Fmt := nedfOct end; if (neafFloat in FAcceptedFormats) then begin Include(Fmts, nedfFloat); Fmt := nedfFloat end; if (neafHex in FAcceptedFormats) then begin Include(Fmts, nedfHex); Fmt := nedfHex end; if (neafDec in FAcceptedFormats) then begin Include(Fmts, nedfDec); Fmt := nedfDec end; if not (FDisplayedFormat in Fmts) then begin FDisplayedFormat := nedfAsInput; FLastInputFormat := Fmt; end; end; procedure TKCustomNumberEdit.UpdateLabel; var P: TPoint; begin if FLabel <> nil then if neoUseLabel in FOptions then begin case FLabelPosition of lpAbove: P := Point(Left, Top - FLabel.Height - Integer(FLabelSpacing)); lpBelow: P := Point(Left, Top + Height + Integer(FLabelSpacing)); lpLeft: P := Point(Left - Math.Max(Integer(FLabelSpacing), FLabel.Width + 3), Top + (Height - FLabel.Height) div 2); lpRight: P := Point(Left + Width + Integer(FLabelSpacing), Top + (Height - FLabel.Height) div 2); end; FLabel.Left := P.X; FLabel.Top := P.Y; FLabel.Parent := Parent end else FLabel.Parent := nil; end; procedure TKCustomNumberEdit.UpdateMaxMin; begin try if (neafHex in FAcceptedFormats) or (FDisplayedFormat = nedfHex) then begin if Signed then begin FMin.IVal := KFunctions.MinMax(FMin.IVal, Low(Integer), High(Integer)); FMax.IVal := KFunctions.MinMax(FMax.IVal, Low(Integer), High(Integer)); if FMax.LowerThan(FMin, True) then FMax.Assign(FMin); end else begin FMin.IVal := KFunctions.MinMax(FMin.IVal, 0, High(LongWord)); FMax.IVal := KFunctions.MinMax(FMax.IVal, 0, High(LongWord)); if FMax.LowerThan(FMin, False) then FMax.Assign(FMin); end; end else begin if FMax.LowerThan(FMin, Signed) then FMax.Assign(FMin); end; except FMin.IVal := 0; FMax.IVal := 1000; end; end; procedure TKCustomNumberEdit.UpdateUpDown(AValue: TKNumberValue); var Fmt: TKNumberEditDisplayedFormat; AbsMax, D, PP: Extended; begin if FUpdateUpdown and (FUpDown <> nil) then if neoUseUpDown in FOptions then begin AbsMax := Math.Max(Abs(FMax.FVal), Abs(FMin.FVal)); if FDisplayedFormat = nedfAsInput then Fmt := FLastInputFormat else Fmt := FDisplayedFormat; D := 1; case Fmt of nedfDec: D := MinMax(FUpDownStep, 1, Math.Max(AbsMax / 10, 1)); nedfHex: D := MinMax(FUpDownStep, 1, Math.Max(AbsMax / 16, 1)); nedfOct: D := MinMax(FUpDownStep, 1, Math.Max(AbsMax / 8, 1)); nedfBin: D := MinMax(FUpDownStep, 1, Math.Max(AbsMax / 2, 1)); nedfFloat: begin PP := IntPower(10, FPrecision); D := MinMax(FUpDownStep * PP, 1, Math.Max(AbsMax * PP / 10, 1)) / PP; end; end; // UpDown min, max and position are ShortInt! (ough) // - must increase the order accordingly if absolute maximum number has more digits while AbsMax / D > 30000 do case Fmt of nedfDec, nedfFloat: D := D * 10; nedfHex: D := D * 16; nedfOct: D := D * 8; nedfBin: D := D * 2; end; FUpdownChanging := True; try FUpDown.Min := Trunc(FMin.FVal / D); FUpDown.Max := Trunc(FMax.FVal / D); FUpDown.Position := Trunc(AValue.FVal / D); FUpDown.Parent := Parent; FRealUpDownStep := D; finally FUpdownChanging := False; end; end else FUpDown.Parent := nil; end; procedure TKCustomNumberEdit.UpdateUpDownPos; begin if FUpDown <> nil then FUpDown.SetBounds(Left + Width, Top, FUpDown.Width, Height); end; procedure TKCustomNumberEdit.UpDownChange; begin if Assigned(FOnUpDownChange) then FOnUpDownChange(Self); end; procedure TKCustomNumberEdit.UpDownChangingEx(Sender: TObject; var AllowChange: Boolean; NewValue: {$IFDEF COMPILER19_UP}Integer{$ELSE}SmallInt{$ENDIF}; Direction: TUpDownDirection); var V: Extended; begin if (neoUseUpDown in FOptions) and (FUpDown <> nil) and not FUpdownChanging then begin SafeSetFocus; Font.Color := clWindowText; FUpdateUpDown := False; V := MinMax(NewValue * FRealUpDownStep, FMin.FVal, FMax.FVal); if V <> Value then begin if (DisplayedFormat = nedfAsInput) and (neafDec in AcceptedFormats) and (Frac(V) = 0) then LastInputFormat := nedfDec; Value := V; UpDownChange; FUpdateUpDown := True; PostMessage(Handle, KM_NE_UPDATEUPDOWN, 0, 0); end; end; end; procedure TKCustomNumberEdit.Validate; var Fmt: TKNumberEditDisplayedFormat; begin if Empty and (neoKeepEmpty in FOptions) then Exit; Fmt := nedfAsInput; GetFormat(Text, Fmt, FValue); if (Fmt = nedfAsInput) and (neoClampToMinMax in FOptions) then FValue.Clamp(FMin, FMax, Signed) else FLastInputFormat := Fmt; Text := SetFormat(FValue); if (Fmt = nedfAsInput) and (ComponentState * [csLoading, csDesigning] = []) and HasParent then begin if neoWarning in FOptions then Font.Color := FWarningColor; if Assigned(FLog) then FLog.Log(lgInputError, sEDFormatNotAccepted); end; end; procedure TKCustomNumberEdit.ValueToText; begin Text := SetFormat(FValue); end; procedure TKCustomNumberEdit.KMNEUpdateUpDown(var Msg: TLMessage); begin TextToValue; UpdateUpDown(FValue); end; procedure TKCustomNumberEdit.CMBiDiModeChanged(var Msg: TLMessage); begin inherited; if FLabel <> nil then FLabel.BiDiMode := BidiMode; end; procedure TKCustomNumberEdit.CMEnabledChanged(var Msg: TLMessage); begin inherited; if FLabel <> nil then FLabel.Enabled := Enabled; if FUpDown <> nil then FUpDown.Enabled := Enabled; end; procedure TKCustomNumberEdit.CMVisibleChanged(var Msg: TLMessage); begin inherited; if FLabel <> nil then FLabel.Visible := Visible; if FUpDown <> nil then FUpDown.Visible := Visible; end; procedure TKCustomNumberEdit.WMKillFocus(var Msg: TLMKillFocus); begin inherited; Validate; end; procedure TKCustomNumberEdit.WMSetFocus(var Msg: TLMSetFocus); begin inherited; Font.Color := clWindowText; end; procedure TKCustomNumberEdit.WMMove(var Msg: TLMMove); begin inherited; UpdateUpDownPos; UpdateLabel; end; procedure TKCustomNumberEdit.WMPaste(var Msg: TLMPaste); var S: string; I: Integer; begin if ClipBoard.HasFormat(CF_TEXT) then begin S := ClipBoard.AsText; for I := 1 to Length(S) do if (InspectInputChar(S[I]) = #0) and not (csDesigning in ComponentState) then begin Font.Color := WarningColor; if Assigned(FLog) then FLog.Log(lgError, sEDClipboardFmtNotAccepted); SelLength := 0; Exit; end; Font.Color := clWindowText; inherited; end; end; procedure TKCustomNumberEdit.WMSize(var Msg: TLMSize); begin inherited; UpdateUpDownPos; UpdateLabel; end; { TKFileNameEditDlgProperties } constructor TKFileNameEditDlgProperties.Create; begin FInitialDir := ''; FDefaultExt := ''; FFilter := sEDAllFiles; FFilterIndex := 1; FOpenOptions := [ofHideReadOnly, ofEnableSizing]; FBrowseOptions := [bfReturnOnlyFSDirs, bfDontGoBelowDomain]; FBrowseDlgLabel := ''; end; function TKFileNameEditDlgProperties.IsBrowseOptionsStored: Boolean; begin Result := FBrowseOptions <> [bfSetFolder, bfReturnOnlyFSDirs, bfDontGoBelowDomain]; end; function TKFileNameEditDlgProperties.IsOpenOptionsStored: Boolean; begin Result := FOpenOptions <> [ofHideReadOnly, ofEnableSizing]; end; { TKFileNameEdit } constructor TKFileNameEdit.Create(AOwner: TComponent); begin inherited; FButton := nil; FButtonStyle := fbNone; FButtonAlign := fbaRight; FButtonText := sEDBrowse; FButtonWidth := 75; FButtonDist := 8; SetButtonStyle(fbButton); FOptions := [foAddToList, foCheckPath, foWarning]; FWarningColor := clRed; ControlStyle := ControlStyle - [csSetCaption]; FDlgProperties := TKFileNameEditDlgProperties.Create; FLog := nil; end; destructor TKFileNameEdit.Destroy; begin FDlgProperties.Free; inherited; end; procedure TKFileNameEdit.ButtonClick(Sender: TObject); var OD: TOpenDialog; SD: TSaveDialog; BF: TKBrowseFolderDialog; begin if foFolderOnly in FOptions then begin BF := TKBrowseFolderDialog.Create(Self); try if (Text = '') or (foAlwaysInitialDir in FOptions) then BF.Folder := FDlgProperties.InitialDir else BF.Folder := Text; BF.LabelText := FDlgProperties.BrowseDlgLabel; BF.Options := FDlgProperties.BrowseOptions; if BF.Execute then begin Text := BF.Folder; Change; if foAddToList in FOptions then Items.Insert(0, Text); FDlgProperties.InitialDir := ExtractFilePath(Text); Font.Color := clWindowText; end; finally BF.Free; end; end else if foSaveDialog in FOptions then begin SD := TSaveDialog.Create(Self); try if (Text = '') or (foAlwaysInitialDir in FOptions) then SD.InitialDir := FDlgProperties.InitialDir else SD.InitialDir := ExtractFilePath(Text); SD.DefaultExt := FDlgProperties.DefaultExt; SD.Filter := FDlgProperties.Filter; SD.FilterIndex := FDlgProperties.FilterIndex; SD.Options := FDlgProperties.OpenOptions; if SD.Execute then begin Text := SD.FileName; Change; if foAddToList in FOptions then Items.Insert(0, Text); FDlgProperties.InitialDir := ExtractFilePath(Text); Font.Color := clWindowText; end; finally SD.Free; end; end else begin OD := TOpenDialog.Create(Self); try if (Text = '') or (foAlwaysInitialDir in FOptions) then OD.InitialDir := FDlgProperties.InitialDir else OD.InitialDir := ExtractFilePath(Text); OD.DefaultExt := FDlgProperties.DefaultExt; OD.Filter := FDlgProperties.Filter; OD.FilterIndex := FDlgProperties.FilterIndex; OD.Options := FDlgProperties.OpenOptions; if OD.Execute then begin Text := OD.FileName; Change; if foAddToList in FOptions then Items.Insert(0, Text); FDlgProperties.InitialDir := ExtractFilePath(Text); Font.Color := clWindowText; end; finally OD.Free; end; end; if Assigned(FBtnOnClick) then FBtnOnClick(Sender); end; procedure TKFileNameEdit.ButtonExit(Sender: TObject); begin DoExit; end; procedure TKFileNameEdit.CMBiDiModeChanged(var Msg: TLMessage); begin inherited; {switch the button position}; UpdateButton; end; procedure TKFileNameEdit.CMEnabledChanged(var Msg: TLMessage); begin inherited; if Assigned(FButton) then FButton.Enabled := Enabled; end; procedure TKFileNameEdit.CMVisibleChanged(var Msg: TLMessage); begin inherited; if Assigned(FButton) then FButton.Visible := Visible; end; procedure TKFileNameEdit.DoEnter; begin Font.Color := clWindowText; inherited; end; procedure TKFileNameEdit.DoExit; var B: Boolean; H: HWnd; begin inherited; if FButton is TWinControl then H := TWinControl(FButton).Handle else H := 0; if (GetFocus <> H) and (ComponentState * [csLoading, csDesigning] = []) then begin Text := CorrectPath(Text, FDlgProperties.InitialDir, FOptions, B, FLog); if B then begin if foWarning in FOptions then Font.Color := FWarningColor end else if foAddToList in FOptions then if (Items.IndexOf(Text) < 0) and (Text <> '') then Items.Insert(0, Text); end; end; function TKFileNameEdit.GetFileName: TFileName; begin Result := Text; end; procedure TKFileNameEdit.KeyDown(var Key: Word; Shift: TShiftState); begin inherited; if Key = VK_RETURN then Key := 0; end; procedure TKFileNameEdit.DropDown; var I: Integer; begin // clear empty items if > 1 if Items.Count > 1 then for I := 0 to Items.Count - 1 do if Items[I] = '' then Items.Delete(I); inherited; end; procedure TKFileNameEdit.SetButton(Value: TControl); var PI: PPropInfo; N: TNotifyEvent; begin if (FButtonStyle = fbUser) and (Value <> Self) then begin FButton.Free; FBtnOnClick := nil; FButton := Value; if Assigned(FButton) then begin PI := GetPropInfo(FButton, 'OnClick'); if PI <> nil then begin FBtnOnClick := TNotifyEvent(GetMethodProp(FButton, PI)); N := ButtonClick; SetMethodProp(FButton, PI, TMethod(N)); UpdateButton; FButton.Parent := Parent; end; FButton.FreeNotification(Self); end; end; end; procedure TKFileNameEdit.SetButtonAlign(Value: TKFileNameEditButtonAlign); begin if Value <> FButtonAlign then begin FButtonAlign := Value; UpdateButton; end; end; procedure TKFileNameEdit.SetButtonStyle(Value: TKFileNameEditButtonStyle); begin if FButtonStyle <> Value then begin if FButtonStyle <> fbUser then FButton.Free; FButtonStyle := Value; FButton := nil; FBtnOnClick := nil; case Value of fbButton: begin FButton := TButton.Create(Self); try (FButton as TButton).OnClick := ButtonClick; except end; end; fbBitBtn: begin FButton := TBitBtn.Create(Self); try with FButton as TBitBtn do begin {$IFDEF FPC} Glyph.LoadFromLazarusResource('OPENDIR'); {$ELSE} Glyph.LoadFromResourceName(HInstance, 'OPENDIR'); {$ENDIF} Glyph.Transparent := True; OnClick := ButtonClick; end; except end; end; fbSpeedBtn: begin FButton := TSpeedButton.Create(Self); try with FButton as TSpeedButton do begin {$IFDEF FPC} Glyph.LoadFromLazarusResource('OPENDIR'); {$ELSE} Glyph.LoadFromResourceName(HInstance, 'OPENDIR'); {$ENDIF} Glyph.Transparent := True; OnClick := ButtonClick; end; except end; end; end; UpdateButton; if Assigned(FButton) then begin FButton.Name := '_internal_'; FButton.Parent := Parent; end; end; end; procedure TKFileNameEdit.SetButtonText(const Value: TCaption); begin if Value <> FButtonText then begin FButtonText := Value; UpdateButton; end; end; procedure TKFileNameEdit.SetButtonWidth(Value: Integer); begin if Value <> FButtonWidth then begin FButtonWidth := Value; UpdateButton; end; end; procedure TKFileNameEdit.SetButtonDist(Value: Integer); begin if Value <> FButtonDist then begin FButtonDist := Value; UpdateButton; end; end; procedure TKFileNameEdit.SetFileName(const Value: TFileName); var B: Boolean; begin if Value <> Text then begin if ComponentState * [csLoading, csDesigning] = [] then begin Text := CorrectPath(Value, FDlgProperties.InitialDir, FOptions, B, FLog); if not (csDesigning in ComponentState) then begin if B then begin if foWarning in FOptions then Font.Color := FWarningColor end else begin if foWarning in FOptions then Font.Color := clWindowText; if foAddToList in FOptions then if (Items.IndexOf(Text) < 0) and (Text <> '') then Items.Insert(0, Text); end; Change; end; end else Text := Value; end; end; procedure TKFileNameEdit.SetOptions(Value: TKFileNameEditOptions); begin if Value <> FOptions then FOptions := Value; end; procedure TKFileNameEdit.SetParent(AParent: TWinControl); begin inherited; if Assigned(FButton) then begin if Parent <> nil then UpdateButton; FButton.Parent := AParent; end; end; procedure TKFileNameEdit.WMMove(var Msg: TLMMove); begin inherited; UpdateButton; end; procedure TKFileNameEdit.UpdateButton; procedure SetButtonPos(ALeft, ADown: Boolean); begin if ALeft then if ADown then begin FButton.Left := Left; FButton.Top := Top + Height + FButtonDist; end else begin FButton.Left := Left - FButton.Width - FButtonDist; FButton.Top := Top; FButton.Height := Height; end else if ADown then begin FButton.Left := Left + Width - FButton.Width; FButton.Top := Top + Height + FButtonDist; end else begin FButton.Left := Left + Width + FButtonDist; FButton.Top := Top; FButton.Height := Height; end; end; var M: TNotifyEvent; begin if Assigned(FButton) then begin if FButtonText <> '&' then FButton.SetTextBuf(PChar(FButtonText)) else FButton.SetTextBuf(''); FButton.Width := FButtonWidth; if IsPublishedProp(FButton, 'OnExit') then try SetOrdProp(FButton, 'TabStop', Integer(True)); SetOrdProp(FButton, 'TabOrder', TabOrder + 1); M := ButtonExit; SetMethodProp(FButton, 'OnExit', TMethod(M)); except end; if BiDiMode in [bdLeftToRight, bdRightToLeftReadingOnly] then if FButtonAlign in [fbaLeft, fbaLeftDown] then SetButtonPos(True, FButtonAlign = fbaLeftDown) else SetButtonPos(False, FButtonAlign = fbaRightDown) else if FButtonAlign in [fbaLeft, fbaLeftDown] then SetButtonPos(False, FButtonAlign = fbaLeftDown) else SetButtonPos(False, FButtonAlign = fbaRightDown); end; end; procedure TKFileNameEdit.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if (AComponent = FButton) and (Operation = opRemove) then FButton := nil; end; procedure TKFileNameEdit.WMSize(var Msg: TLMSize); begin inherited; UpdateButton; end; function TKFileNameEdit.IsButtonStored: Boolean; begin Result := (FButton <> nil) and (FButton.Name <> '_internal_'); end; function TKFileNameEdit.IsButtonTextStored: Boolean; begin Result := FButtonText <> sEDBrowse; end; function TKFileNameEdit.GetWholeLeft: Integer; begin if Assigned(FButton) then Result := Min(Left, FButton.Left) else Result := Left; end; {$IFDEF FPC} procedure TKFileNameEdit.SetFlat(Value: Boolean); begin if Value <> FFlat then begin FFlat := Value; Invalidate; end; end; {$ENDIF} procedure TKFileNameEdit.SetWholeLeft(const Value: Integer); var L: Integer; begin L := WholeLeft; if L <> Value then begin if Assigned(FButton) then FButton.Left := FButton.Left + Value - L; Left := Left + Value - L; end; end; function TKFileNameEdit.GetWholeWidth: Integer; begin if Assigned(FButton) then Result := Max(Left + Width, FButton.Left + FButton.Width) - WholeLeft else Result := Width; end; procedure TKFileNameEdit.SetWholeWidth(Value: Integer); var W: Integer; begin W := WholeWidth; if W <> Value then begin if Assigned(FButton) then begin if BiDiMode in [bdLeftToRight, bdRightToLeftReadingOnly] then begin case FButtonAlign of fbaLeft: Width := Max(Value - Left + FButton.Left, 5); fbaRight: Width := Max(Value - (FButton.Left + FButton.Width - Left - Width), 5); else Width := Max(Value, FButton.Width + 5); end; end else begin case FButtonAlign of fbaRight: Width := Max(Value - Left + FButton.Left, 5); fbaLeft: Width := Max(Value - (FButton.Left + FButton.Width - Left - Width), 5); else Width := Max(Value, FButton.Width + 5); end; end; UpdateButton; end else Width := Value; end; end; {$IFDEF FPC} initialization {$i kedits.lrs} {$ELSE} {$R kedits.res} {$ENDIF} end. tomboy-ng_0.34-1/kcontrols/style.css0000644000175000017500000000253614125207534017314 0ustar dbannondbannontomboy-ng_0.34-1/kcontrols/resource_src/0000755000175000017500000000000014145033543020131 5ustar dbannondbannontomboy-ng_0.34-1/kcontrols/resource_src/tkpagecontrol.png0000644000175000017500000000204514125207534023515 0ustar dbannondbannonPNG  IHDRw=gAMA7tEXtSoftwareAdobe ImageReadyqe<IDATxڴU]lSe~9==vznְn#U::ⅈ%JT.@.c7^v MWݘhpiTY Zߞ{-۴&O>=LĿz/!5GÆ`an"A}o#-buNG&pZ:&+q8y(ۭt-XjB돽'˹Y0|Dw"G?>n/_Jvf !N!B^Z!P(W[s"3-z%LwUU }8g pbnd)JX(g+b3]E X`xz1l~ hY4ŋQ p LpKXY880p.6yncanQF^b> T@ h 3pa6 ~KO1I2)2(lu``e[@>Ű{Caa@K.L~C Kdϒ < b ̞ |q۟ f`8A  5R ~ ( _0*p`X@DU~pS^1w waX@DC;lëL ap *0rg; لMULeh }0`;\@߿b_HJ2d6cp|e, $ R 2s5A<<ǰ^&F0ϕ*1%3} /~3ccn-m/@CX f`Q ,"8..83 /Oc26ZY95$@ H'V-@1S8İ{.v/N@riFg {1e~o';}@L i@D  } @DE2O( (D B1^',Q~IENDB`tomboy-ng_0.34-1/kcontrols/resource_src/opendir.bmp0000644000175000017500000000147014125207534022274 0ustar dbannondbannonBM86(rpnnnnnnno}))))))))))8X~))`7o))`|)W})h)`{rh7o)[)`quvuqkd[)X})KR)``a`]YRKK:u)`e)))))))))))~))u)֤)))))֤))֡xto)))֤}n{zyqtomboy-ng_0.34-1/kcontrols/resource_src/kcontrols_laz.txt0000644000175000017500000000007414125207534023560 0ustar dbannondbannonkpreview_cursor_hand_free.cur kpreview_cursor_hand_grip.curtomboy-ng_0.34-1/kcontrols/resource_src/kgriddemolaz_rsrc.txt0000644000175000017500000000003114125207534024372 0ustar dbannondbannon./kgrid_icons/_cube.bmp tomboy-ng_0.34-1/kcontrols/resource_src/tkpercentprogressbar.png0000644000175000017500000000177414125207534025122 0ustar dbannondbannonPNG  IHDRw= pHYs  gAMA|Q cHRMz%u0`:o_FrIDATxKh\U;+MNR0MH(RJ1ME$ l *BU]qYD,-R$h%M -bhjl My$̝s o,n9rv>a bTnt{-v4j_\%GC;3r% p^ Tّ;;RzvnڡV4tgG poգAր2<@ <5⳥[u#R2>ۡ5 {"hsaf+t:aU!6:^-˒Mk2)IENDB`tomboy-ng_0.34-1/kcontrols/resource_src/tksplitter.png0000644000175000017500000000203614125207534023046 0ustar dbannondbannonPNG  IHDRw=gAMA7tEXtSoftwareAdobe ImageReadyqe<IDATxԕMlE;;c&qRBhRʁ.HP  J'([(j$qzycMWpbx{V<[T"H1". 'V?8.Q%\:l#zNkݜjݬ{? ~8]8W! Sp=dk"n3W{dfDvGa~!&oRK<㈒}קL=T?W*n'l?s,Xf>|gכ`h@m]}Ǖez.KG-464(`Xzg;F WBާL3eojnƷ3IDPe+yx "{<'2M BA'E\]`{.G,(*Z&{UiY#6Qw7x1Ee[֑;Ӆbukj Uqyp둫6w݆i ] s:)m7[ *qp$xjZbނs6N~x A7sҐV+$e%|M]:kKaG*A4UՔwsuo)JT-[xl7֧'BP0.b}< kQ)!U7JAp6'0pߝ06M٧ډƑ֨lzuRiyؖ:4ԍDWkY[bpd,T+t^#fslu!0&J%tN}..6.[o9K/ao ʒz?_Ǝmz'T|:՜_JUÍ>Ug_YCEm%.c^IENDB`tomboy-ng_0.34-1/kcontrols/resource_src/kedits.rc0000644000175000017500000000003414125207534021740 0ustar dbannondbannonopendir BITMAP "opendir.bmp"tomboy-ng_0.34-1/kcontrols/resource_src/tkfilenameedit.bmp0000644000175000017500000000337014125207534023622 0ustar dbannondbannonBM6(  𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠tomboy-ng_0.34-1/kcontrols/resource_src/tkhexeditor.png0000644000175000017500000000220114125207534023165 0ustar dbannondbannonPNG  IHDRw=gAMA|Q cHRMz%u0`:o IDATxb?y`?`b^ bq(> ~@,$ $X(*@yM6nn###VXYxx8xy8Yb"" r &Z 3~ 2s3|Ġǹ P|@lp}t7?2q1gcV>*b@A؈da=7w+'0f oMNN^GifA6 OoaPdk5IJ s ÷Gu\c0`. VO $%. g8p~>G D3yg>1p02\z` /7@ 28{wF003}/ G>13 3p;J0֘0s2D@B/8C|2\獏 Nedc``)duÅo,,LAYG >xΞ~{2}e`~. A X?D@>P3&I1İo fF!U`~;@PMUNȒο' ["q02P@} #`n. LEr(Fo _/zA?n& ?L,8{AEȠ, ;ќA ^ ,WEix>cA<j`| ,_ttT>>`bgecu kGIsN3}d,( LBtH߁qnG`KC@1 XT,o?Tu6@LD_`b09pmDB;"@Dl|rhA@X`‡yD @WVq d2@ dETIENDB`tomboy-ng_0.34-1/kcontrols/resource_src/tkprintpreviewdialog.bmp0000644000175000017500000000062614125207534025113 0ustar dbannondbannonBMv(   B~i` ` i`iD &i`$C" iDD$i`D$ i4"i`D i`ii`iii`hiiUUUUUUUwwwwwwwwxqtomboy-ng_0.34-1/kcontrols/resource_src/tkdbgrid.bmp0000644000175000017500000000062614125207534022430 0ustar dbannondbannonBMv(   |B~`fffffff`bUfeRUf`fffffff`eUfeUUV`fffffff`eUfe%UfP`fffffffU0`bTFeUUV30`fdDffdF3 DDD%0`fdDfdDF30DDD3"""4DDDAR333$DDD33334DDA3%%"4DDU333"DDA33333TDR333"DA"R%Atomboy-ng_0.34-1/kcontrols/resource_src/kcontrols_laz.bat0000644000175000017500000000050314125207534023504 0ustar dbannondbannonlazres ../source/kcontrols.lrs @kcontrols_laz.txt lazres ../packages/kcontrols/kcontrols.lrs @kcontrols_laz.txt lazres ../source/kgrids.lrs @kgrids_laz.txt lazres ../demos/kgrid/kgriddemolaz_rsrc.lrs @kgriddemolaz_rsrc.txt lazres ../source/kmessagebox.lrs @kmessagebox_laz.txt lazres ../source/kedits.lrs @kedits_laz.txttomboy-ng_0.34-1/kcontrols/resource_src/kcontrolsdesign.rc0000644000175000017500000000147014125207534023672 0ustar dbannondbannontkgrid BITMAP "tkgrid.bmp" tkdbgrid BITMAP "tkdbgrid.bmp" tkhexeditor BITMAP "tkhexeditor.bmp" tknumberedit BITMAP "tknumberedit.bmp" tkfilenameedit BITMAP "tkfilenameedit.bmp" tklog BITMAP "tklog.bmp" tkprintpreview BITMAP "tkprintpreview.bmp" tkprintpreviewdialog BITMAP "tkprintpreviewdialog.bmp" tkprintsetupdialog BITMAP "tkprintsetupdialog.bmp" tkbrowsefolderdialog BITMAP "tkbrowsefolderdialog.bmp" tklinklabel BITMAP "tklinklabel.bmp" tkgradientlabel BITMAP "tkgradientlabel.bmp" tkpercentprogressbar BITMAP "tkpercentprogressbar.bmp" tkmemo BITMAP "tkmemo.bmp" tkmemoframe BITMAP "tkmemoframe.bmp" tkbitbtn BITMAP "tkbitbtn.bmp" tkcolorbutton BITMAP "tkcolorbutton.bmp" tkspeedbutton BITMAP "tkspeedbutton.bmp" tksplitter BITMAP "tksplitter.bmp" tkpagecontrol BITMAP "tkpagecontrol.bmp" tomboy-ng_0.34-1/kcontrols/resource_src/tkgradientlabel.bmp0000644000175000017500000000337014125207534023771 0ustar dbannondbannonBM6(  (5,D:SJb[qjz  )5,C;SKbZqj{  (5,C:SJbZqjz  (5+C:SJbZpjz 6,6+D;RKbZ ys6,D:RJvo OGـ ̀ rlD:  [S ր 5,  (\Ssl~wb[  (6+D;SKb[ )5,C;SKbZpj )6+D;RJbZpjztomboy-ng_0.34-1/kcontrols/resource_src/tkcolorbutton.bmp0000644000175000017500000000337014125207534023546 0ustar dbannondbannonBM6(  𠠠𠠠𠠠𠠠tomboy-ng_0.34-1/kcontrols/resource_src/tkfilenameedit.png0000644000175000017500000000176614125207534023637 0ustar dbannondbannonPNG  IHDRw= pHYs  gAMA|Q cHRMz%u0`:o_FlIDATx[hUgfvw6{eTۀ( V5-K} TP|!*B}+AiFm1%Ik2s|piiU|3gR1t ! W? Q]zuՂFg^uN9 F40T sSOw ۤG؃V;1 턁xn蹈g}؃n۫a`Tઇ`:MM>ZZB1O6yk߈ay74ߞn7tMM& NpD4GɆ2M->߸'[}7+5{5z~N1o@Y9ty:N'R`-Irq@ [ $;JH/j92hhu!9`ZcM\fW(ɐW*()p\mz[ܑɊmaC@4n !%Dz#ZE2)-kx7$=[+<٢|"~AdCc46&ibcBclbjHi "eeݹ[`?ə/9d6Wϭ^ @(>K@ f6/%Dv)mƌ]dpz @Ѐɝ@ҧӻ/.f Z_͞4ӓvPrHN x }S̢W3 d6޲"wit\8|n>gyPJܨ1!b\@cZopS@~^O[/rH* xvEPaRN~깃{y] WX܂ċ9_$y( ︈m"s4t~SWJN݂j ?u˧0s_KNj^<_ٶ|5s[6 <ҍn1V¯ ͌u9AO GN2 *|H '6phYAOm2>0ҥ9SKTeS6,+r/2GڈXtcPH[i9d`xm{esϗiVӛOR\0禙no,ͦ05 J cOaL%9MjZ:J}C1K^_:JX tȎ lz}DcI>}&eg^q\4h@5ךg_5EC9{Zf~WbY&@Lɽ6 L!kժƍ͌DL.1?}/1; 2Ƕ-D L!2`Zd IIjfNh(;6M$?R+顦:mi#t_?w_4qI6~IENDB`tomboy-ng_0.34-1/kcontrols/resource_src/tkprintpreview.bmp0000644000175000017500000000062614125207534023733 0ustar dbannondbannonBMv(   @B~UUUUUUPUUUUU UUUUP1UUUU3!UUUU310UUUU#10UUUTA"1UUUTD1LUUUTDDDUUUTDUTDLUUUTDUDDUUUTDDDLUUUTDDDUUUTDD@UUUTDTDUUUUDDLUUUUTDUUUUUDL Ltomboy-ng_0.34-1/kcontrols/resource_src/convertbitmaps.bat0000644000175000017500000000124414125207534023663 0ustar dbannondbannonBitmapToAlphaBitmap kgrid_hci_hbegin.bmp .\alphabitmaps\kgrid_hci_hbegin.bmp BitmapToAlphaBitmap kgrid_hci_hcenter.bmp .\alphabitmaps\kgrid_hci_hcenter.bmp BitmapToAlphaBitmap kgrid_hci_hend.bmp .\alphabitmaps\kgrid_hci_hend.bmp BitmapToAlphaBitmap kgrid_hci_vbegin.bmp .\alphabitmaps\kgrid_hci_vbegin.bmp BitmapToAlphaBitmap kgrid_hci_vcenter.bmp .\alphabitmaps\kgrid_hci_vcenter.bmp BitmapToAlphaBitmap kgrid_hci_vend.bmp .\alphabitmaps\kgrid_hci_vend.bmp BitmapToAlphaBitmap kgrid_drag_arrow.bmp .\alphabitmaps\kgrid_drag_arrow.bmp BitmapToAlphaBitmap kgrid_sort_arrow.bmp .\alphabitmaps\kgrid_sort_arrow.bmp BitmapToAlphaBitmap _cube.bmp .\alphabitmaps\_cube.bmp tomboy-ng_0.34-1/kcontrols/resource_src/tkprintsetupdialog.png0000644000175000017500000000313014125207534024571 0ustar dbannondbannonPNG  IHDRw=gAMA|Q cHRMz%u0`:oIDATxb?y`?`b^ bq(> ~@,ke1111###33;; //07'Dx$D?Fr?@, Ӓ4 d(f[Suᩞ#س+ w3_00&W;w@2/]Rl ?2XpUku9Յ/2I2caxEl_qZ4AZAxSG?2XgJ3\t BiqfA6.].3 >܊..6q9q giGnK2j2H}c7õ ̪ l U Y3}A@lAGG.V?||_f66V+] &1`N`P,-, NNǏ/b@ {?dPTP&f20߷?ͽp808h2÷o1n0>.~G@T /^fex9'03%2iK1|fg,  2x1 1{ ` 8w}@K^Le>1y_ ?͕ 8~t?` )) 0,,CXYYtnݾLϬ,la& QeuM/_9q~.*~VBd];. H0 \<3AhHjb/L Xl fh_3 7I Ig_0|AS[ҥkD ׮\0<տ0LFCCa֬ ή x-fXp9CFj2Z(0܂{ie5f'k߿#/T9@G6`pWk}=2k%؂rZ \ 9_ K&p\K_ c\ 1w~rx#@1l!/h7[ IENDB`tomboy-ng_0.34-1/kcontrols/resource_src/tkgrid.bmp0000644000175000017500000000062614125207534022122 0ustar dbannondbannonBMv(   @B~"!"!"!!!!!"!!!!!""!"!!ADA03334D33DD02"34D"4DA03334D3DD02"34DDDA03334DDD02"34DDC03334D4D02"32D"DA03333434DDA03333333Atomboy-ng_0.34-1/kcontrols/resource_src/kgrids_laz.txt0000644000175000017500000000052014125207534023021 0ustar dbannondbannon./kgrid_icons/kgrid_hci_hbegin.bmp ./kgrid_icons/kgrid_hci_hcenter.bmp ./kgrid_icons/kgrid_hci_hend.bmp ./kgrid_icons/kgrid_hci_vbegin.bmp ./kgrid_icons/kgrid_hci_vcenter.bmp ./kgrid_icons/kgrid_hci_vend.bmp ./kgrid_icons/kgrid_drag_arrow.bmp ./kgrid_icons/kgrid_sort_arrow.bmp kgrid_cursor_hresize.cur kgrid_cursor_vresize.curtomboy-ng_0.34-1/kcontrols/resource_src/tkbrowsefolderdialog.bmp0000644000175000017500000000337014125207534025051 0ustar dbannondbannonBM6(  tomboy-ng_0.34-1/kcontrols/resource_src/tkprintsetupdialog.bmp0000644000175000017500000000062614125207534024572 0ustar dbannondbannonBMv(   B~XXXXXXXXXXSS333330XXUUUUUSPeUUUUS0X0XUUTEUX0XSD5EXXDDD$DPDEXXXPDDDXDDDEXXXXDDDXXDD@XXXXTDTDXXDDEDwwwwwwwDH333333334C1tomboy-ng_0.34-1/kcontrols/resource_src/tkbitbtn.bmp0000644000175000017500000000337014125207534022456 0ustar dbannondbannonBM6(  𠠠𠠠𠠠𠠠tomboy-ng_0.34-1/kcontrols/resource_src/kcontrols.rc0000644000175000017500000000020214125207534022470 0ustar dbannondbannonkpreview_cursor_hand_free CURSOR "kpreview_cursor_hand_free.cur" kpreview_cursor_hand_grip CURSOR "kpreview_cursor_hand_grip.cur"tomboy-ng_0.34-1/kcontrols/resource_src/tkpagecontrol.bmp0000644000175000017500000000337014125207534023511 0ustar dbannondbannonBM6(  𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠tomboy-ng_0.34-1/kcontrols/resource_src/kgrid_cursor_hresize.cur0000644000175000017500000000050614125207534025074 0ustar dbannondbannon 0( @@@@@2LRJyyRJ2L@@@@?????3113?????tomboy-ng_0.34-1/kcontrols/resource_src/tkmemo.png0000644000175000017500000000176014125207534022140 0ustar dbannondbannonPNG  IHDRw=gAMA7tEXtSoftwareAdobe ImageReadyqe<IDATxڴV[lKq[OYוZ6aDƒKL@=,1ADDƒXA$BmbY\mN9w괌b|]è_-pFp >C$| ^x^WXH('?U/wZ2r4-a x Vs Qk$Zk2B}];C <H(n Wj5ì`4cfx'fC1rf-J~rўoHNXfC+@" dcbqqfq>'fCPJb.vQƕQsLnpz0L!E)#;ZaeLfڳ `qZ4Z(IEQ%IL)}8<s# e]P\]x) "|5j+ M̋D8P;hRL䤋P=s jK"r/!;VpT0(m ~G%3VSDI]>c0 &rdk#iԟ1'vBϾJ͘\q+]h[K  x芾nϚAӖ!هuqMh;B]*g8ɗxbKBejgkTܐ!ǹmP6Ycj0H!^86J v-ǜpO#(X9S{OnA,h|Wd!IV-@~|8ΧݩCQ-7i%k;B=yJuEWjjʲlN(GJQ4(6y U#U7E"v6}4k;)q'B=Ka2U#;g" 4IENDB`tomboy-ng_0.34-1/kcontrols/resource_src/tklinklabel.bmp0000644000175000017500000000337014125207534023131 0ustar dbannondbannonBM6(  tomboy-ng_0.34-1/kcontrols/resource_src/tkgradientlabel.png0000644000175000017500000000205114125207534023772 0ustar dbannondbannonPNG  IHDRw= pHYs  gAMA|Q cHRMz%u0`:o_FIDATxԕ[heefvvvQA"Xm@E)>WA)}IEKA* EC*-PC-MZjCM&$fva&lvΙw9 )%6T@,r,9`+W,"5XdhS2tYZ~1^Z?O [q`i E @wi{\qZ2Nx:yж@(fЄˑ8Sk֔-o? xbB 8R` ]ݝu۳Gz0:-FN{WMۑ>0S6 [Bl[~G^@efiSQqOlŚYTF h:&8H?H .9cbh!?2Wڴ] ma<飢OeQĠcoX/^ޯqo[pu+d4JB`ڝEV a 5aRQ w(]xbEjɺ5' ;k5,'N16_8bEUU[_s&Pj~G%͵BB! RJLf̘A84MLDJYy&d2y<m{GK3hnnUU4440cƌܹ-۷ooJ3xW7!?~dܹyX7?{񔗣(~?ȱ7iteW^U(H)9<]]]W._{% '_]vTTT_d H4D|t׋OYc$쳔١!L]ߧbzR$ Ν;nڴi#ʏ]v\,Yɧ?'-HU^lQ^Ju2}} *x}!Du:;;9?z"qUv1sK.0 2(]K҆=k9ADi$;;Qgbs!B!>S:;;hjjx-<؈a <ɉ\YB\//!%spݻ,Z `Fef߿mRxW7TVV>|r <kOee41P9޳RZmn5ϴ@UU:ڭBy9PL&S___?z詉HK?VXdFóz5% j_II)`?~ĩ6}[hЄkn?tŻwSr cy!ldKX,=vڟlߏOHaʔ)'2@0;w3?|rLӤ`ӧ_3_4Mj =<.a:,hE(1ءCcr@CQg I&5'O>sɳ@v\[͛:y̙f a:\Pg_?3gR3 H$r.f=xߔ);at]oqOAk˖-4M>پxa+A]{0 rDV`УQ 7s&ӷo'JN f-//';((B L\&lh2::ZJtuu9QPEy6uR9uqu]ϓȪ*SmW['dHs\޲,t*׮D"aA(n;V:YoD&8~L-0'୩aOKIRd24DD"o~h4oz4L*eeeB[R 677,Xa|!-޴ L;R7pǻ % ڞu4QǃQZZʬjھMRgX@'0 TUE4B(B?OY)IttԄL&wNfN*"JxH~TK@Qh.*%%%TE1# "$YMZtX fryMJi^/@ ȶ^49S&`&#G}[:dz{ M̽2(4 MPU5o0Mx5ґ}VZZP.`0Xmz @O\9}to/4Bim?gvHy:?1ٳc^VqQ(\UEP4lyϤ!}U!R+#LUUfQ@pq xs~Pq.rR׹bw>"o9scq -bΞ=UsaPL#+W"u}Ȃ,~mb,lepʧOQR2 ǃiB)E׷bEZ[[;֍ 3JH))[z !Xg 2x A|&F7oDae-&L&I$ǏL]XWQ#uϴivtzuFS+Wlj2R]]|"|FMTNj/Z2(-e҆ η6mZAsF" #/ˏފ޻o~3i7nD Q.= ~{y%뮻h6+&zo︐_޻@Ue,-yaֻ} y'2RFw]zPn# wm7`vsT< sygť~l,FϷ7 DmS˝VSq Xn;eUʋ/B(D<ȑ#g}Ç.Qn ȧ~˿jkkCuKJ>_w >sỈ(O[['Nxg! /}kqϝ4iedyi͊#fXKf3ClۆRW>裃[lyq-jMD|뭷ZtirNyyEb?F Xmg$an:łO?m>S%,xj$߿:[p8Y 1Z[v5) k/ '"BQza:u} rp&ۿK,JKJJ4 Q_rHMNO # {//z!H$p8pt:B! yWcTW[H1\BoGw45.YzBpZZZSSSXxl*Pr=DEEŊɓ';;(ݨ Zkk,J[5s\x/C.c%s 2FƍmB #H[0at&app!GGyeǎ1R9̗Zt+W]lنP(tK !  RK:fttD"FOݻwѣGaR|Xĥu555&MT_RRr] vFbEQfTjҥKg[[[;;mM0ۤUUV}E|4ܖxE1 c_mH?eIENDB`tomboy-ng_0.34-1/kcontrols/resource_src/tkcolorbutton.png0000644000175000017500000000225414125207534023554 0ustar dbannondbannonPNG  IHDRw=gAMA7tEXtSoftwareAdobe ImageReadyqe<>IDATxU]hU=ΝI?l&)MiVP"⃔VlJQ(J">AcJ`Bk?!Ig7;;3wL661j7rؙ;~} SJǏ@#(!MTa0M!!**mʖTTC~~H'0!FTQfM;^y:RȉTכK2n%mصyJJ 7:;Ѫ׹=؞-;8 UAY#@W=IET%BbjܠH0 ,bR)!~3t';&01rAE>RMN]7 >'T_'-f"kxJa@E j0aX-xey܄%C)C | Js>C@n.)I"fp4ɜ/+EBOE,h8q(ޯ`Հ54a9ZV0⸲&Jlomy Eo$ 7v~u%ID$SGa}N.´dUrX>f7O!9:5CJw ̊CSu c$4MC67 jQ mbL$ -E&b~r,0~<1E-p(n1q_ C?'ۇPTO⁆)<ǦMNF[~@|S L +#/v-#qKd$Ctxꚁ5ÖwX^^Cs~d*0mz8 #'*IWI[&EShsYq[Z} ϋ*@5eAКFA=Tؙl|xڴj2P17@R%:^jć]=_wh4 yg&? nk 0Uk *IENDB`tomboy-ng_0.34-1/kcontrols/resource_src/tkpercentprogressbar.bmp0000644000175000017500000000337014125207534025106 0ustar dbannondbannonBM6(  𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠tomboy-ng_0.34-1/kcontrols/resource_src/kmessagebox_question.png0000644000175000017500000000714314125207534025104 0ustar dbannondbannonPNG  IHDR00W*IDAThyl}?ｙ{I(JdIBZY W@m+Hmu[M A&E5l SH|nR[%[2):(K$E}.qf~w >6ɇj.؉_DBEPZ^pxs<4}~+OYx(O>f?l&ӚRzJ5Jǩ?xr/ 81 V߰nU+p=bե\7}h4`*0 0h-(,Kʥs]S_QC؀߿WHuߦ#o#0/\/xn߮9 mv\( 3NmS+1`|߃h}@;628Lpt.YIA 7,,Ѭ-x;/w9|/n޸=l&'뜾hzA=k0.b@{ 4=}0I&CKs[sgV5`=n۹}:/ؼ5Qb]MqjdʘA8ZA!oZկgUO E#;7dssެO2l ֙(W]~N5RD@HT8 ̉_xj ..o@7Uf}]&_(A5Zg|Gy~e Dx?$vJp/)t۱-yoMyᶛVm=CۀlJƮ([so{. =4n{G~|drh B$#ѿXK'СD!}w\Eytc)pk^a<}FƗkn˺$?H2gݞHe" _xgq)= -۷qff. @ߒٷ(V\ה*_mvz}/YR #L@#$H/b+Gbw{A:f c+94YToQJPyL:2+,R9OȮ-F D5rʥF2 ` hR)틅`k/1,>:LfM^=ZϿ3͛'jA2!l Iz#?YdזTLjmL,il~4S6S3>THf<2R>Y|d#HafdGwV%)z`8=Q+ 7hw}M)<.l:לPs@RE{M0< ]2 lawsiUtR /zA"l=MJ_}ne(w3 0 D~t !wg)ռ+54Z,qs_K. .\!7RuáF +=`@FJVA!8x44lYkuH'?t R$ ٪k Rh !`RȤ_t.~SixmŦU^rULGϻd+E!HFoSh45l|M:`Zƪfh>{}.ug~^?ިN h1#-R!4)̴<"[Q44lB 2hgcxϦU&w|fxIxk7+з*Pk:bCBPR`:2P@>P,T^q._~iZC\"7@Az Z`^5оwTłC A;$m4[XOvH?|ل|t.@Cg@PpCךE G's1ٽ%Zl{&>3}GX PB:_"~|ߩ <>R(0]q\;h@+5L]p1)J+Rbs +r8`^)I:!7B 6jMTqL#jq)b3<[\Y @G蔒_NjMfDY~\u81;[bI;=UJ8ovG !gi e# 4W}SvT%)Xt$HHydJ)̤J)R9tIf.ZDqm: $RzG:JnZFC%ҩ} :Ҡ͈6=CRy&0PF \S;P =G&ѵB-B Q\_tY+ ]߾OVBkF~كrg3y.V/2ZK'8<]Uê<@6)4*^{y +%PF(pHrT.yScN?{CFjpMOV檭4M)A';]k]Tm85H@6UdJ*/tr#7Qxl xkϿ[I~Le29${~j3˅&ԥ$İT%nu~tW^:q;jMv] _~aƷ+?Όl}BQ8= Ne\1#\JaP24??ȡ7N?p Ǧc/y7ATMCK#XIa.c{Ȏ~?81/&Lbcء'&7F/ z@f}~kw sňodP%(p*>0%}i`NK t sKߎf{mfzp\(3MR@k7STڥ♉ެ-q(6U/`CИ$d8(IxZFo/w; =IENDB`tomboy-ng_0.34-1/kcontrols/resource_src/arrow.bmp0000644000175000017500000000266214125207534021772 0ustar dbannondbannonBM6(|tomboy-ng_0.34-1/kcontrols/resource_src/tklinklabel.png0000644000175000017500000000176514125207534023145 0ustar dbannondbannonPNG  IHDRw= pHYs  gAMA|Q cHRMz%u0`:o_FkIDATxԕKh\U=y?36&6J!Zu!fji`%)$"ԍ .+"iAQsm!hIg!x~+p _NKOK`~20XW- %'$h<*`4,în3UyXd!ُRkUaa_PSs`/,ܻ5@u CZM}y{$.f4F1JT t+.xhZ/Z% Uer, 7\K#/9tj8sUSphpL7ӗnagJsrpKvI2O᥽f5}cd9HW'4;9ZBkçq*q2H`)x@֧7Z?3x괆e7_}%aV QvO3B>' Sb" +%v OmJX*;4{z̈NR"rP1#Vr2j֢dָ5ݪ;IENDB`tomboy-ng_0.34-1/kcontrols/resource_src/kcontrolsdesign_laz.txt0000644000175000017500000000056014125207534024752 0ustar dbannondbannontkgrid.png tkdbgrid.png tkhexeditor.png tknumberedit.png tkfilenameedit.png tklog.png tkprintpreview.png tkprintpreviewdialog.png tkprintsetupdialog.png tkbrowsefolderdialog.png tklinklabel.png tkgradientlabel.png tkpercentprogressbar.png tkmemo.png tkmemoframe.png tkbitbtn.png tkcolorbutton.png tkspeedbutton.png tksplitter.png tkpagecontrol.png tomboy-ng_0.34-1/kcontrols/resource_src/kprintpreview_icons/0000755000175000017500000000000014125207534024236 5ustar dbannondbannontomboy-ng_0.34-1/kcontrols/resource_src/kprintpreview_icons/04_print.png0000644000175000017500000001012214125207534026377 0ustar dbannondbannonPNG  IHDRw= :iCCPPhotoshop ICC profilexwTTϽwz0)C 7Da`(34!EDA"""` `QQy3Vt彗g}k=g}ֺtX 4Jc `23B=ÀH>nL"7w+7tI؂dPĩق }F1(1E";cX| v[="ޚ%qQ-["LqEVaf"+IĦ"&BD)+Rn|nbң2ޜT@`d0l[zZ ?KF\[fFf_nM{H? }_z=YQmv|c34 )[W%I Ȱ316rX7(ݝ ⺱SӅ|zfšyq_0sxpєqyv\7GSa؟8"Q>j1>s@7|8ՉŹ,߳e%9-$H*P*@#`l=p0VHiA>@ vjP @h'@8 .:n``a!2D UH 2!y@PAB&*: :]B=h~L2 p"΃ p\ u6<?g! DCJiA^&2L#PEGQި(j5jU:jGnFQ3Oh2Z mC#щlt݈nC_BF`0FcDa1k0Vy f 3bXl `{ǰCq[3yq<\ww7Zx;| ŗ]8~ M!8Ʉ*B !HT'\b8 q$C'bHBvay=+2Mv&G&Ec[ [bDDĐ I* Zc0&8(&iYH~Ho(%46h0װu wKDŽ7EGGDDōFG7FϮX{xULQ̝:+sV^]*uՙXXf8t\DѸ@f=s6'~_ ˍ̮`Oq8圉D]SINII\7n5ewrm\J`ᔅԈ4\Z\) /ד>aQ1n3|?~c&2S@L uYY5YoóOHrrsNy};_-cZuuk/\?kÑ)*0-(/x)bSWr±^$E[nEmnfmOk%%%JY׾1ꛅ ˬir]+wZiYYGgʿs{?T'U߮qiݧo۾C*זԾ?=xΫ^P֡ 2mjTl,ixwxHȑ&JG˚faԱc7sŨZr}wN>8(mP{nLGRHgT)S]]m?x3g]8wn| ƺc\x'ߥ+=/_u=wvWO]c\n}Ϫ'l:o\:xviMoܺ~{;˾;y/Ylx~XHQc?:b=rf}Icda)iDӤ)ϩV<|~W_}oοDΌ\«ï-_w>~f~#zGPQc'O6gAMA|Q cHRMz%u0`:oIDATxb?-@,;##mV&`'0[`L:?}S0 X3B4,n.V)1n cɈcR/^g3DF&`6@p}t?* Xy@glĽArA}k`KB _0|pPA?88,#J33ËEno ~~ P10~ h *h(.C`q&f&̯.20}}3 #,_1 gc?/b?g6H /eh +J$܂pfdi! t?ph dS1F&Dr p&8IB؍1R5of?0b`3Lr;}_\v"hbzoV<Ƀ} L @'m5F^~fPVQcfҍ:sff$@yY|72;rH9? ALT}.߿30 n6vV.y)9$SB2%,/D!0YA X@6c|pos&J" x9E/0!e'/o߾9 çO?>|w-:#L<?~ X@|0@^VL1pA!0(>}?b 2 rN 7f`j8ͺ?0(2Hj0<|h.'gƟOS0B0 Rp3p@׃ FIJsNw~W߿3:rAXBBTdC;0R&0.Xxev@,&LΔL#]=Uՠfabo>@ݛw bhi/Pm6I&1(_xȃ()0&_H9+tffؘ޿~qB]vh6+@|) "Wc}iopJJ x4l`<.!G7>}6[sAz/"'WgF2}a( 29xYޮQZ" I_Z[= ۽Q2d+bւ 6yP")[WRgf¬ QTi9@r '1($+ נ5V˹%(("{>`4M-֠*(*Vi4@-fyPc~qO?H 'IIENDB`tomboy-ng_0.34-1/kcontrols/resource_src/kprintpreview_icons/01_arrow-previous.png0000644000175000017500000000102714125207534030250 0ustar dbannondbannonPNG  IHDRw=tEXtSoftwareAdobe ImageReadyqe<IDATxJ@$7](-^֊bW…>k.*+^jQۤq&5bR;O2̙C_[pzr ;kdcsӺ43 #9*sB xx,6 ,p3ckH'9QTqGXjfμQ?P0'pE,Mgz7 ):H/$2|kBlx+ h ^~ŌFC D|&½yWU5{!ڏ^s]rX .ѥ L>P"?'۾x"HУEVn4jR:KwE19a=^DmjͶ>=5Z{QԖP,h+G#H&Ɛ?x ?W 0 PIENDB`tomboy-ng_0.34-1/kcontrols/resource_src/kprintpreview_icons/03_arrow-last.png0000644000175000017500000000104714125207534027343 0ustar dbannondbannonPNG  IHDRw=tEXtSoftwareAdobe ImageReadyqe<IDATxJ@i x"XAB5t#>(>p]"i "xk2[z;O ɜ;g2Ii aQb} pǺ19>-GJDc3q~e=+!:42ϳe{ t`0ay=-#=ZɅHg)1' Bq]MC;YGhՅGD(Bh~,+G 8\_<֑Pu B:`{nIZ$1yȦ3ӶHLxP@e{mOLuA~ȴ~g͒ +R9ΒOPc9iv0g'j+Q쫁zI[kNxv@9Tg-Rq#| rusH>dBxB Hp^dX vcycQ#"ɅŇz);l:IENDB`tomboy-ng_0.34-1/kcontrols/resource_src/kprintpreview_icons/05_close.png0000644000175000017500000000116214125207534026355 0ustar dbannondbannonPNG  IHDRw=tEXtSoftwareAdobe ImageReadyqe<IDATxUJQ=,N-\+66V6AA6,, ~ "hg'X˙$u,/ 9sfLJ~`{ٹ.y]YVa~T2];33`BtJLB/.LŢL)^^gؓ5 9O#PI89wSbyG st$~>_r2m'г@>_FXm oU9@*y>>9P{;C*y{s1?Ã'|']yX $iPW#imeZP3c[؞Ah&YN:1&,HMkn< '"|gzAɇɩJ\_KCtg]5a'(Hvupon`O7]cccS;}q390L(GGxaqÛ\69ĩ?).Z$  ~@,ke1111###33;; //07'Dx$D?Fr?@, Ӓ4 d(f[Suᩞ#س+ w3_00&W;w@2/]Rl ?2XpUku9Յ/2I2caxEl_qZ4AZAxSG?2XgJ3\t BiqfA6.].3 >܊..6q9q giGnK2j2H}c7õ ̪ l U Y3}A@lAGG.ׯ_gXh0802,r#,ɼ yD"E rr` ܁72utS  3+3۟ 'q&anGqe@s3?Pw@, X;w\>L:f? L| @00YP%g`^a &l()0ۻ >>Ǐ w>exÏ+}wNp`c j fYYy.`ze˰3&1a NW@̌ < ҂@=l( |􁀠ãO?rl < rl E~ w=fط yv&f~ ^` _ 2HJ - A LL@8XA/F1p| /+/_Eů_@| ܸܕ[  3|| _  VLX~o@_s/°͘ ,.`p#5yn]pOo-ĄZ P A؎@ԅk " J@}FO۶2D@X^> ߿f8xx+ؕ\X MM` Gwseprr` {۴ @#@REIENDB`tomboy-ng_0.34-1/kcontrols/resource_src/tkspeedbutton.png0000644000175000017500000000226514125207534023540 0ustar dbannondbannonPNG  IHDRw=gAMA7tEXtSoftwareAdobe ImageReadyqe<GIDATxU[hU\v'K6f6!ƒV> *"/SP- ⃈h$U$*1IlL&fvnL7 E<109~}W D BgEBpMƗCk 6[z<ؙ6X_?l@"!J(#$i2ngcs!цHE9i`* (Ip DUf_?Jd37B " 4-Ϛh(IK9[x*ԞԆ$B~>Ґ^%t(AkS /e!kZ&;fAďmufM^%xi^OafGɨTBץ.߹Q绱i0b~Zx|-1AHp9CQUNl"`:QMnSCds̿? ֛C\}Hklz ,qd]$X184 ᐈqHrzσ9Z,ead s(4f.!QplM َbX!SsR`;|x^2:)>HpD+)f` X$Q?,F%"ù=3܁f0EpNcӲ8ԏC^3?9: aF=¸3sg\9 V0mRVK2@zdSMJOW_̻GwfE5CYpJV{ ʰ` +.0 Xꝁ~5|,;2&BN1QX\ۍ+CE.cO[hؽhJrNtK'?-ŭW}-^)Ѹr}7'{ L9PΤ̹n".ŵ]$#S^"V*_ gX;\dm꜁lA}^v1u s3a{bfCke?+~L#WQkhw= ,斒㕃mVEK ,`ffa02pq1[_c b ff48 $,bo cfB{IIQaa.9'4nK3j-%õ * l "5* y!d@d>&4C#cY9yyWN00rBbc8A(,O"P}@vԪ~P ,X sNN߾1s2|tOws00 $( Z3(i)mt܄@aZlp0|AZT獏 >cdc``ibu0Dxi|?3@a(a :** I~2Ǖ T%Ġ,àT @ "F&g/_3|_L ~հ3&2a NWiA EAIQXk$3 w|`Wæ*>ӇA"Zaߟ3 c~O$BL ~w_1 Q3d82y_DA@؃cf>[`ꑿ |*f/Vn}} _DBN0 0<70>| % ów_}W:9q)qi3?wGš@<ׯd9>pC&3i ~ OcõEم9P…ۯ} ,>``x%îC'Tn.NF#̂vV < =f8}:%$ L8i0Ղ+  0rKJSϥk>|lk`o@U&.߼ws 1Zy5,HxLO^epYE.߶eS'OO@b\ (4[pMf1ekIENDB`tomboy-ng_0.34-1/kcontrols/resource_src/tknumberedit.bmp0000644000175000017500000000337014125207534023332 0ustar dbannondbannonBM6(  𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠tomboy-ng_0.34-1/kcontrols/resource_src/tkmemoframe.png0000644000175000017500000000241714125207534023153 0ustar dbannondbannonPNG  IHDRw=gAMA7tEXtSoftwareAdobe ImageReadyqe<IDATxڴV[hUv'{fݤMjH,T`VXAb (ࣈd_,y>+}*Xo1$[澛93;؛ 1{n9ǻ #4oFn{S|>B;a4V 8~/NAmt$\e2cPiH95t! ֟ڢa޿Ey%PQ`mZj'kò9!EBTg29Pke)Fsfh7+X.ˮ _dx^"x׹J"!TLA:.#bWy5.U920ժ%׆ 0)7& l\dɕmLST zNᡉzv Z#ZZ~!ׅNbiq DT2lQ~e'H%4֫rgt_Ho| "( Upj{{@>ܬ{6ע@ iktGTgS` d"{Shx?cyk33>:c"voh34q$͙Xq<c` I))V:TN ]Tf)J%#Dz伭-=O±}v p͞Fj=u(2G;&E"b{y/qVQЋo¶ҸEJΝFO:ѤjM\pXT}{ 9h@Fh|%sEL\GedPu ;V0͛Q)N!4QuEHIKLJ2$:aԞ6ԧWpZCOI+,_% xn N|ԃ}/RW x#qP<٘?~s+ظ@CH&9=xx{?*2TGǮkF+wuVp;)+9g~a6ô+yIw%1.I Ŝ;"07?XhTiJa BvާMF>lv6 ^)QEsss} uhE+Yf~{Gk`pzƼ)Mڼ11WG *Mj  5Z@RivK]>(T@.{Φj *IoSu5IENDB`tomboy-ng_0.34-1/kcontrols/resource_src/tkmemo.bmp0000644000175000017500000000337014125207534022131 0ustar dbannondbannonBM6(  tomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/0000755000175000017500000000000014125207534022435 5ustar dbannondbannontomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/04_format_paragraph.ico0000644000175000017500000000217614125207534026757 0ustar dbannondbannonh(  I⋐ ?xzN奫D?tomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/00_document-new.ico0000644000175000017500000000217614125207534026043 0ustar dbannondbannonh(  9::::::59~ :~: ::5:::::::ߕ## f:ݕ6f:!!4d2: :!!)?)Z3:Ϗ66xxxz55g:::::::::u))[[**h?tomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/23_format-text-italic.ico0000644000175000017500000000217614125207534027160 0ustar dbannondbannonh(  [[[-[[[[[[[[[[[[O[[[ͼuuu[[[[[[}}}[[[[[[[[[[[[[[[)[[[ooo[[[.[[[J}}}[[[{[[[ ]]][[[[[[mmm[[[ ```O[[[rnnn[[[yyyddd[[[iii[[[[[[d{{{aaa[[[X\\\[[[^^^[[[ppp[[[f???????tomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/33_insert-container.ico0000644000175000017500000000217614125207534026730 0ustar dbannondbannonh(  @~@~@~@~@~@~@~@~@~@~@~@~@~@~*BYq@~@~KL LLVm@~@~5Md|@~@~FLHLLLLL,D\s@~@~ #;S@~@~?LELFLKLLLLL2@~@~@~@~=L>L?LBLDLELJL@~@~@~@~@~@~@~@~@~@~@~@~@~@~@~@~@~@~tomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/24_format-text-strikethrough.ico0000644000175000017500000000217614125207534030616 0ustar dbannondbannonh(  [[[[[[u[[[[[[[[[[[[[[[[[[[[["[[[]]]єbbb[[[^[[[___rrr[[[[[[qqqaaa[[[$[[[___[[[[[[?[[[Vmmm[[[[[[___[[[[[[[[[[[[[[[[[[7[[[alll[[[[[[[[[m[[[qqq[[[OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOccccccwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww[[[5qqq2ccc[[[]]]F]qqq[[[𠠠${{{]]]___tttrrrWώ񫫫ܗ8tomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/03_document-preview.ico0000644000175000017500000000217614125207534026736 0ustar dbannondbannonh(  899:::958~ \\\Ȍư:L-޼ڠ֙v:|{{֐R7ΠoΙݙޖלĎk:@??b>ӫЛקڹiG:9N1aB>4[A99KKJ]ȋ؍ =::::9=tomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/28_insert-link.ico0000644000175000017500000000217614125207534025707 0ustar dbannondbannonh(  j4ke0e1_3XMGhdbmkimkj`=a9okhmkigdbPKI???0i3hfdqqqxxxMMMq8PplgpWECBFFFQQQQQQFFFECBgggx>> ƄGƀBƈIƂEƈJڽػƃFƉKֻԵҳĂFƉKټ~EƉLֺⶄyBňKָش}ےdk>ąI}۔eh;}D`ȋMȌOȌOȌOȌOȍOɌONjOʼnKv;h<tomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/26_format_font.ico0000644000175000017500000000217614125207534025764 0ustar dbannondbannonh(  h8ڏ]ې`׃PP+B#?"*M+qB~Q|MU191\/ _0DuڌXR,=E$H'ܖkۏ`?!T8]0t?|f7c7ߠwډZ>""c2ۓ^y؃Jj:h9zE㨁نVA#j6\ߝhڋR_1NY.*g7z؆SF% j5׀Bߟjf4f]/ a3yzDJ'q8"ޛcܖ^i5Ti5|l:y_0׃>Sl鼑纏緋q~B\/ ؇@@؋CڎIىC؄@؄As:b2 [.tomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/15_edit-undo.ico0000644000175000017500000000217614125207534025334 0ustar dbannondbannonh(  ǿTƳ+Ʃ ŕ9 GAK/ǩ%#RL82 ƮHDcPYIk3en dio.ZUƑƎ$~00LbZ@/V<ǾWe3IEAOi"hǢ1y?aƂXayF0?tomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/25_format-text-underline.ico0000644000175000017500000000217614125207534027702 0ustar dbannondbannonh(  OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOccccccwwwwwwwwwnnnbbb^^^\\\```eeekkk]]][[[dddwww[[[uuu```[[[[[[Qttt[[[[[[www[[[^^^[[[[[[[[[q[[[[[[ [[[[[[[[[```[[[[[[=ttt[[[[[[[[[[[[hhh[[[[[[```fff[[[[[[ooovvv[[[[[[}}}eee```nnnfffvvvjjj{{{lll}}}}}}Ãtomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/20_format-justify-left.ico0000644000175000017500000000217614125207534027353 0ustar dbannondbannonh(  OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOccccccwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwOOOOOOOOOOOOOOOOOOOOOOOOOOOccccccwwwwwwwwwwwwwwwwwwwwwwwwwwwOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOccccccwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwtomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/22_format-text-bold.ico0000644000175000017500000000217614125207534026632 0ustar dbannondbannonh(  [[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[bbbrrr[[[[[[[[[[[[[[[#[[[sxxx[[[[[[[[[[[[___[[[[[[]]][[[hhh[[[[[[jjjjjj0hhh[[[ccc]]][[[mmmkkkaaa=wwwiiiWqqq wwwW|||ssstttttt߫Rtomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/30_format-text-subscript.ico0000644000175000017500000000217614125207534027727 0ustar dbannondbannonh(  jjoz!kjj sYVǡҳbsEEEEEEEEEEEEEEEEEEEEE(EEEerR=,{${$;{$EEEFFFㆆMMM^^^mF2IIIQS@@-PPPjjjPPPPPPVVViٿXTgOYYYXXXVVVVVV&^^^ސ]ؾ]]]]```]]]]]]i]]]ohdkkkkk dddpllldddjjjjjjv~~~rrrjjjqqq&qqqfqqqqqqwwwxxxqqqxxxxxxxxxxxxxxxxxx){{{~~~xxx~~~~~~~~~~~~ ̧⌌[ؒ钒ϒN ?tomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/12_edit-find-and-replace.ico0000644000175000017500000000217614125207534027455 0ustar dbannondbannonh(  64.:8297186075/64.64.64.:8297186075/64.64.:82figSVT860:82figSVT860:93mpo750:93mpo750<94becNPM760<94becNPM76066/QVURfjhSVU66163-P66/QVURfjhSVU66163-P;;1}75/64.64.64.64.64.860;93y64.64.64.64.64.64.75/}850komQRN75/)>W\\\\\\\64.lpnSWU64.`b^UWS)>Vjk>>\64.lpnSWU64.qvt64.gE>\971mqoSWU64.qvt563=}s9k\:83nI~ZO}|}SWU64.[\XLSX Rx8og\m_J[^_\,;MW!: k!TLkh\U dqZ564,>=<oH>==u!7q~?>>AǑˆ@?>pȒȒˆ@??TąɒÉA@@|#3Kppppp@OOOOOOOOOOOtomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/08_edit-copy.ico0000644000175000017500000000217614125207534025343 0ustar dbannondbannonh(  sBuEuEuEuEuEuEuFtDSyIʀTςS΁ṼR̃UyJyKuEuEuEuEʄR˅U|N云̆VςS仑ټ̇W̃R仒׻ѯ̇XʄR仒ټʃS˅S仓Ӵ}HˆT徖껈υUi= ˆUÝ濖仒仒ѠlОm̖_yB~g< ˆUټ͕eˆVӴ}HʅT껈υUi= yĞÜWˈV̈VˇWʃPyBng<??tomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/16_format-indent-less.ico0000644000175000017500000000217614125207534027160 0ustar dbannondbannonh(  `.``nntvnVVVVVVVVVVVVVVV}}!}ccccccR   ppppppppppppppp-'@%<%8#4P?Jhv_oVf$*uzTTTTTTTTTTTTTTTTTTTTTt gpcccccc.qqqrrrrrrrrrrrrrrrqqqRRRRRRRRRRRRRRRRRRRRRRRRRRRcccccctttttttttttttttttttttttttttx|tomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/21_format-justify-right.ico0000644000175000017500000000217614125207534027537 0ustar dbannondbannonh(  OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOccccccwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwOOOOOOOOOOOOOOOOOOOOOOOOOOOccccccwwwwwwwwwwwwwwwwwwwwwwwwwwwOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOccccccwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwtomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/06_document-save-as.ico0000644000175000017500000000217614125207534026617 0ustar dbannondbannonh(  YN6ZO7ZP8ZO8ZO8ZO7ZO7ZO7ZO7ZO7ZO7YN6YN6YN6YN6YN6 YN68^T<}t`xe~l|i{h}jltqruvcYBYN6?YN69e[D𴯡¹ŻpgRYN6>YN6:g]F¹ĺqhSYN6>YN6:h^HtPy\ŻȾsriTYN6=YN6;j`JﾺsQf۸wzyc~u_sjUYN6_T=u?jԆtR_T=_T=^T<^S<^S<]S;\Q9YN6YN6s>ۯ_۷toOYN6k[9lo_=oo`Aoi\@`tomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/19_format-justify-fill.ico0000644000175000017500000000217614125207534027357 0ustar dbannondbannonh(  OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOccccccwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOccccccwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOccccccwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwtomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/14_edit-select-all.ico0000644000175000017500000000217614125207534026413 0ustar dbannondbannonh(  I⋐㊏K剎ĭĭĭì}}ªªë}}ԿӾԿԿԿԿԿԿԿԿ}}}}}}}ïԿӾҾҽҽѼм}}}}}~«ԿӾĬ}}}}?ŮĬëª˹xzN奫Dtomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/05_document-save.ico0000644000175000017500000000217614125207534026215 0ustar dbannondbannonh(  YN6ZO7[P8[P8[P8[P8ZO8ZP8ZO7ZO7ZO7YN7YO7YN6YN6YN6 YN68`U>mquvx{~g]GYN6?YN69i_Ixo[YN6>YN6:kaKż¾yp]YN6>YN6:mcNǾxo\YN6=YN6;ofQƽ½xo[YN6zq]zd~julXYN69YN6?kaKg]GYN68YN6#^T=`V?`U>`U>`U>_U=_U=_T=_T=^T<^S<^S<]S;\Q9YN6tomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/10_edit-paste.ico0000644000175000017500000000217614125207534025476 0ustar dbannondbannonh(  sBuEuEuEuEuEuEuFtDS cJ c c c c cɏgʀT ct{xutک}΁V cSPNM֩}̃U cVSPP֩}˅U cYVSS׬̆V c\YWV׬ټ̇W c_]ZYح׻ѯ̇X ce`]\ٯټʃS ckf`_ٯӴˈW coh`_׭껈ΉYi= ctplkٯ׮׬׬̠p͟qgˈVֲg< cyDDCBBAS c cNuuK c c2 c c7u.n c c cS c* c c c c c ctomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/11_edit-find.ico0000644000175000017500000000217614125207534025303 0ustar dbannondbannonh(  64.:8297186075/64.64.64.:8297186075/64.64.:82figSVT860:82figSVT860:93mpo750:93mpo750<94becNPM760<94becNPM76066/QVURfjhSVU66163-P66/QVURfjhSVU66163-P;;1}75/64.64.64.64.64.860;93y64.64.64.64.64.64.75/}850komQRN75/750uvrkomdgf64/64.lpnSWU64.`b^UWS64.kpmSWUkom64.64.lpnSWU64.qvt64.kpmSWUpsr64.971mqoSWU64.qvt64.wzxqsq75/:83n860?=6|}SWU64.[\XRSO64.:8275/851n72.8POK^_\64.75/{|xLKF55,:;8375/64.64.750t:83n86064.64.98164.|UYW64.64.|UYW64.<:464.64.860<:464.64.860tomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/32_insert-image.ico0000644000175000017500000000217614125207534026027 0ustar dbannondbannonh(  tSrOêmEkCkCkCkCkCkCkCkCkCpJtSmHpJd:kCd9bBXXXXXXXXbBkCf:XuuuuuuuuXmEf:XuuuuuuuuXmEf<Vުsުsݩsݨsܧrܧrܧrܧr}UmEf2,#  (#+B1<52s!)U:- & ~3!&87#fwl--;.ͻ .'6=%t *(-&&4Q8Ԋ &$E604"(Kp{F xDazE3h^wȫϵӹ׿uͯѷ*^{G wB wB wBX|H{GyEzExʭOzFyDb{G xDa xCzF wBF xC wB0tomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/01_document-open.ico0000644000175000017500000000217614125207534026214 0ustar dbannondbannonh(  <>>?????????><TTTTTTTTTTTTTTTTڌKŠᷕŠŠŠŠŠŠŠŠŠŠᷕŠڌKՅC춋ȕnֿֿֿֿֿֿֿֿֿֿȕn춋ՅC~:xU̱¡¡¡¡¡¡¡¡̱Ux~:w1r|Hǩ뼘뼘뼘뼘뼘뼘뼘뼘ǩ|Hrw1q)yĐhӼ˯˯˯˯˯˯˯˯ӼĐhyq)l#l#d!k#k#k#k#k#k#k#k#k#k#d!l#l#ۇAƦ~~ƦۇAۇAƥ~~ƦۇAۇBŤ~~ƦۇAۈBʭ˯ۇAۈBf1ۇAۇAۈBۇAf1>>>>>>?????>>tomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/02_document-print.ico0000644000175000017500000000217614125207534026410 0ustar dbannondbannonh(  '('+΅̄˄˄˄˄˄˅̄"VVVWWWx\\\m```hXYYzBCBBCBCCCCCCVVV|qqqAAAlklnlnnlnnmnomoonoonoomoCBCqqqtss212JHKJHKHFIEDFDBEAAC@?A;:='&(uttqqqVUVzz}srukjmcbeYY\QQSFFI../ttt}||hiiQPQԑnnnnnn?𢡡񛚚CppphhhbbbqppbbbqppeeetttYYY]јɘəəəəɣcccbtomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/18_format-justify-center.ico0000644000175000017500000000217614125207534027710 0ustar dbannondbannonh(  OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOccccccwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwOOOOOOOOOOOOOOOOOOOOOOOOOOOccccccwwwwwwwwwwwwwwwwwwwwwwwwwwwOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOccccccwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwtomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/09_edit-cut.ico0000644000175000017500000000217614125207534025165 0ustar dbannondbannonh(  J1 a1׶v?e4K2 gEjH ^/cOݫbb2wSVǗQئZl6Q5 h5ѠWA* j6u?M3 D֤Z讂Afn6جl7ĕQvV'vx@R8J~An2fʢtg^-Mӯp;I0 j2֥^pM>nKO`ܽͥgئ]fIdfC~Bܪ`ОTeغWW9 AfDi2~BҞh,g_ŁS^= YʹaTϳv7lPf cγf ;L{e$\ӹӸ^GtȮd`'Ѷ仗g~Cnռag"-L{>iˮ] `j%*{>aOo??Ogs{tomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/29_format-list-unordered.ico0000644000175000017500000000217614125207534027677 0ustar dbannondbannonh(  fgfffOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOz"qz"ccccccZfZZgwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwfdffdOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOz"qz"ccccccZgZZfwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwfgffdOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOz"qz"ccccccZiZZfwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwtomboy-ng_0.34-1/kcontrols/resource_src/kmemo_icons/17_format-indent-more.ico0000644000175000017500000000217614125207534027155 0ustar dbannondbannonh(  ???.KyCPKtKW_ ap1WWVVVVVVVVVVVVVVV$b_d yZ#f $bPcccccc*n%(x$u yg*n%ppppppppppppppp/z-iͨ_ȢVÜ:m/|1/z-R45yҰ@[454568ѯ;F68t68TTTTTTTTTTTTTTTTTTTTT686868.ccccccrrrrrrrrrrrrrrrrrrrrrRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRccccccttttttttttttttttttttttttttttttttt??tomboy-ng_0.34-1/kcontrols/resource_src/tkmemoframe.bmp0000644000175000017500000000337014125207534023144 0ustar dbannondbannonBM6(  tomboy-ng_0.34-1/kcontrols/resource_src/tkhexeditor.bmp0000644000175000017500000000062614125207534023170 0ustar dbannondbannonBMv(   @B~ETETDETEDC4CD3D4CDC4CD333DEC4CDDD3DEC4CD3D4CDDD34DC4CDC33333335C#"&b#""53336f336e"#"&f#"ff3336f36fe"#"&f#ff53336fffc5"#"&fff"53336ffc35"#"&f&f"53333f3fc5"#""&#&f53333333fe`tomboy-ng_0.34-1/kcontrols/resource_src/tkspeedbutton.bmp0000644000175000017500000000337014125207534023530 0ustar dbannondbannonBM6(  𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠tomboy-ng_0.34-1/kcontrols/resource_src/kmessagebox_laz.txt0000644000175000017500000000013514125207534024050 0ustar dbannondbannonkmessagebox_info.png kmessagebox_question.png kmessagebox_stop.png kmessagebox_warning.pngtomboy-ng_0.34-1/kcontrols/resource_src/tksplitter.bmp0000644000175000017500000000337014125207534023042 0ustar dbannondbannonBM6(  𠠠𠠠𠠠𠠠𠠠𠠠𠠠tomboy-ng_0.34-1/kcontrols/resource_src/kgriddemo_rsrc.rc0000644000175000017500000000005014125207534023451 0ustar dbannondbannon_cube RCDATA "./kgrid_icons/_cube.bmp" tomboy-ng_0.34-1/kcontrols/resource_src/tkbrowsefolderdialog.png0000644000175000017500000000227514125207534025062 0ustar dbannondbannonPNG  IHDRw= pHYs  gAMA|Q cHRMz%u0`:o_F3IDATxڴ]U733nnJHg V{P7ID$E tEdek[f:?37wNjKsu8/}y7zH-SNS Mh]װm LH$D H9Mr/DQ0ϾɅMtkB@?pi&Z.s }C\4F w.2F,'yraco_~vITWk b]e #:Q/42k%;:4 CnEo!=%뻺H"rN9Ķմ5(e{U6Mou0n13S!Nlok;ϺЋ(//{hkH>$08x. 0n,fRбmX,BU>EӪ'nj% y.\H#"jQpde#{'f{`LUF~It@+ژmhе#{YG.p _u]8p4iLư,/ =*x:jEu`5_,[殗ejҟ.]BGG#ECԪ-P#,TR2 غc]U2Cr[CmvI@e(H0V*W5HE^ٿa̓$FSaۨ-0-ZhqV8ķIB믠G7L(_ra!OFteZ]JAU@7fIqS ճ<4Mcnn'ӣR|d*ϡdd c:K iB0?_ rE@9.),T5C (U_">Ţl)/PR&HR.(t(CJ @S.W WKm[avnS$7JVz\,wcN!RԝH?VXBIENDB`tomboy-ng_0.34-1/kcontrols/resource_src/tkdbgrid.png0000644000175000017500000000252614125207534022437 0ustar dbannondbannonPNG  IHDRw=gAMA|Q cHRMz%u0`:oIDATxb?-@ sV~{X*1H23_v5^1Fb :r< W}ax'ë~Űs.v&W/c1~^O8ujzB `C`? V:" l fP6ds<d$1i- &$p;G ~ T۷ "<o`x^|`NNя ̂l s-xY> xX2mG^.fy1v?+IG)a kG UUyQ {A\@,P' O003cafXt G X_NmaP,-,"Da?`P3ׯ e`¿o2{aL ܎ 5:XS@L[DKo1B +7C\獏 Nedc``z?ï۟81, ATQ1dbPb_pM?aýO2]ax?._ n|.D _Ҧ agM`xuþŇ20ȁ$d~ar=CFD@ ŰoICCYl < r$[p}}Kπ-fDf~f.Fv~kNkdeԌQ–_H0dn`92ó>|$Aؚ$/EycáC;p>&F0*ǰjUß?佸?agS֯ ~6@1"e)9^ΐѺAUO f@_b{$ Y"V<` ߿vð-1xx812DF19l˗~:bA\~0=v7n܅U~f^ @>x4æMfΜO>z5w\?}D 0wU0}EgVH>72ӧ01CD݅.]§ W,(j x{31N @CY Z@ `MIENDB`tomboy-ng_0.34-1/kcontrols/resource_src/kedits_laz.txt0000644000175000017500000000001314125207534023016 0ustar dbannondbannonopendir.bmptomboy-ng_0.34-1/kcontrols/resource_src/kmessagebox_warning.png0000644000175000017500000001031014125207534024670 0ustar dbannondbannonPNG  IHDR00WgAMA|Q cHRMz%u0`:oSIDATxb?P8=@L }b`gɌ~ 1fdz&T@ ~S@F?{v՟o_7K,=@`_z? O \bgDM SSy c` %]TQȬ(F-@~a/Oz=__3}cP`$&p_@$oN=8y3|P :: CwyӬ ΰ2dt| `$ $"1O/rI`A#O?@G3=*q3؏_2ĸe 0] o1{MK,}&\om'&~CQ^zq0#23i~eP1,uK`y 2|l2ë4/ A@ ZPX21.Ŭ3HXaѭMeOD4sL<g`8 ,lA!f9i_A ≮uoBr3|g0pAVK-;2)~Ơwzh?#},, Gq2ܸ &]O*RB]^jb&-Mԋ=-} &ïp: |bțpo?0qd 03v8$s`|ph+'oL oT,n|UkR@c~ñ8ya)`TC&_f`dͰ8;++#-Xc%!a3\>p hGO SX#j1c l3Q_^9`XKÿ3T13reȞͰn?'Tb`p4ɰXW|dF @~bbس;&=`b$i C\*@8* f`vWʷ=dxAA+- zqobz|,.;9r0!;7J9k 'r{u=^34ճ7jb2 пߘ߫} f0ixĠWb)_0g8Fa'xPg4$nm`x|AE+w.̂@1||I `A+_C=$39cAUW!jBP,||İk#fd06Ġk>#GH,@- `aV.;ssJ?RAiFhFeb)]>0ىqɏv 6! NftVYȭUbo|z=])_~.24d#'oO`K22 , π5UFFHp`k`W.,7&>{ It^ ~p `Ի`h/&F7#j3\֟gdh  %Q_~3|~ edbafWXNeWtN$3s8LLF3@1QSc8wg aAjO,?_  0, ?2H1| FF$>X|evl l cEgsO}hrp}OcսćV!s2* 3Ev&nᯰ P=x)pHBeuR'w"gv=<W= Vp?޿Lj16g.'o^` XB ̿D'P"9)E`ͨAlK.b q'1viB1ђkp~0r>aɰ-כQDBLf y5:Bsp6ϚUdD8ek]]}|K?L{_a^2H.4ƃmUTw4e-TR&rK r_o0UFƀYiUx"*(*3J.F˿iVm=ŀ5@R6G@`,6uQ̅ gЁ/8ZKs *hs¥@<'AӃd S/20'`xs&V4?Z6c ksk۷~ONѫH ^ｌ5g`XgZ/eޢ6[BΊ"ik~qUDEEN\5wjMC!4m UU ©jjgpƶv]]466mGUUSdnrn& G ǪrRwr%nnwDڒIiUUefJ Ym,;>AąIENDB`tomboy-ng_0.34-1/kcontrols/resource_src/kmessagebox_info.png0000644000175000017500000000612714125207534024171 0ustar dbannondbannonPNG  IHDR00W IDATh[ly%\DDi1+P_Dhbh)]wNF. 0\ڢڢ@U\E ؕqױԶd)%4uD=fŜgɥ;;Ýy{fvO9&h1>!A ".:WִkyQo2~/ y"ɜR`J)=8jWS*ikZRA]?87Oڿ(OL`ęgضeQ:6Khim,,LmJUV%JmUyk&]c X^byvutY5xv%Г d hmWW(ەߜѳѿ' gp[M7bQKb %-HQgeufm埋8u 836?pxoƍ{-l'(zN<&Zh:r2,=he6׮6ԆDcNzNZ{R]=n"Lm1v}1ӷ'vVZ(Pأ9{(WFS|ws<\ߠRs4ßfK/\~m//:FG߻^e+xI'w_-ɐo}TADˏhfel M׮߿VbHJZڿg[&UKQ?zpN /px%L,*xHM1 #0$Bdę?߷{ɽcw=]m@EL7hٚt~ !cR* A}#4:3&b@õ7&pr +!`M}YANhL~Ю'*B'<51>+o~ 1{XWDJ+]lR6>cX؞/׀|1٠x}tjH(ꓬq$}] 誵 43d S@`:4qIdnF* Ca} F2pMm7/jMFTi{F!]`a`Tמ77mśAfqr~r[S;B@27ݭFkhLK;x_.*z,$"a( 3S>~EԤ^vޕ p=W]0~W]Mr{230Lced,\e),K0-8hh8*mkoז9Ϝ[Y|~_t3ŋHo'e ۧޑI1~#Wا +ZUYuvŮݟioN/]:NkxYD,LYe̠H8x^fo୪?`(U?_#=IENDB`tomboy-ng_0.34-1/kcontrols/resource_src/kdesign.bat0000644000175000017500000000035314125207534022247 0ustar dbannondbannon"brc32.exe" -r -fo..\packages\kcontrols\kcontrolsdesign.dcr .\kcontrolsdesign.rc "brc32.exe" -r -fo..\packages\kgrid\kgriddesign.dcr .\kgriddesign.rc "brc32.exe" -r -fo..\packages\khexeditor\khexeditordesign.dcr .\khexeditordesign.rctomboy-ng_0.34-1/kcontrols/resource_src/kpreview_cursor_hand_free.cur0000644000175000017500000000050614125207534026072 0ustar dbannondbannon 0( @?wg tomboy-ng_0.34-1/kcontrols/README.md0000644000175000017500000000750014125207534016715 0ustar dbannondbannon# KControls component suite for Delphi and Lazarus Original authorship: Tomas Krysl ## REPOSITORY LOCATION: The repository was originally located at https://bitbucket.org/tomkrysl/kcontrols. Since January 2020 it is on Github, moved from Bitbucket because Atlassian discontinued Mercurial VCS in 2020. The original repository should be deleted on 1th June 2020. More info at https://bitbucket.org/blog/sunsetting-mercurial-support-in-bitbucket. Bitbucket continues with GIT support but IMO GitHub is better for GIT. ## LICENSE: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. ## SYSTEM REQUIREMENTS: - platforms: Win32, Win64, GTK, GTK2, QT, Carbon, Cocoa, WinCE(partially tested) - IDEs: - Delphi 7 and higher (tested on Delphi 7, DelphiXE+) - Lazarus 1.2.2 and higher - maybe will work with older Delphi with minor changes - some more problems might be experienced for older Lazarus versions - see other readme files for additional informations about individual components ## INSTALLATION: 1. Compile and install package. It might be needed to specify search path to Source directory in Delphi/RAD Studio. For Rad Studio XE2 and later add VCL and VCL.Imaging namespaces to Unit Scope Names. 2. When compiling an application or demo, it might be needed to specify the search path to KControls sources or JCL sources (if JCL is configured via kcontrols.inc). ## BUG REPORTING: In case you find a bug or have ideas to improve please create an issue or pull request here: https://github.com/kryslt/KControls/issues ## IMPORTANT INFO FOR CONTRIBUTORS: You may contribute to this project, in such case: 1. clone or fork the repository on https://github.com/kryslt/KControls/ 2. implement and test your changes, if possible in all these IDEs: - Delphi 7 and latest Delphi version under Windows 7 or higher - Lazarus on Windows 7 or higher - Lazarus on some version of Linux, preferrably Ubuntu or Kubuntu. - Lazarus on MAC 3. create a pull request on https://github.com/kryslt/KControls/ or include a patch into the issue. Please KEEP IN MIND THE DIFFERENCES between Delphi and Lazarus (mainly string encoding UTF16 in Delphi vs. UTF8 in Lazarus). When working with texts, always test with different Unicode characters. Testing of bidirectional text or aligning features is not required, because right to left mode is not supported by KControls. DON'T REMOVE ANY PROTECTED OR PUBLIC STUFF, the package is already heavily used by me and others! This main repository must stay compilable in both IDEs! I will not merge any changes that violate these rules! If you need specific features please use your clone or fork. If you plan to regularly contribute to this project and have enough experiences with this kind of programming, you can be granted write access to the repository. ## VERSION HISTORY: Version 1.7 (August 2015): - Added: - TKMemo major improvements - TKPageControl, TKSpeedButton, TKSplitter components - packages up to Delphi XE8 Version 1.6 (July 2014): - Added: - TKDBGrid improvements - packages for Delphi XE6 Version 1.5 (July 2014): - Added: - new components TKBitBtn, TKColorButton, TKMemo (early alpha state!) - TKGrid improvements Version 1.4 (February 2014): - Added: - new components TKNumberEdit, TKFileNameEdit, TKLog, TKBrowseFolderDialog, TKLinkLabel, TKGradientLabel, TKPercentProgressBar - packages up to Delphi XE5 Version 1.3 (April 2012): - Added: - packages for Delphi XE2 - Modified: - no separate install packages KGrid, KHexEditor, KIcon Version 1.2 (Oktober 2010): - Update - based on KGrid 1.7, KHexEditor 1.5, KIcon 2.2 Version 1.1 (Oktober 2010): - Update - based on KGrid 1.6, KHexEditor 1.4, KIcon 2.1 Version 1.0 (October 2009): - Initial release - based on KGrid 1.5, KHexEditor 1.4, KIcon 1.8 tomboy-ng_0.34-1/kcontrols/.gitignore0000644000175000017500000000162614125207534017431 0ustar dbannondbannonlib/ Debug/ Release/ source/__history/ source/backup/ source/contrib/ packages/kcontrols/*.cpp packages/kcontrols/*.hpp packages/kcontrols/*.res packages/kcontrols/kcontrolsbase.pas packages/kcontrols/kcontrolslaz.pas packages/kcontrols_copies/ demos/**/*.ico demos/**/*.rtf demos/**/*.ini demos/**/*.rc demos/**/*.ico demos/**/*.png demos/**/*.jpg demos/**/*.bmp demos/kdbgrid/kdbgriddemo*.res demos/kgrid/kgriddemo*.res demos/khexeditor/hexeditor*.res demos/khexeditor/*.hex demos/kicon/demo*.res demos/kmemo/kmemodemo*.res demos/kmemoeditor/kmemoeditor*.res help/**/*.css help/**/*.chm help/**/*.chw help/**/*.gif help/**/*.hhc help/**/*.hhk help/**/*.hhp help/**/*.htm help/**/*.log resource_src/*.jpg tools/**/*.ico *.~* *.*~ *.aps *.cfg *.compiled *.db *.dsk *.dcu *.ddp *.dll *.docx *.dof *.dylib *.drc *.identcache *.ipch *.local *.lrs *.lps *.map *.o *.obj *.or *.pdf *.ppu *.psd *.so *.suo *.stat *.zip tomboy-ng_0.34-1/glyphs/0000755000175000017500000000000014145033543014723 5ustar dbannondbannontomboy-ng_0.34-1/glyphs/install-local.bash0000644000175000017500000000367614145033507020334 0ustar dbannondbannon#!/usr/bin/bash # A quick and dirty script playing with where icons go. # Definitly not for production use. APPNAME=tomboy-ng DEST="$HOME"/.icons/hicolor function WriteDesktop () { # we need write a new one cos need to mention user's user name. DT_FILE="$HOME"/.local/share/applications/"$APPNAME".desktop echo "--- DT_FILE is $DT_FILE" echo "[Desktop Entry]" > "$DT_FILE" echo "Name=tomboy-ng" >> "$DT_FILE" echo "Name[de]=tomboy-ng" >> "$DT_FILE" echo "Name[es]=tomboy-ng" >> "$DT_FILE" echo "Name[fr]=tomboy-ng" >> "$DT_FILE" echo "Comment=Cross Platform Notes" >> "$DT_FILE" echo "Comment[de]=Notizen Plattformübergreifend" >> "$DT_FILE" echo "Comment[es]=Notas Multiplatforma" >> "$DT_FILE" echo "Comment[fr]=Notes Multiplateforme" >> "$DT_FILE" echo "GenericName=Note Taker" >> "$DT_FILE" echo "GenericName[de]=Notizanwendung" >> "$DT_FILE" echo "GenericName[es]=Tomador de apuntes" >> "$DT_FILE" echo "GenericName[fr]=Application de prise de notes" >> "$DT_FILE" echo "Exec=$HOME/bin/tomboy-ng %f" >> "$DT_FILE" echo "Icon=$DEST/256x256/apps/tomboy-ng.png" >> "$DT_FILE" echo "Terminal=false" >> "$DT_FILE" echo "Type=Application" >> "$DT_FILE" echo "Categories=GNOME;Utility" >> "$DT_FILE" } function InstallStuff () { if [ "$1" = "remove" ]; then echo "Remove Mode" else echo "Install Mode" fi if [ "$1" = "remove" ]; then rm /home/"$USER"/.local/share/applications/"$APPNAME".desktop rm "$HOME"/bin/"$APPNAME" else WriteDesktop # cp "$APPNAME".desktop "$HOME"/.local/share/applications/"$APPNAME".desktop mkdir -p "$HOME"/bin cp "$APPNAME" "$HOME"/bin/"$APPNAME" fi # --------- Icons ----------- mkdir -p "$DEST" for i in 16x16 22x22 24x24 32x32 48x48 256x256 ; do if [ "$1" = "remove" ]; then rm "$DEST/$i/apps/$APPNAME.png" else mkdir -p "$DEST"/"$i"/apps cp "$i.png" "$DEST/$i/apps/$APPNAME.png" fi # echo "$DEST/$i/apps/$APPNAME.png" done; gtk-update-icon-cache -t "$DEST" } InstallStuff "$1" tomboy-ng_0.34-1/glyphs/install.sh0000644000175000017500000000063314145033507016727 0ustar dbannondbannon#!/usr/bin/bash # A quick and dirty script playing with where icons go. # Definitly not for production use. APPNAME=tomboy-ng DEST=/usr/share/icons/hicolor for i in 16x16 22x22 24x24 32x32 48x48 256x256 ; do # for i in 256x256 ; do # mkdir -p "$DEST"/"$i"/apps/"$APPNAME" cp "$i.png" "$DEST/$i/apps/$APPNAME.png" echo "$DEST/$i/apps/$APPNAME.png" done; gtk-update-icon-cache -v /usr/share/icons/hicolor tomboy-ng_0.34-1/glyphs/uninstall.sh0000644000175000017500000000046414145033507017274 0ustar dbannondbannon#!/usr/bin/bash # A quick and dirty script playing with where icons go. # Definitly not for production use. APPNAME=tomboy-ng DEST=/usr/share/icons/hicolor for i in 16x16 22x22 24x24 32x32 48x48 256x256 ; do # for i in 256x256 ; do rm "$DEST/$i/apps/$APPNAME.png" # rm -Rf "$DEST/$i/apps/$APPNAME" done; tomboy-ng_0.34-1/glyphs/tomboy-ng.desktop0000644000175000017500000000113414145033507020230 0ustar dbannondbannon[Desktop Entry] Name=tomboy-ng Name[de]=tomboy-ng Name[es]=tomboy-ng Name[fr]=tomboy-ng Name[nl]=tomboy-ng Comment=Cross Platform Notes Comment[de]=Notizen Plattformübergreifend Comment[es]=Notas Multiplatforma Comment[fr]=Notes Multiplateforme Comment[nl]=Platformoverschrijdend notities GenericName=Note Taker GenericName[de]=Notizanwendung GenericName[es]=Tomador de apuntes GenericName[fr]=Application de prise de notes GenericName[nl]=Notities maken Exec=tomboy-ng %f Icon=/usr/share/icons/hicolor/256x256/apps/tomboy-ng.png Terminal=false Type=Application Categories=GNOME;Utility Keywords=notes; tomboy-ng_0.34-1/glyphs/icons/0000755000175000017500000000000014145033507016036 5ustar dbannondbannontomboy-ng_0.34-1/glyphs/icons/hicolor/0000755000175000017500000000000014145033507017475 5ustar dbannondbannontomboy-ng_0.34-1/glyphs/icons/hicolor/22x22/0000755000175000017500000000000014145033507020254 5ustar dbannondbannontomboy-ng_0.34-1/glyphs/icons/hicolor/22x22/apps/0000755000175000017500000000000014145033507021217 5ustar dbannondbannontomboy-ng_0.34-1/glyphs/icons/hicolor/22x22/apps/tomboy-ng.png0000644000175000017500000002757714145033507023662 0ustar dbannondbannonPNG  IHDRĴl;iTXtXML:com.adobe.xmp Y%%iCCPxypd_sRGB default i1 DisplayPro, ColorMunki Display _[2018-11-14_18 35]x| |En䂈CAɵ אf# *n1$ $ 23:ㆢ>:긏Ό "2#n(﫮S`IUN:ۚڻz>vix!ޮhlS\SS%? st+6涷B~f"?[pf|'~t7vOzK[:\R^_yzOڱ'?/efeFܶn5K[5.tutVΝ}t TEaXP<:u7[˫&y<Z^7k .^ux / ^% jhPyZR^_"/52̓W7uY:sVw/linimSR\̇ow\VRY|ZgnwK_>??٠-+&tt 8/-d}7kgVb߸}}z{oWv׫v=yoMA4s%Ia7 1]=}k^~/ݫWGszs>=7}P{3O]gE}+k7culvf (*~]n~߱ggs~nAo؀ 8u[[ŚAG za˽}N/jVg3dPo识ohܵm 1.~0cDX_,Y: j ޿QcG}.ͻ'cv؉}{71>:Xʖ+¨5*'(G~!{ ػ>/W? ޾/kz] n77o};[|sП=裏/~O_%]/^^mo<_/jY~yՊcV^ѣ|+ל~-֯˒r2٘~]3ecPEяXndbp={z{#޾uN8dAi{Y'UL.-gu@X1U[WUv'K^z.>薃ov!za~4}ٍL?KZq̻g=;'۟dSs9οvqs;-=>8q/?:Ӆ9S<},urgת=}_r궵'=]ۧ{_})oqW\?D4fS;`Əv#s#vzŝuv9gǴvvsآ/1 b)-:0OU[zw|ny=sgOh*9l➓}_}吪}Y3w^v#{?mӇ͙zdzF9]c.{aE%Kwl h+*wu5Y뾽޸{<薑X}kmn?shw]uKnOw?caOt3㟝皞{^z_Yg}~o }sǿ+ޙnҩ/~JWpG_}?]jg'}޴kYc֖=믾˷W~^rgQPUE۠|q'[:`V[fE^b;5Ž#o7'=jCvucG>l/Z_#2谸\ R0=ɽ}D%5e|INPޫWg).;qK>?dC8l~<#lȏWN_Ѵye˧3G:w[>tl61A]Cǎ?vAp\|'/4ma㯎:O=OEg^ߝuwso> ^{K޿te/_~ŲE]eW/fŵ?aՍ_ܴ?ݒ?θ.;zq;~OV?&>^DÓmO\?? ǗzM|oGfOi#g@˼%W<,ʱ} _,0NSBǑ2@ Üu^\/a> >@X  .1k gp epP\BDBepDB L c8AY$ sLEȌ~#X$/ǿWy簛scXR&jiJ9xQd{"66 &\(}I=-$#"aMXP!c3Aa BBC3> TZtes >gy-LQ 1q3gR03\caOd^r!1iδc2K'1U |,C qCJp8LYd/B!Vb E!pGb(y`9# "4.j0B$g}9Ƈ=ܫ$2BcYJ_wmB't!05ĒFHF+84> b"x&h,0UQ s=+/bB cT&r4ˇaO`l}W*Iɜ9:#=@<z)ilPzE0\ pl!1󑎸Ql;$7 I2-9Ø.mԲƥ7f?F :j nhf_4/: /j~QIMx"(H00! 7/:WNllom[ȉ-ӑA6Y j%6A *I~D(ސE`Lt8Tah4(+ #}C<*k]S:dBn FIFPha!jD`dX45X"$E]t1N",d fV+Iڍ-DDxXP0%iaq@CR&8&&X"Pҁ'0LE"Ahl1CY cP+I.^Jm%Aaĭw0:$HTlm0Y#$]%]4 0IH,\dnl'#,R _Z]c} ˆ$5!&n-hKw]]x"+ҕbuep1Ft>@EAi$(+RAsMa:6naIWZ]mVFh$rI>ǬX]aVJ 3Ods8] O!AtR B8;6)d"0lҩviZi$X`j;Me;P.Vf9 Gu0Ս~H7'IW-`*AlH׬L9wq7,LNjRՕhҕI46i#vR-. +*ENAf-vPA8IצD :CIMcJ#Bl6$.¤tnaP S@2qgco۔yna8r`Du2IʼnnaZ5&] BP1!2tU9ݔ ";)"GnaxF8ȓKKīyax AZC&f,Nsv3Ψ,z ҁk70(-!wpK2 ]w I70@SLG4*:0|7be;M9 n&uUHk(0-R]:fF z渃*tk(0&m)-!J ÀޅxٖkqݔF@)397q Ƅ7%US@5Ť9]BD)Tm"jj8T EaCN&Ff ʭ!@A)Lir)C[o"0x3IT/Da4- &fߌ-FEaD8L%(&EaXI9x8 挹ěuna=3.GFsqۨ0H[70BROmr3gdr*2 89_tx}8 fAEcuAVd4U9s#!na6Rz8ݔ`2snzaNrda.*P(q(1wpQD$8L"S( छr(D)sQcKGAB]Dna,$Dΐ P9"ݔD&3cZ@b"{3r y݌Dfza2L=#HfQT/na"M!k709ո-70Ec("bM9LdҮ rm8L?w< !Qa"D8p]Qa0؅D1Kq$tb{p-y\)17L8bq0AEna"mqBE1qЅBKna5%1BF RN{(0MNΨI2F9@QPk殜)1!q3a>Az ͞tS4LK!ʼqabs~`!ak!T:ݔLTB6v]1w0gSt< P3cR,a<-8L, '%hEq4Mt809!$kZAСS;JqiOS%3br86'qPQ}Q"ݔ&ǑkIc8 2t);5 80b C"0D"tZC_ mItSc?D]D(~rqX#t 䳌 J*ؖݦ80xjѠIi Airsb%Øe6Q!<)3P3qZqn,$AˌÀ2rҨq\fFJ(wVM9d2`!OMq87r <"z IٛqHs>Z0H70>wӂ& ˌØ}/66^Qxda$足4-sriuS#zCR?M9 vK3;h[݌è MrqA\'ׂ scS1;cd:ݔ(B%<⤛r${Lge.e q͐Zjj>J|ReF2;*' M92G4x8V7B'sOqlݳ|e݆A"ihE9)8yD|.;8aS] H70:9K#t݌`ҙ`}Py8Fr6naGU@ʩhzZm{ c%)n.@:?J:1E`3B_[4 D{5ش(x8 *Kޤ9tә8?ps!6'tS\ w^fd:0=ØM.N53cr6ata ( _rX41-n1^n٧wfw=%inmroNVo p]뭸Q:pq5`gmH39T^躄/|6ץt=w^Hq-!k_gm}߶0kfpmo67 A./|K@`Wi7̷ۛ@f\'`{_z}^N?~ڳ9m^jy cpOM {xɷǴz2+o/* *z\ bΛWUxϼS$qg CVI7)'{ &WBfZof& o5f/"cߑ|#NixVjvFҒx#H)ZcvWmԖ[E6Of&-k=*M/ 4ed17{x@uX)}caϱ,zc :?tҢOmh<̆pd̝I'>l=.W&Mh#qfCfҔk3?CvUmN5XhխlH:1OcH%F=G+f̯InG6+ kJ"+S ͬVSI?S^c^w2ffO׮&n;ixa춫9oЅ;5%v4QOӁS035YռYՔ~gUY#lؾz"FՌq81=ƷܓOօ=f]ԏLz2OnC% ͖$D,`WQy4fǠ&nI:"g91w{[1scT s޺ pHYs%%IR$KIDAT8ՔKlTUtBKQ`7aA"+MB1FavhyQQ@c̝{E+!h>80Ԗ|ՑG788w[i>[pr?.N?UPXu8s,Η՟75> B-%7(*S}w)Q\M&[!ĦV6oJX_xNpxݜk^Ņ6raHFk'S?% N6A-O~B~ı@dW-EiMN$1RHadf6KfP&̶<ӚVz-WRq~AR#q!3.,lbmxgF!l|Mz=qQ>fǝa"ՒZBF`tݨV]= ؘV-ƸtKjzJ/D #0CyK1zИʁ@x{J&"MCp2.:w.x!BFX|h5x^$ͳhz$bpdbkgΒINӀ@J>8s 9zŗSv04xJybNo8)@8C5 &M&8`I.#qsc\M5,!8F2%UG*Y հNM?+CrBl5E`+Baz{zR2PhґS72֚$Whh/߳VMjP '@ueFiV[#)mBvj þ-%iCCPxypd_sRGB default i1 DisplayPro, ColorMunki Display _[2018-11-14_18 35]x| |En䂈CAɵ אf# *n1$ $ 23:ㆢ>:긏Ό "2#n(﫮S`IUN:ۚڻz>vix!ޮhlS\SS%? st+6涷B~f"?[pf|'~t7vOzK[:\R^_yzOڱ'?/efeFܶn5K[5.tutVΝ}t TEaXP<:u7[˫&y<Z^7k .^ux / ^% jhPyZR^_"/52̓W7uY:sVw/linimSR\̇ow\VRY|ZgnwK_>??٠-+&tt 8/-d}7kgVb߸}}z{oWv׫v=yoMA4s%Ia7 1]=}k^~/ݫWGszs>=7}P{3O]gE}+k7culvf (*~]n~߱ggs~nAo؀ 8u[[ŚAG za˽}N/jVg3dPo识ohܵm 1.~0cDX_,Y: j ޿QcG}.ͻ'cv؉}{71>:Xʖ+¨5*'(G~!{ ػ>/W? ޾/kz] n77o};[|sП=裏/~O_%]/^^mo<_/jY~yՊcV^ѣ|+ל~-֯˒r2٘~]3ecPEяXndbp={z{#޾uN8dAi{Y'UL.-gu@X1U[WUv'K^z.>薃ov!za~4}ٍL?KZq̻g=;'۟dSs9οvqs;-=>8q/?:Ӆ9S<},urgת=}_r궵'=]ۧ{_})oqW\?D4fS;`Əv#s#vzŝuv9gǴvvsآ/1 b)-:0OU[zw|ny=sgOh*9l➓}_}吪}Y3w^v#{?mӇ͙zdzF9]c.{aE%Kwl h+*wu5Y뾽޸{<薑X}kmn?shw]uKnOw?caOt3㟝皞{^z_Yg}~o }sǿ+ޙnҩ/~JWpG_}?]jg'}޴kYc֖=믾˷W~^rgQPUE۠|q'[:`V[fE^b;5Ž#o7'=jCvucG>l/Z_#2谸\ R0=ɽ}D%5e|INPޫWg).;qK>?dC8l~<#lȏWN_Ѵye˧3G:w[>tl61A]Cǎ?vAp\|'/4ma㯎:O=OEg^ߝuwso> ^{K޿te/_~ŲE]eW/fŵ?aՍ_ܴ?ݒ?θ.;zq;~OV?&>^DÓmO\?? ǗzM|oGfOi#g@˼%W<,ʱ} _,0NSBǑ2@ Üu^\/a> >@X  .1k gp epP\BDBepDB L c8AY$ sLEȌ~#X$/ǿWy簛scXR&jiJ9xQd{"66 &\(}I=-$#"aMXP!c3Aa BBC3> TZtes >gy-LQ 1q3gR03\caOd^r!1iδc2K'1U |,C qCJp8LYd/B!Vb E!pGb(y`9# "4.j0B$g}9Ƈ=ܫ$2BcYJ_wmB't!05ĒFHF+84> b"x&h,0UQ s=+/bB cT&r4ˇaO`l}W*Iɜ9:#=@<z)ilPzE0\ pl!1󑎸Ql;$7 I2-9Ø.mԲƥ7f?F :j nhf_4/: /j~QIMx"(H00! 7/:WNllom[ȉ-ӑA6Y j%6A *I~D(ސE`Lt8Tah4(+ #}C<*k]S:dBn FIFPha!jD`dX45X"$E]t1N",d fV+Iڍ-DDxXP0%iaq@CR&8&&X"Pҁ'0LE"Ahl1CY cP+I.^Jm%Aaĭw0:$HTlm0Y#$]%]4 0IH,\dnl'#,R _Z]c} ˆ$5!&n-hKw]]x"+ҕbuep1Ft>@EAi$(+RAsMa:6naIWZ]mVFh$rI>ǬX]aVJ 3Ods8] O!AtR B8;6)d"0lҩviZi$X`j;Me;P.Vf9 Gu0Ս~H7'IW-`*AlH׬L9wq7,LNjRՕhҕI46i#vR-. +*ENAf-vPA8IצD :CIMcJ#Bl6$.¤tnaP S@2qgco۔yna8r`Du2IʼnnaZ5&] BP1!2tU9ݔ ";)"GnaxF8ȓKKīyax AZC&f,Nsv3Ψ,z ҁk70(-!wpK2 ]w I70@SLG4*:0|7be;M9 n&uUHk(0-R]:fF z渃*tk(0&m)-!J ÀޅxٖkqݔF@)397q Ƅ7%US@5Ť9]BD)Tm"jj8T EaCN&Ff ʭ!@A)Lir)C[o"0x3IT/Da4- &fߌ-FEaD8L%(&EaXI9x8 挹ěuna=3.GFsqۨ0H[70BROmr3gdr*2 89_tx}8 fAEcuAVd4U9s#!na6Rz8ݔ`2snzaNrda.*P(q(1wpQD$8L"S( छr(D)sQcKGAB]Dna,$Dΐ P9"ݔD&3cZ@b"{3r y݌Dfza2L=#HfQT/na"M!k709ո-70Ec("bM9LdҮ rm8L?w< !Qa"D8p]Qa0؅D1Kq$tb{p-y\)17L8bq0AEna"mqBE1qЅBKna5%1BF RN{(0MNΨI2F9@QPk殜)1!q3a>Az ͞tS4LK!ʼqabs~`!ak!T:ݔLTB6v]1w0gSt< P3cR,a<-8L, '%hEq4Mt809!$kZAСS;JqiOS%3br86'qPQ}Q"ݔ&ǑkIc8 2t);5 80b C"0D"tZC_ mItSc?D]D(~rqX#t 䳌 J*ؖݦ80xjѠIi Airsb%Øe6Q!<)3P3qZqn,$AˌÀ2rҨq\fFJ(wVM9d2`!OMq87r <"z IٛqHs>Z0H70>wӂ& ˌØ}/66^Qxda$足4-sriuS#zCR?M9 vK3;h[݌è MrqA\'ׂ scS1;cd:ݔ(B%<⤛r${Lge.e q͐Zjj>J|ReF2;*' M92G4x8V7B'sOqlݳ|e݆A"ihE9)8yD|.;8aS] H70:9K#t݌`ҙ`}Py8Fr6naGU@ʩhzZm{ c%)n.@:?J:1E`3B_[4 D{5ش(x8 *Kޤ9tә8?ps!6'tS\ w^fd:0=ØM.N53cr6ata ( _rX41-n1^n٧wfw=%inmroNVo p]뭸Q:pq5`gmH39T^躄/|6ץt=w^Hq-!k_gm}߶0kfpmo67 A./|K@`Wi7̷ۛ@f\'`{_z}^N?~ڳ9m^jy cpOM {xɷǴz2+o/* *z\ bΛWUxϼS$qg CVI7)'{ &WBfZof& o5f/"cߑ|#NixVjvFҒx#H)ZcvWmԖ[E6Of&-k=*M/ 4ed17{x@uX)}caϱ,zc :?tҢOmh<̆pd̝I'>l=.W&Mh#qfCfҔk3?CvUmN5XhխlH:1OcH%F=G+f̯InG6+ kJ"+S ͬVSI?S^c^w2ffO׮&n;ixa춫9oЅ;5%v4QOӁS035YռYՔ~gUY#lؾz"FՌq81=ƷܓOօ=f]ԏLz2OnC% ͖$D,`WQy4fǠ&nI:"g91w{[1scT s޺ pHYs   IDATxyGu~Y5m}Œe-68$6@&77MnO &,7HM!lWlY6FHI?KwUTUw3#c694Owuuws~wNUCG:ґt#HG:ґt#HG:ґt#HG:ґt#HG:ґt#HG:ґt#HG:ґt#HG:ґt#HG:ґt#HG:ґt#HG:ґt#HG:ґt#HG:ґ']݁|yO%%B!V#F5I'ou_et#SiED=7 Y{{v/X&,5Q35ejYƀ9n{L:YSM=ԑ'_:H#"J/C Y1cAtc8 & 9y@dYY !+ˡĠg'Mc:9[K}iĎ<1rIƾcwқ%zA&I'rW1&遲wQ" ٽŘ1N EVY{zyR)7y/lzI(c ED)T?-KW~$&ZVVĽƤvc oi7 jiF^Lu{K~42`GE?uBv6c&1Y-z7|SկgtJOT~ac ㇊m; Ƹˎa5"'x!TV͢e[Ztm@|ɓn~zvJ-ld@5vecW]L$A|4Gt|ޮN3e+Srh hEP^4&~myO|)yI5~ϭ:1vOXh@pg1"ot@`ŋG_z|jj3g_u+~0Ʌ5v]0d+3wzv+Xd摂WExolkҥou'Q5Wэ5`qKʛ6/< a1ʡEO/.48giDih Jw%7~ nSG粫=*oZk=ʹs~J%.]… B`14''=|/\t t9ws-d(*?kt2Ñ7u  E}]y?ԑ'Q7O !Df X+ׯvYV fɡC񿔒!Qic̑U:D :AC0gmP AWo ;84cCCc+k/R}迖} {lBZȟR"  R[^յ;hŊt022Ge|PVYf ju6 N>$Gmo{V3^.d.5yOÜnp=o#=a?!)~JaJ!pǚBߋ2т *Ƅ,,aܟmH$<ןW!obDeh4IYz[i+g/Vv ExK\;r)BxBJ"(Q$i .gOa+br̿s=M%/%$& QN:mXtU4:zWa:蛐_MǮh;Ɲ7տ.P0ks7V,~m ()w EŪIY7.nߨ9m3͟{#&e%Air='D:/ `r|MOt/]J z+rZ//m6>iHӔÇ3==m;,K.esPBZO6O|'~}W"Qu_Lk`sL1|p?3!Xv'.!##am>V|/ .f϶xOrLC(OОn;g;0_<$"&0XDih% KwKKn8{qw#*loG)4b!<7/SVezzzk_Zk\wu/F)͛9|02.qzRĚ5k.Z29%d\[_r s{+uFJGƿ hc;v56x=}(zZ1aիLÚ5k8닔k+&$2qth_}Z9Ϛ=ѿww&ED>šLNZllqL2{\1m^yΌP)C3gA("!0D}Gn=}99[6gR"D#D=lnx(T*۷/S!^GOO7n _J)zzzx^OI$z^XLQ RlA1>]>tk;>iwnuy{rKzfo?CBѥӧNr!J)Wjlv˯lSvi< *b`4<e b$re*ܵZ$]{Vfyr]WQ\5²N5 ~g>wַZ-R9r#GP*keŊH)~BpM7k.z9rNt^z_@+Qv !m=B)F1Q)FBJd{907gc_5cO;'? O0) A 3hBJR1-]ǺoT˽f",m dl+9!CTV 7<LG\wmH"5AiR !ՆTiuwLLM顫 Ri͛Z3::ʹs^O|iZ֭>N(ŒŋٯW\ѭ(`,5ZSISTbRe)ŖS/<~ ]Omt>қLIJr'U/΂@=Ig"vEr.KR*;9}w9G BZAD@dFta"vmG8_ "BH{8l >cS~Hy Ǐ$C&9j~j␎\\0-9!˄/ YȰ7y˦Bp}1<<1e˖n:j===TU* > ###!زe 7|3SSS l2>L}iٶfʔ*)QDG8"s$ dGzh›ozϵN>P|7=bO +(| M[,X ;oҽ#P!ϑB Ab;ih#'C%~啄y>ehHޝȮ ~O#^.׭ϹW.W:@  o<==Mdll(ZsUW!̲ZGra,^W,_!CCC:ul)G)2.qLPbi8F)&*!]8F A3{w/E׾󶋽jvxn}$_~BiL~ *?v[!J tc ٨E70CwO1l6*fR2wAomA!p[EW)ψ=O(- Z||^vbB.l{S⡷t0)$[~ٴ}s9Bog߾}i˹Kh6$IR1ٓ\zTU*r5=UIL@#+5tjkF($x ;bPDEE"@J*G^7j0/~Oz355ydL-$7xg$/,?o|1pt '޾A6 ׺ @KϟE0 8'#x0ٞmw1*hWs_]dYoQc7bG}(c{8>cF(ڡxddj֚uR\veTUǩT*DQ>~=5j!&[:fbݢh͢[ (^%xbqe?G>p-?)si4=/n}}io^~ϕWȒNatV^ &X FRz&-LMKV{.܄UŅqR_?(ȇAJ7d#|2?.;{> n*KaEp7; ^Lhlk++4Xϭ#sI y*ϴqPugϞ--_>Ve*Z.z{{9}4V*]]]LLLp)j3Vƴ)s,jcLjHf15F,k`\-S'~bkW3gLF?~irV{=_d$oeXBz|gc `bM#}w3{l6~8l'l"בE)oFƖ8D d) r27;Λ߼CpA_DtuW`Z#։1,爙$G 믽{+(W^ɧ8uir 7PT00>>ΩS>G̼___VwUWYOg&Ѝ=Q HWz*Qh)E>qUWl6al[@OC7fi cf' /t1k佈"dQW,?`lQoAɬ~f0\iLN3{|v\F<=%8%iYHe-/Jآ%2e88g bnF%"- :R*.{CWCkVB'Y/~ʇzX'76p~n0YsBS[õaB]qϯIG+j v-th6Z-de,YBVcxx(+J` &mb\Fԕd65}i(B74jQJ#^yH 60mj3xo?77y4OZeC#Duc=n)|k 2YJ0̫gȠDY!P}Qfɲ5|.٬gAښvapnYrĀ…!4$f!}6,YA|H8Gap$ a<3p<9:ŒiyI6͋.fEwY?e_LldN>u/~;rfff(TU֭[ǒ%KXr%ݬ] n8kocD̢=-Dqy{tt+E7 J3g٬Npx2NW2+z,#04Ԁea0Szxpȸ1{@+Ie%B2(ŀaCu},"X\K`)ʜϽ_>|G@6)pJrFHWP aQoN|>wAA}{-!' 1y=~"N~y/u#1Կ%//];Zsln1Pӓ)eÇi6T*֮]KСa@p?N\s5 Q.;%'PiHZI"20'dJZsvES*I*%>3tQ)}bZ f"(D d!q,dlvRzqV}wxHNDh&ma dU =߶[+HSS9(c7v[zwwΰ]ݷB Qƅ!ɑMNdcvMu8$lQ/3ӑL.{[5z6u?}Kw׿u,YK/p췾u7 .gffYY a{ Tc 4@K?9ífP?7t3(۾^rݰ0n D\B*Z7c lXa.GJFG;U ORetbK^C7Ux=|=qn脭Aݬg&LFY93/gQ;fp?b)Xq5S]RЛJl>?Q&-X< vPT<9G { ;v^Њ(%ڻ{mɠ c°`bZОӇ)X2$ &<'[ɻyFo| ߀JmΥV'ϳ{8&hm@;;{1Uo#]ÂBF<0<ƁIV/-mmCܵ4'&8((LҴ5g%>(1&7\XL1P@ d}3ޫ\l(ƽaǖȸؾytu25qyk+iyI9Dp`TB&ߗpbhShAQh;-iƿ^3Sny;ֿI}.ESEQj~4`"e Kdb ؼvpAt3w"$#c|=?15pk4 LPIUu 3<%MT^zC+<І4/g6d r1l% R,議tI$|䋏rwN0>0YOxFJ nNϰYc}=峙*'`d"Y'Ty˥@\;ޣ%31Khx6l#"Ny;qWkj+XJ}&r=2*(j”e>= A!B*ØP_i c#<,w}r޽~)\ln:VZmR6[|iZ81x# hb:&mNJ+|wTYldۚGUn g^}R`=r)B!8̓ GX  (ZCٓ,?I\hc={f%9o#*r WH fcfA$kW) C5 !k!OU׾3|Sj|~qѸ>3rqF/_ 'chHz)L2I~1 CcB_W} cɂ*7^ j>|c`x5ٺjG'Yێi\AVc@KVO9썀8^_iqG6m=g$VYu^ّ`2rk|- Bb8H,޶8Gq|$iR*UXz}Ksxw7ofҥ Uy쇐ؘ;}PKJ.˗ 5I[l5 F_}Ny.G[)/05 7J>GKs+rD0TKVrɥv,B X9sAuz/8ɕ$T~{' _CbG{neي<&;Glb㮷QZ\Aً^uՀtЎ%U۾bJ4@P1*:cE۱\Q]=!d#5zzǻGF\uV-)}e^P#Lu#19HiĴf0:F%@>H8=>ڥ}CpS\y)w^¿}0M~6j%&g,._%!2VcR,L'mŠ A?xE6ѭpe| {XC'' V$՚ Z- R2BQ"+]OrcInpULn/0LM6gM:9\gӃs*UD .$"$b,HJV Gaۿb_a;g0G <( ,*~:{=y~/syQI: "CTԁʺ_ g!p=Bȸm ej$|}k>iNDH-!B>KvC&$@A=oV Ҍs*ȞDE I3k&=GF>8bmT6?\jg 8`y#-$<_Ucݜ$-H[yhf)]S~)?{Vn#y˵Y?4ʗ?ۮ\$ @$Q,ne^tJ[pM0l>vʤh$+n !|y.g Al #z.p~tu/`[Dzy9!0S@=MLA9Lh%sUMCV7<a˥kqYׁnqNscgNS:Ăp&9iDP)e>9ɭ?[e\a+ãd ]I)`B`dcD.MpTJS2vG IҽđU4l =k.De-5:0څ(Y 3%Ȍt s\{Iǭ@$XrVo3Q|{14?@1s,R:)i)幉6QZ(-8n_[Y(~41>2{Pl`p,mUw$<3٠+>jV vLRzf(;4,qY4KHټNV[0F{av$9i,88b}R`+Kr]*A1eg۱!gkȈG[p0#~j7wĂ=5W87of}m۶! B4mQC 뗪~3[( 8}OlyJz I04pp ٱL ZS btnR>pnf)w8u6!;fE4 .$kٶAO1Q1N%83cTP,ʝUE/,9-W&|CxEMr"3 +Ȕj1|AϞ`f|+qm ]T4yh}"ixkO\3FykT2$*}cgggTSײ 9n]%aDž|w(Wi9;g{}X*ƐI9~40"+VΗ{WrT`2vHOĆ>Ld|š12Wmy %TPە2 }2gs.CB( `KK ⯋vcuӻOsO< @d:F>=|[y䃤iJ$hILmdA<#!B8yT_Κ%gэYH;| PR~KKJrQqԬm+R-h!J@7y֩̎t֞+;Y|]CaP@y ~O)ρW]D)#2z} aOշyFƑڦUىգVc$I*!M5ZAֶ}}'@nȍAF$M!`R9Qm it24*MχܱBL$Q Q`jc3v%1A /V agNӯRTr,#Os'@r\)kx0G9x!H)YjVnqDX.>(ra֠-,~IⒸTC+ش޽@3: ˜wNW 3{nⱑ;h6fQID)$Ai__0w<P֡Ŕ$nfޚ o^ց:24-Ih@+`$t+Zfwr(@5`hIoSV3B0"TڶՇ;heK}:ކ 2eÕR q@|N\d\}z$Ӈm^?LidYvK8l@R Dr24b~keʟ6<.#_f&GIVBhPirƍ4B؛Le FQiLn_M]y>QU~N^U"זLB}ptV+ajNl&عCaP+DoӮ|cȗ#P"27qC&Jo;_|*(5 Be/ !4@Y;yRP]uY[(➟mqO| @ތ#]}(-QiҚ4U(J*ESHS1hAS ZH1 B(0¯)_z) j"PyA!xdv'ts6SЬ5/xL_0W@{ F,ڼKGE&:эeffLN3l*+pvi@,:-u7 ڴ\@/!x Ն^i9<ӣ,\ - :' 8? ̷h"Ǐ.\ r k_Snx/Y6h#*%hRhIuVm4:TLQBcQ+k qm ۇB|SQL%עjإ, ap*Q lfVc2LMh5@PMM},C}Yh_ h_ypա0WvR3@*>%)De F&e{iϦX8^u{m"܀ QM hBv t?uG//H8m&߬'V5Me뵉1ƠhaZ+6hѩFaQrISRA׈iؐ@04cICPAy.$KwJy B0:m"R6ڧ|Bп#} XR"呙%D>S\"Fb$fbJfbaD!X$2 P7@y,Ȯ-=$Qe6<P d) #*kS+!B½s؎7wAaa{uchPP1}FO\?.yR @{#L"5=`I7㧱_!ke-Xek2J`JQڡUxX^@FB* hY+xknm,E60gI$n dӌrt)&^DwojJTPHddz (^Onzg\!O k 8$!Xq cRI|*1 F-g퍇K]]ǎcMLc'q< d¹yQd Zt7DT{_eXI3ށQjZ'$WCӘ E#!#,0"#0*APi!T$G FcT!c<*0rT :^%˖U۠ <2Cl'N'э ľ@q@ *%nj*jJ%&.(v,PZ(Mih6[Sme=jþBP!,q2hü8fNBVKð#$=Rrrg xI oAŗ>.j0+( 3O;D/xsV s'?9Ƿ41*Fp]Ώ+O4l?GȟSEu6'+ZjgA4*Ȋ-bWZ7Xβ IDAT8`VpS:E]^e3MjbBAہI{/Z2cBd]1j1C:dEf jLˣD>* r$)cjt^s^WL$gfyQ71MF£ltYۜg]a};"  aBPӪm GNg4޵\N|诽!o5zktF(^ѣAڧً:rS~iocba :H[+KjWTQAjjY%׶X6-!nam4KlfIyoc WXGY Y&vC0W} ⮣ede^**R8(EXBdgȾDa @i4[i9̵ȿgU~' `7_Ȥ81_1u`4﷟cP48|gZ bî?kK^لo΀/}Dž\6=z>!7"[O@ByYYnZ2]Fcl͝WƥB\rҩE FWv("EGؼX^8PjckaL} lKI#RLUe2~tjo/Tz(W)1q)&P.IH)1–D7P4s칳2Lm (>d,3~]@IX9k 6y`7gIHgl1So"&Ύ2<|V ^ЦqnC9O@BzDpmEM "0):0F&w}j\C=VDM`E1ZQ*\YYg_&̫x npEa6~hJl&@%( h g+Ae )̌V e qUP*2RZO՞~^*BIE"[ fK3LlqeӦa݅<&x;yhǁUB`{Ц >Mr"et+G#n?3'D GM/b?}D"0a> | `(LaIc}lWpDMۛv\} w~AQ)y";.DzK<ĶlQ<'Rr8I%Q%XqdURRXq-;mMDILH$ޝs{^ ]{9ַ54q׾{/Nk.u??fm0``b~-G*D7̳@o ldAZҐ;M2!B$6 rAR6\^rI?v9 5zy/prrR:}Lx򫽌";Qdc Ts9.V2JY3 ȼ`ߟ8cw4/η~Mכg&-w?Bg>~D"m"ICNl0[]g6_c̦-h\i IJ/;z_Bx.K!yьf5ZE2~}Q[7@iF/WZW_Ϋ_&OvEP͡›.@""y *3z+1r+FA#Wq]L.T'US}<|qu'oXbg x\rI$%,Qq+)!CR̵DRAБ$(a~ ҇0- (0Х ټW|12>O[xiOX"Hm L[h t|eld$4} ] x8pwo*aLYTUe>iL"X(reezO^QKl*='K^x9rct JA:&Tjŗܥ&vmH! G7Hs 3t?>w&j{m=9h2ʔJř\YIqhYuM&הH))urbV tJv0dAO% sw"1`@ o[_ѴM޽<[G'9ˮtC7D&mmـ͔|lΤ3iB&(OGђJKH]M۵-H&'A(%A";7__&l6mlj_C/h,G0~{?wR|6uۤ='?#u1:zO?>7X_|4/=}92['8ˀ((e|q1؂hhZ'6sZY9ys Z9o!iO嵀wMg[D6Xikh`g8X yB#:k`|\!:)nK=C_.H&*iuE\· QC.KgFinBK2}%#{ TFk[J+B3AB&VWr*'Xk׊ʯ^u?眯FrkrsYв:.a81~ό^GOѫz'JSu; sI9? gz&H5'JǷԡ`"Ťu A& ő8, U!I]N?.iCKQGN޺Őᭃ ya\=rAY. CP)%xhC 0iM!L39ɄiK3/rttoݬe}>J\*2kqLl^CqH6b yڦKHq⒚dtQ7Rr"ۯ4,]W"Xݾ/}Ӷz仹-ٗd-6Ÿ *B!<:GM&W߿t_|oݼ#-8h"춣HR:%d4a(yHq _Z)C@֟8D68o>#Z+ xw8?!|,-q G,O9Xo[h' I>MCzqAzGw Ȕw \`ట0h/$D>ȕ\lUkG|zGek~bŅp*/K{eD 9fЄh̹vn!o<ٸ.v+^/}WXls0o *SܱsCDw).S)G~GIqX[MS\9JZ UG*yQ1ԟ @Q#h{)#]H%I1vEʅH%9(H>#M8g0 닞901ľt ݲ,OOe>w"|hH DS;f!cww|'~'V).N2YƧkΙHAM/!:'Eh5W 3.BPvO=Dcw/~%ˎoywqה@t5rsKY p.+7fs"py? 0G;ɷMoEԂT>^N_qD 9_ܐQ#3 8_6kTEQX ;k^/\݀msJsF>[ {u );M64KN )={6 ҇h#`R*4".]gee< xkg^[(dla& U)K趩{’jB Ztb@TpoA618tWc7gƯq!٥/n_%(AQO֥ 7{-"^μ'@8w8?zJY#L \֪9R}0|Pb:l u}>jlyhydd8$.@D)p,#)f2Ѕ"Mq Y=!4d|'B L$nw''mЀ|&BN /.B_!We}y|c7ociVVVL&4MCTG9fiOD~N! =T% S{ {cCyXgsccx_ 6=V|wF^_:Fav!\{gđⰯI} C?}~ /=~z8=ۤBpYoZBS!AR̈́gD4Po4oP6X&IueSJ*8N&|1d%s\pC^"VEMA*LȒN7jǭ?CDLLM-+u8B(A h痟>`0נ%_=]m"%{=PZx (46 0bU!X oQAFOyO&k׶{ۯGYۼk(.E d8<υ5e]r, ^y֯~paB jh UX®,n<,@S0ޑg$ R@rą(>Ѿ|)+9%, PC6L%w|.%\x+ k RʿahbOh"C$ ms+|hLMNXYzDq.p}C|Ĺ.xɕCu3(7X.lob{;6$wg.@ErڏFA;!%_nqȊ78 (-@$~Y4S΄eb~DM. 8s/m‹pttȓQ|N Dr$@Pzfb* v]X};w2s34졂?; [* h?0ZpMP^A ϱ(F?D$ tSJTg V#火&vbōpdsYn({A?!q՛\[圾,=nCtH1$AL99ϐ<['\MsVV2 8LX.,K{;ᵱ >W R'a>l*D EnkP`YA]w>{ v1]<|Dm; 6pppz#n0[%ub;4@6 z`H-ur4˿>?N5Xf{H2Q~j6Iؗ8kE=ak̿(JFlB:}/Za1 D1n r_qS,!H7VS_ˌ}TVr)+$m|C*$:Yp>(a}\jPPC3=18+<B13]d:Ɍ$rRUղ3t/j6i4MuMQ:_.Vbx@l|(eIE"(Cw=)&AseS^z6;\ro:g/\V!2xTY|&[n[y4ti&*xBXnˍV&S6RMx9˂Op9˽Y.Zfl?-OwCO%Ex2:J&UT T\)>>7$7h!"GL#r q1|~&/.DnX2 ]N&Ba#H@פ*B(W_R8~M{ KR0%yBm&y(_'IJyʸ=eCӁېsMAHԦV9+1SpLq#bP|Q}p[G-J"=çJZ:T|0VuXo\A zϪWʐ|jʻ^y6Ꞌ쳁up]n:๧7?>osoĩЪ9#T#5a8eqzEt;zP^S'K3`4>wW(It~NB$ZJ\v$,c,\ÛfZ&B3EUPbʹV Õ#'%\d3%R _yKA҄|C}mvA IDAT$ Kb p!=6R>r@& ҅ߊ̋Rs lJu!K]q풮wy^mYY)O]"̢\HEȺԙEODײrJ &2IC ݉c蟠)cW_fO}~{;}F,/*d@[E,qaFv rec&KHai)S.ŮFyV!m&#" >&9X܁rO=U@e>" Hyp9 RTfIۃ$[K=1%|ؒ|Gl H4ð$H:fZ|~)V"Fʆlڿo2ˡY?}2ΐ= ˚GvNQ qϧX(욾,hԟ"Pc-Ğ9]^|_rmT𩋡~XzX$ux|cyQ9`"؛RCQE-c]T6ZR˗( ^$%> N+>ZQℝ8|ZȻҠ$IM9%!ӡ%I 5xWyn>U(e&?C1$E?ކt?z8%aI{Y}s ה4LDa DոC|'qKd\+_\=:[s^Op]C oX\}ӫt 7^jUʻ G^>sC 4ҿb'+`Hk6R$P2I8ѱ83HnY?[)QѠ ;[~F (Bh ʹTN̈́rlitNV!BJv-!#\(ҌEcⶉ f2ԟ>dᏅw0\FZƧ$,%Z Ŧ&p0o=#( &)i`-k(kXӉo[ߢ 7^?sʿK o؍$>My{/V M+SXa@4 ߔ4L\@9!AI=qUm|X+o ω*;,>b*\3ˣ?pT)FY%5TbBl Af}kȻ\ i 4$ }3) ^\ Z%y3L=a ,OvY3pZH4 GAx& O+Ӳ&|')qrF*EY e$Ȇ-P FXtktrguekʣ３[3sG<+%+ O/ϓDܽWH5.Z5@abY78?q%fд(E{&P420]j%Zj qfn p]Z3'Xh(3bQGSˆspfV%7VV*")Ydz'dt^Ɨuny5K#)Q}P}Zx$Xy+!X*3TSjDK ~BכSyťl8@\ l1i۷o/7Obz sh' Ye6ǎH3N;i)"jR՗ tuK΀(=E|N}aeRL٦;s\Bښϗ(Ő) l GslK([ \s( oHU^ ދ@"h-eԅ͗y Z֬;GDKDd`?g;)vuPd)s(nFg0(V-7+ : 0FJ筠SZ;pʜ~?`e>ep) vxWnp{\ ~XlHK I͢J 8PTl:846^XWTIv唄0f"q+?$՗ 'J*`af/k%EKdaYd> qUһ˂`/ŝTy2[H*Ro]K&]@]&/ iD,zn1z0fB,su[E#RՖw2w߱JJvӷ؝G> s*dSMU AФ6P<:[WT,&aC}TT%`g-G8 ćTwc]τX1ol<'fV!sGо*NCn(E[c*V Ēz)V C '0٢}^(΄e]$M;E kqԜ N wkO3de |]qKOv_ؗ+;cFPXvAu<98A@zn}Կ(GRD3-id]MYMP + li2LJ>]C= :Z@R ;#B(j aX,r |  (m$^!ER`DʸGaXigЀ#)B9ԄN6p#2Cc#>rrPL99*|uvĨn+, TAYբ8i$՛_WWxWXpz`XH<v|Gg)صt-!?9wc6=I[Joe5GYf[]8rSo j*htMS2M#pM6ڜҸPCVN\<(Fx]}һ#*abbQD4D"+y}fek ,ԕJuφtU؍ґU1[ΠceQRx l7N!pUڐ9ʩIT'BQ-ED~/x}.σ|b8z7^} +rWUv)ϒ ,5B &t+$uр{v8z\#~# i6j[cG/=;N3LMMr1J ["N r_'Cx sTw>Z {|f;! )F$cu+ 7!$cN gȚ΢(q$R",|ḀLv>K푯(IW L\+)_C^hJ9Q-zJB3u~Ɣիr〝焣7~}W9-urαNӴllKcmu}6sO~l-͆CzB"vrt&OiNvp<Nģϒ7"J׉!aإy5]y9:\*(CKLπ*r(ʜI^W;Ie4 xM6#%*?e< f]X2/__ʕp&x~ZqdC0=Dg0&X/wQUQ4Rі0tyQ?W&jqS\9r;IӼv g2ñrؤ;vuGȍ#qXMgH5M" ' PT6GƕL? }d X-LA|4IN)6w'~y7hk>8W~ 0I*)45݃KK8ݤlfA}2@R^װhyMQ=/c'ZB;qRP,u a\ڤ'!F>Uȡ[7!f.;^?A^xs|_P9AloqN۶eeeNft]~O@"O7D\b"a~;6hsS\zI$ Ȣ,|g'qIRՊ)r(]z8KF&Mc)5wAP\ɳi).RQ{_P|Z^y).уOAKʸH)k_F賒7 :Zǒ^Ϻ1PȲHi;)`2nH֪+󳬟Sp(/RIbTde:~*Vkóc}`c9vwn5X][gowsl6c(!|giJŧ&̡D`/)?"+1l'm|w4ɵrz߿/OoPm&O&xl8j 57z=q)VB(,Ē(,.'-GN=/* &l6D3/UP3D䴥d~Zc Y5/, 'P+촓("Se{D9蔘(U}BtrYŽpg䚟7;!Qeո6Rs7_xع}wkmpxхY[[LT!+m vԲ`Ӹ$G.AJ^E$'o~OV?ăIA61L4Z(m  3dD$;SbhYI8q* X*h7?_XTHEBS䒭c=EU "n}hp?*,KE.Vc<~޼y2ۄv@YK4}Qr=]į[yIаu8 oK޳q{U {ti=6;5n.3{MqI⇓>kİN~~_썔j\s~]|/{x,'^Ol8kI!%̦@+ VO(nQE[0 .!+*[`uTN;o(.("RZ[}k_'~لxԒ:\Iks(IUiHgƘH%|s"@ NJ-aAVP!9=a#Y{ f( gU| w1 \(*o^+1k ֽg2ar$>5|%Ep-{e|!ղ%uG-a|GfEh$aJ,nn'r~lG֯, (GO XyAckkj [Q ۫i'ln^c<`w1B1Fv!U4 VyV\k;82m:$<[ta˾ ɝe|X2L<ĕ>m3~%X׫~Y7jp |wDi,gFˁ.Dj `Ʃv*S6_)">R+A2)ɣ,CHȠ4} -t'k# !as@{Hb;pKè[lt) vE !.@g'{(]sOLJxs_b:wnF|.2t*;;ۤX__[yԧf~l h8Q$P7 +$V ;Ha;N аpI*<`t""&b IDATtڹRUQ UЗf^7"b%PkrD$$!4)ʣ0,cv6 p%//(4=ZV*FЅPZe35a Dݍ铍Tsb OD/ 2N'*!e(#Ϧ0*}G<~Y ٠V՗?Eiͫ,N9:ܽ=MӲy[pxw!2X]]c:kW._f8_Y'8Ir,%\$%@kaЙ8On8V&ڍ{m2IRJ]ďm\tYX7,`Nl51L؄|m x3&9ݵnlUJ~RƗ+jhHNb}qF,5W %cORcLEq J)/ ]s8,'>r?Ą[J֊juD<(y PՆ01 6>̓2_=kWi7. 9X]`Bdcc#A deeM{ogᔎ9X0Sqn`\cCI ~~$t8!?s0jMMAu^pwwM 5.l,mPAbR1[C4$QrK*TaeZ-H4^dHB H>%VGt!"#7;kc qYFed Kkaz!8+Ec]* 4nB3 E@2 kUE);YDƯRAxg߂y :[۷_(ɌW` i.]BUB`>s||8F7 qB'Dt8yU }{'n8",o{}a;~ b?HVrf6e8$.._bE(V}M1n2lNEƏ<Ԓ d.ZԼM{.ଛ!-2fEB͟(=GFƂ~QBq } *`k (5¶:M2B?"zee̽l,V("n^%nMp^yjP܇J&asBƇ8<:O|އk8}„<h e gswWv%X.;#Ri8ӥ5H}Q|m1089'Ϻ8p6 <@8J\Ý;=-Y}w"?M:} )gbt1@ѦnRg@y_n,Byu+o(ﵰZSEB8PlyXސm/U6$RQKq$>Rጐd>6[l+> ,? %dJ[Nf %sdAJĚF5*ӯ4'?ܾ,]MV.qӓ} 9>@d&Sq9::m[6<+ٿ?ݶ4d `"nJ ͰK^3nލK&ɼ@JW`Xjh^Anr[<;i̼ "T?<%*tq',1(V jP.@2? eRFi*p2&rL&F&!BJqUyU.3)&9Ŧ2FL>cQۣ\# HIx{?F~uW*2_0akCnѐ|U8yrїO" ί෾y3??'Wh&ln0tAùxؼ7oҶ-{狀VVVNHn3s_5{yi OO~ ȼ9zItk4-\:7e&th/f7+8C\aTH-<-PBt}c0S~|vѴUBMBL9tXW*k[b =3`X ~eӐk]'WQIс|<ȍc1i\e J%FeRoKDyIYu(!N٧~/rrյW69{i V698l[o}_ڿ>cwuh}0jr&.-ih맑[2L XE@C~_dfK>fwqRWģzRAnVXtX'_/zFw~E/@P̨n I36>v*?Ir8h ,DP}jV*(X]Qd.ĺКUߑMum4YP+)5AY|(Ba~y|ڸnr~[u9^/mgl\ý[BӲy-~Sdq ={"=[ Y]]{ﾵXs:lRwg`%hųcI;\gtx?>#,_"M{ m5 Gfz1|_u׉O z ”kчr*%F>jU|X )qX$hB߯!1ٌ_ZuQ Ԏ3e#p`hSg<brtت O=җAD&Rpa4Ȋ:ob52MB$3JjaICa VU ,̜9V7c MLumen"$Hh`/_&q˛eÊE8y6naq/qC0e&d6X_iQrj?$٦ۆ"4# gZk> F7=j@_߂\Roeh(VA"bdĊ 2&3Mv.+H2'\ _Ų^Xe^(ӕb\qhI[6̿64+܁&&sP"|KSXug/kwҴSvor!cmjF7:l''}d2teyw_ڥ'2'8s. S3ʁK B'62(oCEދ@]),nB oS\%d2mUw^[cpi iޚ*Cs7*~8}~uoqð$>1\ڞafUB&V͕jX.$!Φc7 ٙ(&JUa%&-| LѬ=\ehBa|C+HJtH){ēa8i8/sR y)bltW5Ee1mѮ}O6T(3]Sȯ%M;W2S1 Ӟ=,Nv9{вyp*D`Fh)_ 9J)z3d{%n BC>+ļl=|[OQ9K|:"MO=V.1;q45opmhVa .- CEhwQD}4gK Rw+F=rjgBUO|K( WRCy0Jsh>,_Q >*IU./FKao ZCD*|Ŭiץ*Kr+#E/P_y;l}'/|LD>V5|':_!{p|JhQfo6L=O:x swpfeacQSx T[\ޡp5&$%"Qhsğ 6%G R4fr7q[|s4j5-'F$*3oܥD"!Oωz3 TMV Rg>-e%KYtuMyҐ 3_a&9J 6wyH8o)c^ }hغ橾Wi) dtmoV|eݑK0NY-%l}>_k;@KNݜ&ȖF Wq!K84w2,o.Jcr V뤓 cd˱c *|7>X )Ճn4lyji[6Jr1ؓDiT6^}NR1Ir~A3XfOX"gh5+h/>vv>JrH*b]SCY$4ѠY;g｣->ޫ*{i`$ 0,ٖZBR´d KBB {IHha@f=3+鄽s_W30LkU{/~i\E#g[(o;:r!LVh/aν+|{[)UZ׈:jj}a6boXQo,3u-Dl:b4}y>F$ ->րO} MOLRr:@R&m\j(Q&u!7]cc@QBr_#O /r)k-^ ӱ hbP-andèd40hbGkn,% ZhiF,*>'-o"}EV˴R$ZK # -bR4Wؚu\ R}jĜ$4+]V,D)MjKZٿSPڝH:DkCM? 6 +4SЊXh5BS)½2p7ѹssoBs*4V4;Iӈ&&mH1MZ*[jR Yh,--qwmkg]y)4*+w?j\1#AHWmf{8xj wN"@{o)"V<YH1pHtQE2$;T?܀yP,[;"MYfaVh3^b"/IwK-OS HRm%i 6 #,XЙ)gTeST2B)* JN%GxH '\BE ^rDv/LDAb6HAE;QpgDuBN$Bi갎߸IOp_7CJ} LFIT[1b4X[&&.bT`XZl6߻P~HL QBZ6Yg)D#oFR鱄2ܳ-88j@۩S-XD 'L悂a|V6D쿃q+Ov>2nUkY9;(Dhm lxشcwPh.J"d| TAh0i-k &bk|=ç蒶n˳B90FYo 8U\ !Eb2neV(eY_^EIӯxǣ^|k78Ԛ52PA 7ehiARo4{餼w֌乗O}";_-|3%eC/<&mCB_HouN*N^0Q! !%{Y`8}*.24siT d#ɥysU0)fa!1Pk, EB>C;ToQHG(8(B %,\Ȓ*5ȊT7l=!cj´RIJ\0N@HtQT4?ac*! ,8dA¬YmaQ-CǩBԟ{^K%/@N.M%Dјa&P_F{2MK7p\~wm@P5#pI޺y_tQ'O,*͊$IJaN4qӻ8jqTTm 'Hm½d f?`q'[GT$"w*8tmLU3^m/Om\Ot>LV"O>[Oby= lY@cR|4['jI]XCwĵuvB@tS*&Ed,AY.tKđ@*P*B%3#TW׫t:o 81 WgdeYRm+]VdOf!pk8gڿb:7%//d9K wěX-σtwSˠTiϠdzpכL'#F!Q"xZdG_>5Q^(NXy^86`J" Ś>u/RC@8X2.(\ &V IDATvg ZoNi7Nrp9:c>:e ~gH]2A7W1Q "̴(PBXmc]&꟱Ub2 4;e~?1s9FzilVdaT XCe##`Ҕh}tr>'LMD뿻%1>XE6bpqCܹ݊PoZʠ{mp(UZԛ; n3.VbAXtc4elm'&]WWUJߔlI@~4IMN_ HSk[׀]NxdmR IAjpD[pһ8rqnS ![̯n{jP:e(ހ,(\>Jgi?W ǵ~L慅7\a驿_A5{C؝ EAFs`4[I&Gd,N&ٱv#/ZG O! _9R ,7i!uIA:'hR"MTQ~H{ 2knz>7 qrZ <I}  h?2mO526l5k!aXPR*M4{RIS%.=FPnWYQL+R>ɾk6n?hv޿.3'J=mTd]e;a|;A(HxJь)~pD.q r s5đ8PFa>.ŀDciiN \[ qm&Am\aнC޾23uޗO;Ǽ߇v<\%]v-/%ᒺ[W${*N|EQv f ]$;*jz;G` rr5@|9AbZ ` eGO*5ֿD(AVA,kJebpy:5cv5}B B/3?~[]Y.0Hg 0ej6clp6V ͭof # L33bF4wzmz򹁉؟)@"2NY3]Zpv5w/Gc)5SwM+Jmj}A֦AXSone<,lCl2b4\_lN@I3u|˧".K<=UᑢJnŕ=BSAtRᔵ5f%+9!|i蝙q*G^ 9x sS?{qpkvv>?|Nһ\ TL),03AAHJ(*8nٖ٧Ȍ@I22:*o5 z͓U,)KFq))Ehf@(-Dd4@VN W`D<5 IYnS2[_(E4___E}i/m[_h2`2BK I@B2hXX H+i$xJHf?h/yba?Iqsm[[1<>s[PXL B(.#䢴+*؅]dq+|fWPk̹66/ԎfבeQxP:IM$C,?p _E(6'L :b}UjԤ :ȗ Fmn h> xYqoAQ)-TZH)QTXZ "z+T]{ؽ03CDvP.88q^b:M81ͮXk}ԖHi{PkҀKz[(Wwmj$;LǽsRzs QpqAV HwQ[>wzŔ4Sk]M,NX:'8C?xJTH9Ma8%':ogB~?=CT *r6r.N"تX(s@Vt?\dCxIѪ@7OOL ZKt-&B/M˼>E#f :j!`/ Zo|OJ[L䠼`Ht.+D7Y$P>nHMcC:|\5 ݫ5ZkSQ)Vf^@,I"HW2d*դ70"+|/d]p*(7 c"~0~0f6l\O#>a"})(i>T*si"I8T.xȭZrjJ>* pw|3u.|'<̮RmDɔEd:hDn7~$޳5w_wr͠{fJj}.M-L=FC۱[qFHw8|;<H@ c"𢤁?rdSRPO.o}m 8%Y2.N +[&$!>-(imyRI|)TvS?J7?27en*ƠgۤI[)'@t_oWVҪBD]ac0Dq,&0m!q[A61E7siYђE-zш#Uh9Ad7:BU}۞ o#NK!ԷS`нt=kأ*Zn2~@NnmbiWg#X>L7;. H[ݑa?'vVJyX鮠e}HAF!`^Q> -20$X^[d!v@8%֓?Ua,F'ks瓧tP_L[⸹D&U!)zma YAF;,NaF 5bAD/jK͟Ioik|pjk+_DS$T~$jAb:a' R8}h"_>vsᎾ&@W3lph'_*ilB 4 X.h Jj|zӔS>("GokVFN.Ȝ.ă3wQR\0րLQxGo gʡu 7xcc|\e"6Ԯ}|!_XV*FT>`:1pVm_A)u-h )Tvw"qtc80^w1HoJ`<&lC (׷R`~d=&DXYŰ{p34Z;Nh̠b;t'm(/Ѓ\. u/|jmD]B;p⛛*܏oCdHA@TBAMo+8GANIGoz*qJ'~'2ݏ"\:}$U[OpF8l 3,Fa5=G#EFvFocڧZ"(a2UɮOc/D@*MW`}A{ {05|xaZ :n!N_i. M& I$ة)aйMp5h.8_`4n۽%cvWA)(Nf ]2`'jr/(NiNI.8 sOyV琣̺oL37 GXy%^s22~E/ or !?~W0[j6<_ʬ\psfBBsԼJ>mm|&M LQm ϒ#}+ NJ &n\Ba*qg^?rНaF{!mFiSk?򩵏,< '=)?Du MIAu(K Ђ[9EO/v/nA_G6(&}JW\q^o Ƒ?@}|kCy\koPIpsU1ւإ6*=n!*R rJ-&(K]h,`62_&5RLJԗ&Ho((A L«02m0+l!Qe4+mSLÍ|D*qNҎ7Qe @ FfE8s#k3tg~4Mq"U";(FCƽ/2#E  ;H §ޏC2He~,!*]2܄ٗ6*%zm-zp!~Ǘ\@ >'"wNy9 azva._mB .N(NtT|spqH!p_'m^5V.}x.q3 zu7a噟&n: nb,a5)]c@lmYwU؞{zyMC1/0L 0o^?EkTv !.F)BΡKP^a~d5ATIad-B0PkaؿZ is!AI. =7[{bz&Bʔ~'/rrvP4(;,@h4!D|xR,+*D#_֤ dq_x-x-'mϠ)IU8D~huP `9p;jW%\*?AN}ج`lq~m)Vgs2SfK\haQ/\8g6P9ܹ2\2|/lR_zޥ-MԖDCƽ /n  /dT`kWb~zda_Pi /E9 Ĝ&Ֆto0 wbxZd_bzv<OQ2cw>|5~osRP0_F܄V>-$xI/,SM~dxxֽpC$KDWȘAVϑN3L;I/P qɺ`HfѪ-0t;ܜL%`TsmC$9Via]LWHTȕ$ɬk/,xTpӨ45.2YiJPm\ɨw(wLQ9yf֩03̲ BsiUC}{75q ϗp|Y D(D/mro Q9эHnHA54gC2~)p'ෟ }dq Q񪇘Яq^|Qeqm*40iӼ/U}V8H}'FaaVh68J' IDAT lilPʛ}lnNnx{7 !fkL:vc0sRJ0%:j/E&$[|81\&{K~P0\ M`1Rk6$Wp[RAsh] ޽6I=K~Ǘ)@ԎC9HF߁tQpFTÅ6'UHAq˻ON eq+@:D4 N&\ 2}'QڇwFlB 88Cѻ&vpJxHG )hp Kn W>։?Z0 gU ?*ev BJi'뤃Õa{n0m[-եionfe@k T@pkᷞsWX;ot2\=+S_>L#F3c.*8ϰs: }3ukgȄ. D\N\BQJP&Y6w1f<JJ8g}0 ݄~W @ h1 DU ѻ,;%^9) T (\ƣD$(7dt~y'oOi=/t>B _pfUZH:Y\0b!留Vt߫>FzލΙZ/ZRmau'{D9H5v}Ltzܞ %*Ld{:UCԠ sx%mSF˺| (ZkD8$ı.)>p8{?Rzv<VVNy>^ [F6I:.CsmI'5)h?ֈD)3fk(`YlBӒl(pK;h=&F2jz,xdmќ`u cUĭf 7yY/7 {݆sZ)p2bFg9!d2փ:RiiY[8CruA.bA^%8PogܿlT{C9˧?`_+V@ ~4v` YA *Ť ǫ=ߘ4)8niWN w~!1'4)hjGZO>C"3h,E&1Ү̭Džs|j.BWh!v[)|Èp'n(rrDh`+nqʦ o/p"pp 5[&\zV}Kxo=ncqV n[p즆=O.&!2wX 8DoLo1azW}|6m*Ʒz"p:$QIXUZ0JIg4Ahfs~/d~V[0#܍6vG h"!v3\&Qgs,n4*D{xAwCB:x(ehN rQ Q8xjG",$jMQU2w݄K#X+KϒNo^svQ"\z8~-[2Eʱp-c?JIdc{L:o L~^/>ȃiŧ<wF#\,ha$P[I&9!Ay+^+LRT0^! dk/Rk#4 HӞW\=r~W @ѥDrv9:âo㷞AFwH@ ^@3uWs2nٝA.9 O~ @į$C<: @]sn $V.ɬCOFE*^ya{ _Xۃ_E4L4 M9 0\ ^jI4b?Tq,*r?\jk?2#&BJs@}/d$T2x~W)ãvv0ŭC[t`RW;S=H{9]^%]<`Djz7JQB ۈ{oL_ 4TckbdM@(*;'/(5u"M%/@8am #3Nk;(Wv3uTn1ĜuC?lPkc6^c< \pc}*k دU+  4 zȈ}4Hm z%'$WwG8-mcz7 7U0[&BjGp*,jLl|`8Ƈy|{.Jϒ$|03CLW e`+( 7lRiiдw _> ꛥA =9GɣڋvG ]޹R*6ڜ=+~Whkm+~^g6'UiRP*{ ϑ &ɢ`[N $ -q´ī-BFk$KS> p!J̷=k4p ~e­OngA7j(JLzT>A\pT2*p:{[%u3aMVvPdܻlٖh+KTZohY3׃6 Yl} /+gG9:O`3RP48>B5)Y`ڇтV%h=WlC׏u_%_ 6`4ZGFduWS~LMr/hMHgkF ;*"N>fD[鬋{$.I 6%/5&ʍUFs$Qڳ?APJQ ]$ sDwykN@ thu^e!A&=4L{!=W7-)Q$*{LZlG8!8~/k P2FSd4cX]ѻ qYv)lp.AirD!`7L;p\p Ad:eԽLtcWI`SlDm rʻ5)hxzsRPiAJ[^"%Z&P@7>|gW&*627}LɛʔGA$ ?6UZNs$貂֜ p)MF3MEtPPT2'vQ$yh:x~״?mxh O &q㋫ 8^e/߻)踦d|qxLjohO_t|dt1K}!#zܿ}(d}u.U+@R9]L{g&y;"+tp@(5 8D4 ] Fud`)Q.p3, o7l|]qr@@)?6`9vC 9)(X&\ k|А~>gnhc.nU>xtg 6$5MBEIWށWމR16iS\)V Hf}sYp !D}&3H7§:ㄌ =yQ[H؋6uφ`0y\l?6@_@ 6c8._qL7%&h=I}dxzpiYMZ ǫUwJiAd<`yOJaҁnP[xA oP$tnlzq^&u>/&\zxIUa{z\2;>'@8iP2Fɘ4*B)5-9IЬi i)-)GVN̺FWa}'*޹ 3jkUfÛ qY{7;sZwо _v|]|aD;D)W5?L*\!\)mN r8fk@4#gkD7g >aŠ]1)=r @*q2Y-ʭ&w2V~R(22N@HSpBʭ`}O u\;V=w|]|ho|OW{q'-=O: @T=n? h?0{p8neQ瓤Z p ^uNL:F2{..bC.v oWv+hhtx֥X7B0(5 1] egjC}hrhp3b/Sn%Mƌ{2@ջ{yw gE%Qd+NvZ6-EEEP @/wIv!N,$ҴڴEi;X%Ғp}}]|޹CޢCbw˙/Ug;B`n9uY@TM>GMA/u/4M>OZo@]>SrHu`+ƣҹն,dnoUBEu$an@kG(iHz;Pk& No4a3Ȏ64^in,A;8yٗG>ȂE07sl( R7E27۬cDyT* KәI柚k.՟&Z' ؑ-!$ƊA榛s9Ba%,\$Zlr}eyt[g 4#_;Ս]XAoW|1*-sObnEgG&>y gq*G,6g)hq֯m:^#lo @ez:&7c39Vl4@xGpǎ0\2 |NIvAw~r:E]sJk~ŌA]@]$}FDkdҞҝ~+8~$`ۖl/n8J9D7-Jїuf&)0G>Gt_Q?2~I[qMAGq > 4#;6'/T|}[Aᖐpm>x6[k"^A8hDV `qvqnh\8q Vs4 zR s}3h3;| |U= T@ED 8㙣C"y噙ی'sǟ% p;(+-,hY&c: l\!jJ|iRx8ܠ>N]}yGv_\rpH6>Oi[eroYsOU_Y>n8;ޕP mIފkW!_%\ʍGGXxc*SZo=7U7#jHpmF@?[;25\@5>5CKL#,/qѸmjEO-])t.DMӎ0b*' t.Gs >g Aқ T@]o5ѼpF* M~7OvjK)ĩBY>Q2` FG|;r8I>t%X ,tlNߏ_;$;htm~v~.I znE90s?ØS/v\6^)4/v4Qvٔ&[3*@&FGiŲ=3ܪ@)8hĽk$ $z1߃_!/o})q~T<Мz^KJ6 HD^l<7t& rϑDk'w 쒙 Qv)7XvGo~{qنIDATTXT°5)_AYitd6ïު}Aϫ"yHE֚5@:s*jO ol! {2 Io1,N9K_{O]*3ވ0g]F* zG`@:~\YpǏn\$Z?A\%ep+Eb+>;Vkc=?AB.en(CSZm*=S9։6 w `\oYY5@N:JtAx\wW7Qzv!v1KLyL]_Ƕ[MV?O *@Br|ObrLă6"8X_kW/EC@* >lRppaS%: :uJA\bYe,$IFzW}N]*3 "Hxm%FN|$[slcpjUX;aʅ`y;PA¼ y^1f²d;W^[{/22f.X ՘ǧ{`qg>Xj\sG|tNcJ{?$ÅT;esc>TwZCgvYi;\]uX 6m_ymG  9i ,35 ܄$%LG""=Cmh? on$mN '@.%瘋_ym)i8Ɩ4Ə6׼ޟHj *@0I-+                    ?_kIENDB`tomboy-ng_0.34-1/glyphs/icons/hicolor/24x24/0000755000175000017500000000000014145033507020260 5ustar dbannondbannontomboy-ng_0.34-1/glyphs/icons/hicolor/24x24/apps/0000755000175000017500000000000014145033507021223 5ustar dbannondbannontomboy-ng_0.34-1/glyphs/icons/hicolor/24x24/apps/tomboy-ng.png0000644000175000017500000000423314145033507023646 0ustar dbannondbannonPNG  IHDRw=PLTE۶mmmIII$$$mI$mI$mmII$$mI$۶mmII$$mmII$$۶mmmIII$$ےmmIIm$$mmII$$mmII$$II$$$$۶۶mmImI$I$ےmmII$m$mmII$$mmII$$II$$$$ےmmIIm$$ImmII$$mmmII$$mmII$$II$$$$۶mmmIII$ےmImm$mI$mI$I$$۶۶mmImI$Iے۶mIm$mm۶I$mI۶$I$$ےmImm$IImI$mmmI$mI$I$$۶۶mmImI$I$ےmmII$m$ےmImm$II$mIm$Im$۶ےmmII$m$ImmII$$mmIm$Im$ImIm$I$mے۶mIm$mII$mےIm$Im$ےmmIIm$$ImmII$$mےmImImI*VIDATHݖ[]e_k=vLH iZB@jXEi4&HK%V. A . X 0=jK0ٳ3}k^Cr/yߛ/.[kX{^kwvfa{LZ!=|pZl<>y՟>dmSn&s]]*t=%6}v̟ L JܚBuJX] oOɁo=J[<ӿB98 F/V[)r}ˈSPes%K;Nk5lWBĞp$oݹZcWᦥzW~kg7 fZI?M# Fo"xyV-$@HZq?ZlBcg?ҸA$L#$$ PBcWbg:tzs\t1BП 3N[w*_{GG8_ySw$ZHH&t؀׻q_e82dҥ^oj/wQU<5=?s"+Rm+ NKi/6zͻ %z{׫ONn--*!~$qA4=}4޹?Ik;; *-ctW'{~8>r=}Aw#W=׼bpy4Jd۟UnCZdԃ+IENDB`tomboy-ng_0.34-1/glyphs/icons/hicolor/48x48/0000755000175000017500000000000014145033507020274 5ustar dbannondbannontomboy-ng_0.34-1/glyphs/icons/hicolor/48x48/apps/0000755000175000017500000000000014145033507021237 5ustar dbannondbannontomboy-ng_0.34-1/glyphs/icons/hicolor/48x48/apps/tomboy-ng.png0000644000175000017500000003447514145033507023675 0ustar dbannondbannonPNG  IHDR00WiTXtXML:com.adobe.xmp 7)%iCCPxypd_sRGB default i1 DisplayPro, ColorMunki Display _[2018-11-14_18 35]x| |En䂈CAɵ אf# *n1$ $ 23:ㆢ>:긏Ό "2#n(﫮S`IUN:ۚڻz>vix!ޮhlS\SS%? st+6涷B~f"?[pf|'~t7vOzK[:\R^_yzOڱ'?/efeFܶn5K[5.tutVΝ}t TEaXP<:u7[˫&y<Z^7k .^ux / ^% jhPyZR^_"/52̓W7uY:sVw/linimSR\̇ow\VRY|ZgnwK_>??٠-+&tt 8/-d}7kgVb߸}}z{oWv׫v=yoMA4s%Ia7 1]=}k^~/ݫWGszs>=7}P{3O]gE}+k7culvf (*~]n~߱ggs~nAo؀ 8u[[ŚAG za˽}N/jVg3dPo识ohܵm 1.~0cDX_,Y: j ޿QcG}.ͻ'cv؉}{71>:Xʖ+¨5*'(G~!{ ػ>/W? ޾/kz] n77o};[|sП=裏/~O_%]/^^mo<_/jY~yՊcV^ѣ|+ל~-֯˒r2٘~]3ecPEяXndbp={z{#޾uN8dAi{Y'UL.-gu@X1U[WUv'K^z.>薃ov!za~4}ٍL?KZq̻g=;'۟dSs9οvqs;-=>8q/?:Ӆ9S<},urgת=}_r궵'=]ۧ{_})oqW\?D4fS;`Əv#s#vzŝuv9gǴvvsآ/1 b)-:0OU[zw|ny=sgOh*9l➓}_}吪}Y3w^v#{?mӇ͙zdzF9]c.{aE%Kwl h+*wu5Y뾽޸{<薑X}kmn?shw]uKnOw?caOt3㟝皞{^z_Yg}~o }sǿ+ޙnҩ/~JWpG_}?]jg'}޴kYc֖=믾˷W~^rgQPUE۠|q'[:`V[fE^b;5Ž#o7'=jCvucG>l/Z_#2谸\ R0=ɽ}D%5e|INPޫWg).;qK>?dC8l~<#lȏWN_Ѵye˧3G:w[>tl61A]Cǎ?vAp\|'/4ma㯎:O=OEg^ߝuwso> ^{K޿te/_~ŲE]eW/fŵ?aՍ_ܴ?ݒ?θ.;zq;~OV?&>^DÓmO\?? ǗzM|oGfOi#g@˼%W<,ʱ} _,0NSBǑ2@ Üu^\/a> >@X  .1k gp epP\BDBepDB L c8AY$ sLEȌ~#X$/ǿWy簛scXR&jiJ9xQd{"66 &\(}I=-$#"aMXP!c3Aa BBC3> TZtes >gy-LQ 1q3gR03\caOd^r!1iδc2K'1U |,C qCJp8LYd/B!Vb E!pGb(y`9# "4.j0B$g}9Ƈ=ܫ$2BcYJ_wmB't!05ĒFHF+84> b"x&h,0UQ s=+/bB cT&r4ˇaO`l}W*Iɜ9:#=@<z)ilPzE0\ pl!1󑎸Ql;$7 I2-9Ø.mԲƥ7f?F :j nhf_4/: /j~QIMx"(H00! 7/:WNllom[ȉ-ӑA6Y j%6A *I~D(ސE`Lt8Tah4(+ #}C<*k]S:dBn FIFPha!jD`dX45X"$E]t1N",d fV+Iڍ-DDxXP0%iaq@CR&8&&X"Pҁ'0LE"Ahl1CY cP+I.^Jm%Aaĭw0:$HTlm0Y#$]%]4 0IH,\dnl'#,R _Z]c} ˆ$5!&n-hKw]]x"+ҕbuep1Ft>@EAi$(+RAsMa:6naIWZ]mVFh$rI>ǬX]aVJ 3Ods8] O!AtR B8;6)d"0lҩviZi$X`j;Me;P.Vf9 Gu0Ս~H7'IW-`*AlH׬L9wq7,LNjRՕhҕI46i#vR-. +*ENAf-vPA8IצD :CIMcJ#Bl6$.¤tnaP S@2qgco۔yna8r`Du2IʼnnaZ5&] BP1!2tU9ݔ ";)"GnaxF8ȓKKīyax AZC&f,Nsv3Ψ,z ҁk70(-!wpK2 ]w I70@SLG4*:0|7be;M9 n&uUHk(0-R]:fF z渃*tk(0&m)-!J ÀޅxٖkqݔF@)397q Ƅ7%US@5Ť9]BD)Tm"jj8T EaCN&Ff ʭ!@A)Lir)C[o"0x3IT/Da4- &fߌ-FEaD8L%(&EaXI9x8 挹ěuna=3.GFsqۨ0H[70BROmr3gdr*2 89_tx}8 fAEcuAVd4U9s#!na6Rz8ݔ`2snzaNrda.*P(q(1wpQD$8L"S( छr(D)sQcKGAB]Dna,$Dΐ P9"ݔD&3cZ@b"{3r y݌Dfza2L=#HfQT/na"M!k709ո-70Ec("bM9LdҮ rm8L?w< !Qa"D8p]Qa0؅D1Kq$tb{p-y\)17L8bq0AEna"mqBE1qЅBKna5%1BF RN{(0MNΨI2F9@QPk殜)1!q3a>Az ͞tS4LK!ʼqabs~`!ak!T:ݔLTB6v]1w0gSt< P3cR,a<-8L, '%hEq4Mt809!$kZAСS;JqiOS%3br86'qPQ}Q"ݔ&ǑkIc8 2t);5 80b C"0D"tZC_ mItSc?D]D(~rqX#t 䳌 J*ؖݦ80xjѠIi Airsb%Øe6Q!<)3P3qZqn,$AˌÀ2rҨq\fFJ(wVM9d2`!OMq87r <"z IٛqHs>Z0H70>wӂ& ˌØ}/66^Qxda$足4-sriuS#zCR?M9 vK3;h[݌è MrqA\'ׂ scS1;cd:ݔ(B%<⤛r${Lge.e q͐Zjj>J|ReF2;*' M92G4x8V7B'sOqlݳ|e݆A"ihE9)8yD|.;8aS] H70:9K#t݌`ҙ`}Py8Fr6naGU@ʩhzZm{ c%)n.@:?J:1E`3B_[4 D{5ش(x8 *Kޤ9tә8?ps!6'tS\ w^fd:0=ØM.N53cr6ata ( _rX41-n1^n٧wfw=%inmroNVo p]뭸Q:pq5`gmH39T^躄/|6ץt=w^Hq-!k_gm}߶0kfpmo67 A./|K@`Wi7̷ۛ@f\'`{_z}^N?~ڳ9m^jy cpOM {xɷǴz2+o/* *z\ bΛWUxϼS$qg CVI7)'{ &WBfZof& o5f/"cߑ|#NixVjvFҒx#H)ZcvWmԖ[E6Of&-k=*M/ 4ed17{x@uX)}caϱ,zc :?tҢOmh<̆pd̝I'>l=.W&Mh#qfCfҔk3?CvUmN5XhխlH:1OcH%F=G+f̯InG6+ kJ"+S ͬVSI?S^c^w2ffO׮&n;ixa춫9oЅ;5%v4QOӁS035YռYՔ~gUY#lؾz"FՌq81=ƷܓOօ=f]ԏLz2OnC% ͖$D,`WQy4fǠ&nI:"g91w{[1scT s޺ pHYs%%IR$ IDAThk]WuksglcĉcCw+J&5*DQhiIheBTL)T@@C"hK"$A<̝8W?s$j?4˽=_}^\/KySCie_qzˁHP?=ε1_RٵG8 ӹoµ^lfMbUH`>PzO^n@5WSw|Z{筷޺6rM;ծO@3@S'O͛S|[W|Qdvx=Y-uvpn6iKoi=y&n >˃ hRr0Dse,mUnc?ovN\XT̥sYF+·Ԧll|6[at˩5v9G}Vh8pwŻuy˫_]˒tfl߭A~C^{3tㄑ2QCw+>ݕֿ4!&nn:0"EEOkūo?6.BiWׅoi\of jm[r3ٶɦM*# ?Re`JVږ+hl[dP+g&{G?{ 'sv67̲L.rnaq1]0gdr=gm )TKgmnb2J'EiT]jLO=Թ8piT3:͚IVm%wmfۉGbʵ;8uA(X\Xڑ:/z~: /x' YAΝcMZ 0DP\^ +S4wؠPYݳtvdi=kkm.Ma@S-#jQp煰}~KLnjAUګ4wBqmd0KϚqz[ aޱ[l'}ֻ0O-$eܤ\!@HBkHhc[Yi\FXZx͵."2-XZ^Dm_:DL1;Ҽ\CڕwQk:l@3DTJFxBlfIӌ$MIc-[9>"IkC\:f4qJFƮ6#uO &<.Zl޳_Znj~C]]k}FG+~{5&F$"Ԅ eT ΃s:4!MzT|@%(KbqjM6 #Mu+HQJG.P%1~ћ0Ai6gDa{Ѽ|0 0$ < Bxzdg=xa~~ZƥP¼a?#đ?C> ")!!&$HvzQ>U!v1!`˜+Jt.A)ѬCTVe0Z " pf%T ƛu֖S?eb[ :HRAL1UrK~h_EPEL)o Se vJp <s8i,MlFFNV!Bg[=^2P4C}/P:,-blMgK:ДŨ:6*)d-_"9c( $yUgE 0611ф8Cy+DGMYMVg|#eO0gl7EBH a\׈*&"TΓ1s=OoCDYx^@ɺ'yGӞ턔w?{ԶڼqԂa7H!E$fUpVсSd;͊)]6poqXCH9v⽥*fA 4zQZ?NNw^EK¬e%ƃDTa Y9y[%لӧ\nT Z% ,/_B}jWٚ|( P5}(24eS :6iIn/8t1u%:1i!}jy * ?̞Ba]uuLuVa-)s"iC#"g1$k/_c]#F~ B}q\Rjl}p6ͭ{0S_rLu&zO#>As3<7آdrNy)k4"0#15"oƀixAPo-j;D-Dַ"KP3 Aa*Sx ;>Jap:#,wxiz|حs@k5;1g>(6% n8+y8E!C}~ POcv,l {יE]񽄥z>AcyKQ՜\ͅC]^~O|"^~>،'z$W jT_MQK /hS,uc`e:CmFJr7ObmZ$~Tt*]>r-,u9|ԁ+8fd'lWB bl?E2:wC\x+8kpSpB 簦jP8a wGr'C3:l6Kҷ\ۏo``T 1qc;z+|B`U:ŴsZW9szZN>]Yslڎ*y\yȯ aҦ wCzV U4XnIm2 =*Jݫ{uSr~hfg38כg^Os1ŘBR*Y4&Ixجhx6Qͯxz>[~#5o;4x\qgqi)U~WsD'(ؐI+8K6 xΣcRZ JwoR9ae?>}:C3j  T'o.ldx ἠޓZ=lYs{׮ݣO2?uP?ox. \ u`R=8Zs`|St|$3}_Y6k6q^\otAbx IENDB`tomboy-ng_0.34-1/glyphs/icons/hicolor/16x16/0000755000175000017500000000000014145033507020262 5ustar dbannondbannontomboy-ng_0.34-1/glyphs/icons/hicolor/16x16/apps/0000755000175000017500000000000014145033507021225 5ustar dbannondbannontomboy-ng_0.34-1/glyphs/icons/hicolor/16x16/apps/tomboy-ng.png0000644000175000017500000002675214145033507023662 0ustar dbannondbannonPNG  IHDRaiTXtXML:com.adobe.xmp 0K%iCCPxypd_sRGB default i1 DisplayPro, ColorMunki Display _[2018-11-14_18 35]x| |En䂈CAɵ אf# *n1$ $ 23:ㆢ>:긏Ό "2#n(﫮S`IUN:ۚڻz>vix!ޮhlS\SS%? st+6涷B~f"?[pf|'~t7vOzK[:\R^_yzOڱ'?/efeFܶn5K[5.tutVΝ}t TEaXP<:u7[˫&y<Z^7k .^ux / ^% jhPyZR^_"/52̓W7uY:sVw/linimSR\̇ow\VRY|ZgnwK_>??٠-+&tt 8/-d}7kgVb߸}}z{oWv׫v=yoMA4s%Ia7 1]=}k^~/ݫWGszs>=7}P{3O]gE}+k7culvf (*~]n~߱ggs~nAo؀ 8u[[ŚAG za˽}N/jVg3dPo识ohܵm 1.~0cDX_,Y: j ޿QcG}.ͻ'cv؉}{71>:Xʖ+¨5*'(G~!{ ػ>/W? ޾/kz] n77o};[|sП=裏/~O_%]/^^mo<_/jY~yՊcV^ѣ|+ל~-֯˒r2٘~]3ecPEяXndbp={z{#޾uN8dAi{Y'UL.-gu@X1U[WUv'K^z.>薃ov!za~4}ٍL?KZq̻g=;'۟dSs9οvqs;-=>8q/?:Ӆ9S<},urgת=}_r궵'=]ۧ{_})oqW\?D4fS;`Əv#s#vzŝuv9gǴvvsآ/1 b)-:0OU[zw|ny=sgOh*9l➓}_}吪}Y3w^v#{?mӇ͙zdzF9]c.{aE%Kwl h+*wu5Y뾽޸{<薑X}kmn?shw]uKnOw?caOt3㟝皞{^z_Yg}~o }sǿ+ޙnҩ/~JWpG_}?]jg'}޴kYc֖=믾˷W~^rgQPUE۠|q'[:`V[fE^b;5Ž#o7'=jCvucG>l/Z_#2谸\ R0=ɽ}D%5e|INPޫWg).;qK>?dC8l~<#lȏWN_Ѵye˧3G:w[>tl61A]Cǎ?vAp\|'/4ma㯎:O=OEg^ߝuwso> ^{K޿te/_~ŲE]eW/fŵ?aՍ_ܴ?ݒ?θ.;zq;~OV?&>^DÓmO\?? ǗzM|oGfOi#g@˼%W<,ʱ} _,0NSBǑ2@ Üu^\/a> >@X  .1k gp epP\BDBepDB L c8AY$ sLEȌ~#X$/ǿWy簛scXR&jiJ9xQd{"66 &\(}I=-$#"aMXP!c3Aa BBC3> TZtes >gy-LQ 1q3gR03\caOd^r!1iδc2K'1U |,C qCJp8LYd/B!Vb E!pGb(y`9# "4.j0B$g}9Ƈ=ܫ$2BcYJ_wmB't!05ĒFHF+84> b"x&h,0UQ s=+/bB cT&r4ˇaO`l}W*Iɜ9:#=@<z)ilPzE0\ pl!1󑎸Ql;$7 I2-9Ø.mԲƥ7f?F :j nhf_4/: /j~QIMx"(H00! 7/:WNllom[ȉ-ӑA6Y j%6A *I~D(ސE`Lt8Tah4(+ #}C<*k]S:dBn FIFPha!jD`dX45X"$E]t1N",d fV+Iڍ-DDxXP0%iaq@CR&8&&X"Pҁ'0LE"Ahl1CY cP+I.^Jm%Aaĭw0:$HTlm0Y#$]%]4 0IH,\dnl'#,R _Z]c} ˆ$5!&n-hKw]]x"+ҕbuep1Ft>@EAi$(+RAsMa:6naIWZ]mVFh$rI>ǬX]aVJ 3Ods8] O!AtR B8;6)d"0lҩviZi$X`j;Me;P.Vf9 Gu0Ս~H7'IW-`*AlH׬L9wq7,LNjRՕhҕI46i#vR-. +*ENAf-vPA8IצD :CIMcJ#Bl6$.¤tnaP S@2qgco۔yna8r`Du2IʼnnaZ5&] BP1!2tU9ݔ ";)"GnaxF8ȓKKīyax AZC&f,Nsv3Ψ,z ҁk70(-!wpK2 ]w I70@SLG4*:0|7be;M9 n&uUHk(0-R]:fF z渃*tk(0&m)-!J ÀޅxٖkqݔF@)397q Ƅ7%US@5Ť9]BD)Tm"jj8T EaCN&Ff ʭ!@A)Lir)C[o"0x3IT/Da4- &fߌ-FEaD8L%(&EaXI9x8 挹ěuna=3.GFsqۨ0H[70BROmr3gdr*2 89_tx}8 fAEcuAVd4U9s#!na6Rz8ݔ`2snzaNrda.*P(q(1wpQD$8L"S( छr(D)sQcKGAB]Dna,$Dΐ P9"ݔD&3cZ@b"{3r y݌Dfza2L=#HfQT/na"M!k709ո-70Ec("bM9LdҮ rm8L?w< !Qa"D8p]Qa0؅D1Kq$tb{p-y\)17L8bq0AEna"mqBE1qЅBKna5%1BF RN{(0MNΨI2F9@QPk殜)1!q3a>Az ͞tS4LK!ʼqabs~`!ak!T:ݔLTB6v]1w0gSt< P3cR,a<-8L, '%hEq4Mt809!$kZAСS;JqiOS%3br86'qPQ}Q"ݔ&ǑkIc8 2t);5 80b C"0D"tZC_ mItSc?D]D(~rqX#t 䳌 J*ؖݦ80xjѠIi Airsb%Øe6Q!<)3P3qZqn,$AˌÀ2rҨq\fFJ(wVM9d2`!OMq87r <"z IٛqHs>Z0H70>wӂ& ˌØ}/66^Qxda$足4-sriuS#zCR?M9 vK3;h[݌è MrqA\'ׂ scS1;cd:ݔ(B%<⤛r${Lge.e q͐Zjj>J|ReF2;*' M92G4x8V7B'sOqlݳ|e݆A"ihE9)8yD|.;8aS] H70:9K#t݌`ҙ`}Py8Fr6naGU@ʩhzZm{ c%)n.@:?J:1E`3B_[4 D{5ش(x8 *Kޤ9tә8?ps!6'tS\ w^fd:0=ØM.N53cr6ata ( _rX41-n1^n٧wfw=%inmroNVo p]뭸Q:pq5`gmH39T^躄/|6ץt=w^Hq-!k_gm}߶0kfpmo67 A./|K@`Wi7̷ۛ@f\'`{_z}^N?~ڳ9m^jy cpOM {xɷǴz2+o/* *z\ bΛWUxϼS$qg CVI7)'{ &WBfZof& o5f/"cߑ|#NixVjvFҒx#H)ZcvWmԖ[E6Of&-k=*M/ 4ed17{x@uX)}caϱ,zc :?tҢOmh<̆pd̝I'>l=.W&Mh#qfCfҔk3?CvUmN5XhխlH:1OcH%F=G+f̯InG6+ kJ"+S ͬVSI?S^c^w2ffO׮&n;ixa춫9oЅ;5%v4QOӁS035YռYՔ~gUY#lؾz"FՌq81=ƷܓOօ=f]ԏLz2OnC% ͖$D,`WQy4fǠ&nI:"g91w{[1scT s޺ pHYs  IDAT8;hQϽw}>I4YE ""X`a b!&6(Zh `P$(qqlv73s*SCwwh':Ꭰpטni|xA ~F}͍+ƍWA7wh-}ӫU 3EdW%a/0mdZΜu+? treɽjM0A]jpk%c}&ui {kF!C*%`6t $k7IU:3q&@b.ƦZbSG[ar*2"޼ VzԽ%OZ۶3$dB1/$HUAr*T=clYt}3 '0M#y'䳚?fjlfY6B\0Dj-&@ Pi"n]kݙM6 c' l D`$I², >0~aY߭kga62CF?HBjI!&pF+rHP_J#GJV]l.4E PK۩T~#~<mK%[[)-n8;1+VFrq}v~)&b;o'}\#v^IENDB`tomboy-ng_0.34-1/glyphs/icons/hicolor/32x32/0000755000175000017500000000000014145033507020256 5ustar dbannondbannontomboy-ng_0.34-1/glyphs/icons/hicolor/32x32/apps/0000755000175000017500000000000014145033507021221 5ustar dbannondbannontomboy-ng_0.34-1/glyphs/icons/hicolor/32x32/apps/tomboy-ng.png0000644000175000017500000003127614145033507023653 0ustar dbannondbannonPNG  IHDR szziTXtXML:com.adobe.xmp I3O%iCCPxypd_sRGB default i1 DisplayPro, ColorMunki Display _[2018-11-14_18 35]x| |En䂈CAɵ אf# *n1$ $ 23:ㆢ>:긏Ό "2#n(﫮S`IUN:ۚڻz>vix!ޮhlS\SS%? st+6涷B~f"?[pf|'~t7vOzK[:\R^_yzOڱ'?/efeFܶn5K[5.tutVΝ}t TEaXP<:u7[˫&y<Z^7k .^ux / ^% jhPyZR^_"/52̓W7uY:sVw/linimSR\̇ow\VRY|ZgnwK_>??٠-+&tt 8/-d}7kgVb߸}}z{oWv׫v=yoMA4s%Ia7 1]=}k^~/ݫWGszs>=7}P{3O]gE}+k7culvf (*~]n~߱ggs~nAo؀ 8u[[ŚAG za˽}N/jVg3dPo识ohܵm 1.~0cDX_,Y: j ޿QcG}.ͻ'cv؉}{71>:Xʖ+¨5*'(G~!{ ػ>/W? ޾/kz] n77o};[|sП=裏/~O_%]/^^mo<_/jY~yՊcV^ѣ|+ל~-֯˒r2٘~]3ecPEяXndbp={z{#޾uN8dAi{Y'UL.-gu@X1U[WUv'K^z.>薃ov!za~4}ٍL?KZq̻g=;'۟dSs9οvqs;-=>8q/?:Ӆ9S<},urgת=}_r궵'=]ۧ{_})oqW\?D4fS;`Əv#s#vzŝuv9gǴvvsآ/1 b)-:0OU[zw|ny=sgOh*9l➓}_}吪}Y3w^v#{?mӇ͙zdzF9]c.{aE%Kwl h+*wu5Y뾽޸{<薑X}kmn?shw]uKnOw?caOt3㟝皞{^z_Yg}~o }sǿ+ޙnҩ/~JWpG_}?]jg'}޴kYc֖=믾˷W~^rgQPUE۠|q'[:`V[fE^b;5Ž#o7'=jCvucG>l/Z_#2谸\ R0=ɽ}D%5e|INPޫWg).;qK>?dC8l~<#lȏWN_Ѵye˧3G:w[>tl61A]Cǎ?vAp\|'/4ma㯎:O=OEg^ߝuwso> ^{K޿te/_~ŲE]eW/fŵ?aՍ_ܴ?ݒ?θ.;zq;~OV?&>^DÓmO\?? ǗzM|oGfOi#g@˼%W<,ʱ} _,0NSBǑ2@ Üu^\/a> >@X  .1k gp epP\BDBepDB L c8AY$ sLEȌ~#X$/ǿWy簛scXR&jiJ9xQd{"66 &\(}I=-$#"aMXP!c3Aa BBC3> TZtes >gy-LQ 1q3gR03\caOd^r!1iδc2K'1U |,C qCJp8LYd/B!Vb E!pGb(y`9# "4.j0B$g}9Ƈ=ܫ$2BcYJ_wmB't!05ĒFHF+84> b"x&h,0UQ s=+/bB cT&r4ˇaO`l}W*Iɜ9:#=@<z)ilPzE0\ pl!1󑎸Ql;$7 I2-9Ø.mԲƥ7f?F :j nhf_4/: /j~QIMx"(H00! 7/:WNllom[ȉ-ӑA6Y j%6A *I~D(ސE`Lt8Tah4(+ #}C<*k]S:dBn FIFPha!jD`dX45X"$E]t1N",d fV+Iڍ-DDxXP0%iaq@CR&8&&X"Pҁ'0LE"Ahl1CY cP+I.^Jm%Aaĭw0:$HTlm0Y#$]%]4 0IH,\dnl'#,R _Z]c} ˆ$5!&n-hKw]]x"+ҕbuep1Ft>@EAi$(+RAsMa:6naIWZ]mVFh$rI>ǬX]aVJ 3Ods8] O!AtR B8;6)d"0lҩviZi$X`j;Me;P.Vf9 Gu0Ս~H7'IW-`*AlH׬L9wq7,LNjRՕhҕI46i#vR-. +*ENAf-vPA8IצD :CIMcJ#Bl6$.¤tnaP S@2qgco۔yna8r`Du2IʼnnaZ5&] BP1!2tU9ݔ ";)"GnaxF8ȓKKīyax AZC&f,Nsv3Ψ,z ҁk70(-!wpK2 ]w I70@SLG4*:0|7be;M9 n&uUHk(0-R]:fF z渃*tk(0&m)-!J ÀޅxٖkqݔF@)397q Ƅ7%US@5Ť9]BD)Tm"jj8T EaCN&Ff ʭ!@A)Lir)C[o"0x3IT/Da4- &fߌ-FEaD8L%(&EaXI9x8 挹ěuna=3.GFsqۨ0H[70BROmr3gdr*2 89_tx}8 fAEcuAVd4U9s#!na6Rz8ݔ`2snzaNrda.*P(q(1wpQD$8L"S( छr(D)sQcKGAB]Dna,$Dΐ P9"ݔD&3cZ@b"{3r y݌Dfza2L=#HfQT/na"M!k709ո-70Ec("bM9LdҮ rm8L?w< !Qa"D8p]Qa0؅D1Kq$tb{p-y\)17L8bq0AEna"mqBE1qЅBKna5%1BF RN{(0MNΨI2F9@QPk殜)1!q3a>Az ͞tS4LK!ʼqabs~`!ak!T:ݔLTB6v]1w0gSt< P3cR,a<-8L, '%hEq4Mt809!$kZAСS;JqiOS%3br86'qPQ}Q"ݔ&ǑkIc8 2t);5 80b C"0D"tZC_ mItSc?D]D(~rqX#t 䳌 J*ؖݦ80xjѠIi Airsb%Øe6Q!<)3P3qZqn,$AˌÀ2rҨq\fFJ(wVM9d2`!OMq87r <"z IٛqHs>Z0H70>wӂ& ˌØ}/66^Qxda$足4-sriuS#zCR?M9 vK3;h[݌è MrqA\'ׂ scS1;cd:ݔ(B%<⤛r${Lge.e q͐Zjj>J|ReF2;*' M92G4x8V7B'sOqlݳ|e݆A"ihE9)8yD|.;8aS] H70:9K#t݌`ҙ`}Py8Fr6naGU@ʩhzZm{ c%)n.@:?J:1E`3B_[4 D{5ش(x8 *Kޤ9tә8?ps!6'tS\ w^fd:0=ØM.N53cr6ata ( _rX41-n1^n٧wfw=%inmroNVo p]뭸Q:pq5`gmH39T^躄/|6ץt=w^Hq-!k_gm}߶0kfpmo67 A./|K@`Wi7̷ۛ@f\'`{_z}^N?~ڳ9m^jy cpOM {xɷǴz2+o/* *z\ bΛWUxϼS$qg CVI7)'{ &WBfZof& o5f/"cߑ|#NixVjvFҒx#H)ZcvWmԖ[E6Of&-k=*M/ 4ed17{x@uX)}caϱ,zc :?tҢOmh<̆pd̝I'>l=.W&Mh#qfCfҔk3?CvUmN5XhխlH:1OcH%F=G+f̯InG6+ kJ"+S ͬVSI?S^c^w2ffO׮&n;ixa춫9oЅ;5%v4QOӁS035YռYՔ~gUY#lؾz"FՌq81=ƷܓOօ=f]ԏLz2OnC% ͖$D,`WQy4fǠ&nI:"g91w{[1scT s޺ pHYs%%IR$IDATXm\e/3v}e BhbSw &5H01aMlDk YbBBT&bQHLQTJܹ3s};] BA/wr39o*puO^{s}-Hg&?fS|[6ha6>bM#{ج~nkK=YMf~@vQE&pFxO7^eÛF;iMw{ß m\F]?m \'Leͥ <t׿GCm[ZAĊZK#{F3"eԒ$)xjJF*x}``ZS)3S\U> >b ` LUsEGjsS6h{fݐҌo^2`tSKSXMjb|0c<5agZ^.1 , EHSS^q#hy7?0`P^>LedQԁAPupY(/j0]uYn¶Ճn I1Jxhu+Ϋ4_}q_<+c9KAS2g8tdƩYQ|!=Dzؽ^/=7[)%Ԁ-'OHm>Y&d!6,91v;l1ϓ 1ԡ6bH J@Ր6=415~e|^eOcW]VyIl -d,Q5DԞ# 7 F4c~@?mь̂UkB3/_['S7T5j^}EGile.b|+13' \'o&R{g}}hް6]]-c染._hLxo,"pgX'htn/9_^NIENDB`tomboy-ng_0.34-1/source/0000755000175000017500000000000014145033507014715 5ustar dbannondbannontomboy-ng_0.34-1/source/editbox.lrj0000644000175000017500000001524014145033507017066 0ustar dbannondbannon{"version":1,"strings":[ {"hash":153585165,"name":"teditboxform.caption","sourcebytes":[69,100,105,116,66,111,120,70,111,114,109],"value":"EditBoxForm"}, {"hash":124067209,"name":"teditboxform.label2.caption","sourcebytes":[82,101,97,100,32,79,110,108,121],"value":"Read Only"}, {"hash":201669571,"name":"teditboxform.label3.caption","sourcebytes":[84,104,105,115,32,110,111,116,101,32,104,97,115,32,98,101,101,110,32,99,104,97,110,103,101,100,32,98,121,32,116,104,101,32,83,121,110,99,32,80,114,111,99,101,115,115],"value":"This note has been changed by the Sync Process"}, {"hash":71601577,"name":"teditboxform.label4.caption","sourcebytes":[80,108,101,97,115,101,32,99,108,111,115,101,32,105,116,32,40,97,110,100,32,114,101,45,111,112,101,110,32,105,102,32,105,116,32,119,97,115,32,97,32,100,111,119,110,108,111,97,100,41],"value":"Please close it (and re-open if it was a download)"}, {"hash":185126132,"name":"teditboxform.editfind.text","sourcebytes":[69,100,105,116,70,105,110,100],"value":"EditFind"}, {"hash":238044255,"name":"teditboxform.labelfindinfo.caption","sourcebytes":[76,97,98,101,108,70,105,110,100,73,110,102,111],"value":"LabelFindInfo"}, {"hash":88,"name":"teditboxform.labelfindcount.caption","sourcebytes":[88],"value":"X"}, {"hash":225175811,"name":"teditboxform.speedbuttonnotebook.hint","sourcebytes":[77,97,110,97,103,101,32,78,111,116,101,98,111,111,107,115],"value":"Manage Notebooks"}, {"hash":48553723,"name":"teditboxform.speedrollback.hint","sourcebytes":[82,111,108,108,32,66,97,99,107],"value":"Roll Back"}, {"hash":217489525,"name":"teditboxform.speedbuttondelete.hint","sourcebytes":[68,101,108,101,116,101,32,116,104,105,115,32,110,111,116,101],"value":"Delete this note"}, {"hash":242362684,"name":"teditboxform.speedbuttontools.hint","sourcebytes":[84,111,111,108,115,32,45,32,83,121,110,99,44,32,69,120,112,111,114,116,44,32,83,112,101,108,108],"value":"Tools - Sync, Export, Spell"}, {"hash":153225411,"name":"teditboxform.speedbuttontext.hint","sourcebytes":[70,111,110,116,32,115,105,122,101,44,32,98,111,108,100,44,32,105,116,97,108,105,99,115,32,101,116,99],"value":"Font size, bold, italics etc"}, {"hash":156305157,"name":"teditboxform.speedbuttonlink.hint","sourcebytes":[76,105,110,107,32,104,105,103,104,108,105,103,104,116,101,100,32,116,101,120,116,32,116,111,32,97,32,110,101,119,32,110,111,116,101],"value":"Link highlighted text to a new note"}, {"hash":59715590,"name":"teditboxform.speedbuttonsearch.hint","sourcebytes":[83,101,97,114,99,104,32,65,108,108,32,78,111,116,101,115,32,67,116,114,108,45,83,104,105,102,116,45,70],"value":"Search All Notes Ctrl-Shift-F"}, {"hash":343125,"name":"teditboxform.buttmaintbmenu.caption","sourcebytes":[77,101,110,117],"value":"Menu"}, {"hash":300580,"name":"teditboxform.menubold.caption","sourcebytes":[66,111,108,100],"value":"Bold"}, {"hash":84574963,"name":"teditboxform.menuitalic.caption","sourcebytes":[73,116,97,108,105,99],"value":"Italic"}, {"hash":151125108,"name":"teditboxform.menustrikeout.caption","sourcebytes":[83,116,114,105,107,101,111,117,116],"value":"Strikeout"}, {"hash":234009348,"name":"teditboxform.menuhighlight.caption","sourcebytes":[72,105,103,104,108,105,103,104,116],"value":"Highlight"}, {"hash":101774616,"name":"teditboxform.menufixedwidth.caption","sourcebytes":[70,105,120,101,100,32,87,105,100,116,104],"value":"Fixed Width"}, {"hash":180974597,"name":"teditboxform.menuunderline.caption","sourcebytes":[85,110,100,101,114,108,105,110,101],"value":"Underline"}, {"hash":48330708,"name":"teditboxform.menusmall.caption","sourcebytes":[83,109,97,108,108,32,70,111,110,116],"value":"Small Font"}, {"hash":129088868,"name":"teditboxform.menunormal.caption","sourcebytes":[78,111,114,109,97,108,32,70,111,110,116],"value":"Normal Font"}, {"hash":225574612,"name":"teditboxform.menularge.caption","sourcebytes":[76,97,114,103,101,32,70,111,110,116],"value":"Large Font"}, {"hash":326613,"name":"teditboxform.menuhuge.caption","sourcebytes":[72,117,103,101],"value":"Huge"}, {"hash":53226462,"name":"teditboxform.menuitembulletright.caption","sourcebytes":[66,117,108,108,101,116,32,62,62],"value":"Bullet >>"}, {"hash":53226044,"name":"teditboxform.menuitembulletleft.caption","sourcebytes":[66,117,108,108,101,116,32,60,60],"value":"Bullet <<"}, {"hash":267343253,"name":"teditboxform.menuitemsync.caption","sourcebytes":[83,121,110,99,104,114,111,110,105,122,101],"value":"Synchronize"}, {"hash":213582195,"name":"teditboxform.menuitemsettings.caption","sourcebytes":[83,101,116,116,105,110,103,115],"value":"Settings"}, {"hash":80705172,"name":"teditboxform.menuitemexport.caption","sourcebytes":[69,120,112,111,114,116],"value":"Export"}, {"hash":110270710,"name":"teditboxform.menuitemexportrtf.caption","sourcebytes":[69,120,112,111,114,116,32,82,84,70],"value":"Export RTF"}, {"hash":120326628,"name":"teditboxform.menuitemexportplaintext.caption","sourcebytes":[69,120,112,111,114,116,32,80,108,97,105,110,32,84,101,120,116],"value":"Export Plain Text"}, {"hash":267951902,"name":"teditboxform.menuitemexportmarkdown.caption","sourcebytes":[69,120,112,111,114,116,32,77,97,114,107,100,111,119,110],"value":"Export Markdown"}, {"hash":5738580,"name":"teditboxform.menuitemprint.caption","sourcebytes":[80,114,105,110,116],"value":"Print"}, {"hash":236160955,"name":"teditboxform.menuitemspell.caption","sourcebytes":[83,112,101,108,108,32,67,104,101,99,107],"value":"Spell Check"}, {"hash":5262024,"name":"teditboxform.menuitemindex.caption","sourcebytes":[73,110,100,101,120],"value":"Index"}, {"hash":209960037,"name":"teditboxform.menuitemevaluate.caption","sourcebytes":[69,118,97,108,117,97,116,101],"value":"Evaluate"}, {"hash":85652432,"name":"teditboxform.menustayontop.caption","sourcebytes":[83,116,97,121,32,79,110,32,84,111,112],"value":"Stay On Top"}, {"hash":110774325,"name":"teditboxform.menuitemfind.caption","sourcebytes":[70,105,110,100,32,105,110,32,116,104,105,115,32,78,111,116,101],"value":"Find in this Note"}, {"hash":73728500,"name":"teditboxform.menufindnext.caption","sourcebytes":[70,105,110,100,32,78,101,120,116],"value":"Find Next"}, {"hash":73741766,"name":"teditboxform.menufindprev.caption","sourcebytes":[70,105,110,100,32,80,114,101,118],"value":"Find Prev"}, {"hash":19140,"name":"teditboxform.menuitemcut.caption","sourcebytes":[67,117,116],"value":"Cut"}, {"hash":304761,"name":"teditboxform.menuitemcopy.caption","sourcebytes":[67,111,112,121],"value":"Copy"}, {"hash":5671589,"name":"teditboxform.menuitempaste.caption","sourcebytes":[80,97,115,116,101],"value":"Paste"}, {"hash":78392485,"name":"teditboxform.menuitemdelete.caption","sourcebytes":[68,101,108,101,116,101],"value":"Delete"}, {"hash":195288076,"name":"teditboxform.menuitemselectall.caption","sourcebytes":[83,101,108,101,99,116,32,65,108,108],"value":"Select All"} ]} tomboy-ng_0.34-1/source/mainunit.lrj0000644000175000017500000000552114145033507017255 0ustar dbannondbannon{"version":1,"strings":[ {"hash":220274030,"name":"tmainform.hint","sourcebytes":[73,102,32,116,104,101,32,121,101,108,108,111,119,32,116,111,109,98,111,121,45,110,103,32,105,99,111,110,32,105,115,32,118,105,115,105,98,108,101,32,105,110,32,121,111,117,114,32,83,121,115,116,101,109,32,84,114,97,121,44,32,121,111,117,32,99,97,110,32,100,105,115,109,105,115,115,32,116,104,105,115,32,119,105,110,100,111,119,46],"value":"If the yellow tomboy-ng icon is visible in your System Tray, you can dismiss this window."}, {"hash":60217639,"name":"tmainform.caption","sourcebytes":[116,111,109,98,111,121,45,110,103],"value":"tomboy-ng"}, {"hash":87847529,"name":"tmainform.label3.caption","sourcebytes":[68,105,99,116,105,111,110,97,114,121,32,67,111,110,102,105,103,32,40,111,112,116,105,111,110,97,108,41],"value":"Dictionary Config (optional)"}, {"hash":3892505,"name":"tmainform.label4.caption","sourcebytes":[83,121,110,99,32,67,111,110,102,105,103,32,40,111,112,116,105,111,110,97,108,41],"value":"Sync Config (optional)"}, {"hash":230572289,"name":"tmainform.label5.caption","sourcebytes":[87,101,108,99,111,109,101,32,116,111,32,116,111,109,98,111,121,45,110,103,32,33],"value":"Welcome to tomboy-ng !"}, {"hash":88,"name":"tmainform.labelnotesfound.caption","sourcebytes":[88],"value":"X"}, {"hash":108199710,"name":"tmainform.labelerror.hint","sourcebytes":[76,97,117,110,99,104,32,102,114,111,109,32,99,111,109,109,97,110,100,108,105,110,101,32,116,111,32,115,101,101,32,101,114,114,111,114,115,32,111,114,32,115,101,101,32,67,111,110,102,105,103,45,62,83,110,97,112,83,104,111,116,45,62,82,101,99,111,118,101,114,32,46,46,46],"value":"Launch from commandline to see errors or see Config->SnapShot->Recover ..."}, {"hash":88,"name":"tmainform.labelerror.caption","sourcebytes":[88],"value":"X"}, {"hash":205434003,"name":"tmainform.checkboxdontshow.hint","sourcebytes":[89,111,117,32,99,97,110,32,114,101,118,101,114,115,101,32,116,104,105,115,32,102,114,111,109,32,83,101,116,116,105,110,103,115],"value":"You can reverse this from Settings"}, {"hash":215954672,"name":"tmainform.checkboxdontshow.caption","sourcebytes":[68,111,110,39,116,32,83,104,111,119,32,102,111,114,32,110,111,114,109,97,108,32,115,116,97,114,116,117,112],"value":"Don't Show for normal startup"}, {"hash":343125,"name":"tmainform.buttmenu.caption","sourcebytes":[77,101,110,117],"value":"Menu"}, {"hash":68883765,"name":"tmainform.labelbadnoteadvice.caption","sourcebytes":[76,97,98,101,108,66,97,100,78,111,116,101,65,100,118,105,99,101],"value":"LabelBadNoteAdvice"}, {"hash":363524,"name":"tmainform.bitbtnquit.caption","sourcebytes":[81,117,105,116],"value":"Quit"}, {"hash":323493,"name":"tmainform.bitbtnhide.caption","sourcebytes":[72,105,100,101],"value":"Hide"}, {"hash":218390960,"name":"tmainform.buttsystrayhelp.caption","sourcebytes":[83,121,115,84,114,97,121,32,72,101,108,112],"value":"SysTray Help"} ]} tomboy-ng_0.34-1/source/spelling.lfm0000644000175000017500000000371714145033507017242 0ustar dbannondbannonobject FormSpell: TFormSpell Left = 800 Height = 227 Top = 243 Width = 421 Caption = 'Spell' ClientHeight = 227 ClientWidth = 421 OnHide = FormHide OnShow = FormShow LCLVersion = '2.3.0.0' object ListBox1: TListBox Left = 248 Height = 136 Top = 40 Width = 152 ItemHeight = 0 OnClick = ListBox1Click OnDblClick = ListBox1DblClick ScrollWidth = 150 TabOrder = 0 TopIndex = -1 end object LabelPrompt: TLabel Left = 256 Height = 19 Top = 20 Width = 152 Caption = 'Click a word to use it.' end object Label4: TLabel Left = 19 Height = 19 Top = 16 Width = 105 Caption = 'Suspect word -' end object LabelSuspect: TLabel Left = 19 Height = 19 Top = 48 Width = 102 Caption = 'LabelSuspect' Font.Style = [fsBold] ParentFont = False end object ButtonUseAndNextWord: TButton Left = 16 Height = 49 Top = 112 Width = 173 Caption = 'Use and Next Word' OnClick = ButtonUseAndNextWordClick TabOrder = 1 end object LabelStatus: TLabel Left = 19 Height = 19 Top = 199 Width = 83 Caption = 'LabelStatus' end object LabelContext: TLabel Left = 19 Height = 19 Top = 80 Width = 95 Caption = 'LabelContext' end object ButtonSkip: TButton Left = 16 Height = 25 Hint = 'Skip just this instance' Top = 160 Width = 88 Caption = 'Skip' OnClick = ButtonSkipClick ParentShowHint = False ShowHint = True TabOrder = 2 end object ButtonIgnore: TButton Left = 104 Height = 25 Hint = 'Ignore all instances for the run' Top = 160 Width = 85 Caption = 'Ignore' OnClick = ButtonIgnoreClick ParentShowHint = False ShowHint = True TabOrder = 3 end object BitBtn1: TBitBtn Left = 248 Height = 30 Top = 184 Width = 152 DefaultCaption = True Kind = bkClose ModalResult = 11 TabOrder = 4 end end tomboy-ng_0.34-1/source/savenote.pas0000644000175000017500000010233614145033507017253 0ustar dbannondbannonunit SaveNote; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ This unit is responsible for saving a note in the Tomboy XML format. After creation, the class needs to be told the current FontNormal size and the CreatDate if any. If the supplied CreatDate is '', it will stamp it Now(). All the work is done in the Save(..) function, it needs to be passed the name of a file (that may or may not exist) and the KMemo its getting its content from. New Model - Saving is now a threaded operation and that happens in EditBox The class is created in EditBox, then ReadKMemo is called, it puts an XML version of the note into the passed StringList. The class can then be freed. ReadKMemo decides to put xml into either the StringList or a stream (that can be saved from here) on basis of if a StringList is passed or not. ----- Tag order ----- List, Bold, Italics HiLite Underline Strikeout Monospace Fontsize Processing Order is the reverese, so, and and of line might contain (in extreame case) - ListOff BoldOff ItalicsOff HiLiteOff UnderOff StrikeOff MonoOff _FontSize_ MonoSpace Strikeout Underline HiLite Ital Bold List } { HISTORY 20170927 - added Hyperlink to blocks to be saved. 2017/11/4 - replaced GetLocalTime() with one from TB_Sync, it puts minutes into the time offset figure, eg +11:00. Old notes written with previous vesions will fail with file sync until rewritten. 2017/11/12 Added code to replace < and > with char codes. 2017/12/02 Fixed a bug were we were skipping newline where there were 2 in a row 2017/12/02 Extensive changes to ensure font setting spanning part of a bullet list are saved correctly. 2017/12/02 Restructured AddTag to ensure tags laid out in correct order. 2017/12/02 changed the way that we ensure there are no hanging tags at end of a note. 2017/12/10 Fix a bug in BulletList() whereby font changes were not preserving previous queued format changes. Possibly. This is not robust code. 2018/01/01 Yet another bug fix for BulletList(), this time I've got it ! 2018/01/25 Changes to support Notebooks 2018/01/31 Added code to reprocess & 2018/05/12 Extensive changes - MainUnit is now just that. Only change here relates to naming of MainUnit and SearchUnit. 2018/06/26 Some tags an an 's' at the end. Changed the test for when FixedWidth turns on in AddTag(). 2018/07/14 Fixed a misplaced 'end' in BulletList() that was skipping some of its tests. 2018/07/27 Call RemoveBadCharacters(Title) in Header() 2018/08/02 Fix to fixed width, better brackets and a 'not' where needed. 2018/08/15 ReplaceAngles() works with bytes, not char, so don't use UTF8Copy and UTF8Length .... 2018/12/04 Don't save hyperlinks's underline, its not real ! 2018/12/29 Small improvements in time to save a file. 2019/04/29 Restore note's previous previous position and size. 2019/05/06 Support saving pos and open on startup in note. 2019/06/07 Removed unused, historical func to clean xml 2020/07/17 Esc bad XML in Template name. 2020/08/08 Added a BOM, a Byte Order Mark, at start of a note. 2020/08/10 Removed BOM, no advantage I can find, undefined risk. 2021/08/28 Can now save multilevel bullets 2021/10/05 Bug where a line in a monospace block was getting a even if the next line was monospace, Linux. Because that individual line wraping is useful, I now do it in notenormal. 2021/10/15 Serious change, now terminate font size changes at end of line where necessary vastly better xml. 2021/11/04 SaveNewTemplate now gets a current date stamp. } {$mode objfpc}{$H+} interface uses Classes, SysUtils, KMemo, Graphics, LazLogger; {type TNoteLocation = record X, Y, Width, Height : integer; end;} type TNoteUpdateRec = record CPos : shortstring; X, Y : shortstring; Width, Height : shortstring; OOS : shortstring; FFName : string; // path, ID and .note, not used in Single Note Mode LastChangeDate : string; // if '', its a content save, generate a new timestamp CreateDate : string; // if its '', its a new note, use LastChangeDate ErrorStr : string; // '' if all OK, not used everywhere.... // ToDo : remove the field ErrorStr end; type { TBSaveNote } TBSaveNote = class private OutStream:TMemoryStream; ID : ANSIString; FSize : integer; // Current Font Size, compare to Sett.Font* Bold : boolean; Italics : boolean; HiLight : boolean; Underline : boolean; Strikeout : boolean; FixedWidth : boolean; PrevFSize : integer; PrevBold : boolean; PrevItalics : boolean; PrevHiLight : boolean; PrevUnderline : boolean; PrevStrikeout : boolean; PrevFixedWidth : boolean; InList : boolean; KM : TKMemo; { This function key to whole parser. It uses a set of regional vars that remember the current style attributes and compare it to a newly arriving block, writing tags accordingly. Special case when CloseOnly is true, we terminate all active styles and reactivate them (NoteNormal will move the reactivated tags to next line later). Absolutly vital that tag order be observed, crossed ove r tgas are a very bad thing.} function AddTag(const FT : TKMemoTextBlock; var Buff : ANSIString; CloseOnly : boolean = False) : ANSIString; function BlockAttributes(Bk: TKMemoBlock): AnsiString; procedure BulletList(Level: TKMemoParaNumbering; var Buff: ANSIString); procedure CopyLastFontAttr(); function SetFontXML(Size : integer; TurnOn : boolean) : string; public // TimeStamp : string; // abandonded in SaveThread mode // Title : ANSIString; // set to orig createdate if available, if blank, we'll use now() CreateDate : ANSIString; procedure ReadKMemo(FileName: ANSIString; Title: string; KM1: TKMemo; STL: TStringList = nil); function WriteToDisk(const FileName: ANSIString; var NoteLoc: TNoteUpdateRec ): boolean; constructor Create; destructor Destroy; override; end; function Footer(Loc : TNoteUpdateRec) : string; function Header(Title : String) : ANSIstring; procedure SaveNewTemplate(NotebookName: ANSIString); implementation uses FileUtil // Graphics needed for font style defines ,LazUTF8 ,Settings // User settings and some defines across units. ,SearchUnit // So we have access to NoteBookList ,LazFileUtils // For ExtractFileName... ,tb_utils {$ifdef WINDOWS},SyncUtils{$endif} ; // For SafeWindowsDelete const {$ifdef LINUX} MonospaceFont = 'Monospace'; // until Oct 2021, this was monospace, caused each line in a mono block to be individually wrapped on Linux {$ifend} {$ifdef WINDOWS} MonospaceFont = 'Lucida Console'; {$ifend} {$ifdef DARWIN} MonospaceFont = 'Lucida Console'; {$ifend} constructor TBSaveNote.Create; begin OutStream := Nil; end; destructor TBSaveNote.Destroy; begin if OutStream <> Nil then begin debugln('ERROR - ID=' + ID + ' outstream was not routinly freed .....'); OutStream.Free; OutStream := Nil; end; end; function TBSaveNote.SetFontXML(Size : integer; TurnOn : boolean) : string; begin Result := ''; if Size = Sett.FontHuge then if TurnOn then Result := '' else Result := ''; if Size = sett.FontLarge then if TurnOn then Result := '' else Result := ''; if Size = Sett.FontSmall then if TurnOn then Result := '' else Result := ''; end; function TBSaveNote.AddTag(const FT : TKMemoTextBlock; var Buff : ANSIString; CloseOnly : boolean = False) : ANSIString; {var TestVar : Boolean;} begin // Important that we keep the tag order consistent. Good xml requires no cross over // tags. If the note is to be readable by Tomboy, must comply. (EditBox does not care) // Tag order - // List, Bold, Italics HiLite Underline Strikeout Monospace Fontsize // Processing Order is the reverese - // ListOff BoldOff ItalicsOff HiLiteOff UnderOff StrikeOff MonoOff FontSize MonoSpace Strikeout Underline HiLite Ital Bold List //debugln(BlockAttributes(FT)); // When Bold Turns OFF if (Bold and (not (fsBold in FT.TextStyle.Font.Style))) then begin Buff := Buff + ''; Bold := false; end; // When Italic turns OFF if (Italics and (not (fsItalic in FT.TextStyle.Font.Style))) then begin if Bold then Buff := Buff + ''; Buff := Buff + ''; if Bold then Buff := Buff + ''; Italics := false; end; // When Highlight turns OFF if (HiLight and (not (FT.TextStyle.Brush.Color = Sett.HiColour))) then begin if Bold then Buff := Buff + ''; if Italics then Buff := Buff + ''; Buff := Buff + ''; if Italics then Buff := Buff + ''; if Bold then Buff := Buff + ''; HiLight := false; end; // When Underline turns OFF if (Underline and (not (fsUnderline in FT.TextStyle.Font.Style))) then begin if Bold then Buff := Buff + ''; if Italics then Buff := Buff + ''; if HiLight then Buff := Buff + ''; Buff := Buff + ''; if HiLight then Buff := Buff + ''; if Italics then Buff := Buff + ''; if Bold then Buff := Buff + ''; Underline := false; end; // When Strikeout turns OFF if (Strikeout and (not (fsStrikeout in FT.TextStyle.Font.Style))) then begin if Bold then Buff := Buff + ''; if Italics then Buff := Buff + ''; if HiLight then Buff := Buff + ''; if Underline then Buff := Buff + ''; Buff := Buff + ''; if Underline then Buff := Buff + ''; if HiLight then Buff := Buff + ''; if Italics then Buff := Buff + ''; if Bold then Buff := Buff + ''; Strikeout := false; end; // When FixedWidth turns OFF //if (FixedWidth <> (FT.TextStyle.Font.Pitch = fpFixed) or (FT.TextStyle.Font.Name = MonospaceFont)) then begin // if we are currently in fixedwidth AND the next block is not. Not because either Pitch is not pfFixed OR Name is not Monospace if (FixedWidth and ((FT.TextStyle.Font.Pitch <> fpFixed) or (FT.TextStyle.Font.Name <> MonospaceFont))) then begin if Bold then Buff := Buff + ''; if Italics then Buff := Buff + ''; if HiLight then Buff := Buff + ''; if Underline then Buff := Buff + ''; if Strikeout then Buff := Buff + ''; Buff := Buff + ''; if Strikeout then Buff := Buff + ''; if Underline then Buff := Buff + ''; if HiLight then Buff := Buff + ''; if Italics then Buff := Buff + ''; if Bold then Buff := Buff + ''; FixedWidth := false; end; // When Font size changes OR end of line where we cloe off any pending, we rely on // notenormal to later move the re-turn ons down to next line. if CloseOnly OR ((FSize <> FT.TextStyle.Font.Size) and (FT.TextStyle.Font.Size <> Sett.FontTitle)) then begin if Bold then Buff := Buff + ''; if Italics then Buff := Buff + ''; if HiLight then Buff := Buff + ''; if Underline then Buff := Buff + ''; if Strikeout then Buff := Buff + ''; if FixedWidth then Buff := Buff + ''; // we need to do this if FSize is Small, Large or Huge OR Font has changed if (FSize in [Sett.FontSmall, Sett.FontLarge, Sett.FontHuge]) // ToDo : Oct2021 Seriously untested code !!!! or ((FSize <> FT.TextStyle.Font.Size) and (FT.TextStyle.Font.Size <> Sett.FontTitle)) then begin Buff := Buff + SetFontXML(FSize, false); // better for pretty tags but generates invalid tags ! See below .... Buff := Buff + SetFontXML(FT.TextStyle.Font.Size, true); end; if FixedWidth then Buff := Buff + ''; if Strikeout then Buff := Buff + ''; if Underline then Buff := Buff + ''; if HiLight then Buff := Buff + ''; if Italics then Buff := Buff + ''; if Bold then Buff := Buff + ''; FSize := FT.TextStyle.Font.Size; end; if CloseOnly then exit(Buff); // if CloseOnly, ie end of line, nothing is turning on. // This comment no longer applies, leave hear until well tested !!!!!!! // this is not ideal, it should happen after we have closed all fonts, before // we write new sizes but that difficult as we have only one flag, "FSize" // difficulity is that font size change is two step, other things are On/Off // Result is that xml tag for a new font jumps up blank lines. Not pretty // be nice to find another way..... DRB // FixedWidth turns ON if ((not FixedWidth) and ((FT.TextStyle.Font.Name = MonospaceFont) or (FT.TextStyle.Font.Pitch = fpFixed))) then begin //TestVar := (FT.TextStyle.Font.Name = MonospaceFont); //TestVar := (FT.TextStyle.Font.Pitch = fpFixed); if Bold then Buff := Buff + ''; if Italics then Buff := Buff + ''; if HiLight then Buff := Buff + ''; if Underline then Buff := Buff + ''; if Strikeout then Buff := Buff + ''; Buff := Buff + ''; if Strikeout then Buff := Buff + ''; if Underline then Buff := Buff + ''; if HiLight then Buff := Buff + ''; if Italics then Buff := Buff + ''; if Bold then Buff := Buff + ''; FixedWidth := true; end; // Strikeout turns ON if ((not Strikeout) and (fsStrikeout in FT.TextStyle.Font.Style)) then begin if Bold then Buff := Buff + ''; if Italics then Buff := Buff + ''; if HiLight then Buff := Buff + ''; if Underline then Buff := Buff + ''; Buff := Buff + ''; if Underline then Buff := Buff + ''; if HiLight then Buff := Buff + ''; if Italics then Buff := Buff + ''; if Bold then Buff := Buff + ''; Strikeout := true; end; // Underline turns ON if ((not Underline) and (fsUnderline in FT.TextStyle.Font.Style)) then begin if not FT.ClassNameIs('TKMemoHyperlink') then begin // Hyperlinks also have underline, don't save if Bold then Buff := Buff + ''; if Italics then Buff := Buff + ''; if HiLight then Buff := Buff + ''; Buff := Buff + ''; if HiLight then Buff := Buff + ''; if Italics then Buff := Buff + ''; if Bold then Buff := Buff + ''; Underline := true; end; end; // Highlight turns ON if ((not HiLight) and (FT.TextStyle.Brush.Color = Sett.HiColour)) then begin if Bold then Buff := Buff + ''; if Italics then Buff := Buff + ''; Buff := Buff + ''; if Italics then Buff := Buff + ''; if Bold then Buff := Buff + ''; HiLight := true; end; // Italic turns On if ((not Italics) and (fsItalic in FT.TextStyle.Font.Style)) then begin if Bold then Buff := Buff + ''; Buff := Buff + ''; if Bold then Buff := Buff + ''; Italics := true; end; // Bold turns On if ((not Bold) and (fsBold in FT.TextStyle.Font.Style)) then begin Buff := Buff + ''; Bold := true; end; Result := Buff; end; { This function takes an existing parsed string and wraps it in the necessary bullet tags but has to resolve any pending formatting tags first and restore then afterwards. Its horrible. If you are debugging this, I am truly sorry. } // ListOff BoldOff ItalicsOff HiLiteOff FontSize HiLite Ital Bold List procedure TBSaveNote.BulletList(Level : TKMemoParaNumbering; var Buff : ANSIString); var StartStartSt, StartEndSt, EndStartSt, EndEndSt : ANSIString; iLevel : integer; begin //writeln('Status Bold=', Bold=True, ' PBold=', PrevBold=True, ' High=', HiLight=True, ' PHigh=', PrevHiLight=True); StartStartSt := ''; StartEndSt := ''; EndStartSt := ''; EndEndSt := ''; if PrevBold then begin StartStartSt := ''; // Starting String, Start StartEndSt := ''; // Starting String, End end; if Bold then begin EndStartSt := ''; // End String, start of it EndEndSt := ''; // End String, end of it end; if PrevItalics then begin StartStartSt := StartStartSt + ''; StartEndSt := '' + StartEndSt; end; if Italics then begin EndStartSt := EndStartSt + ''; EndEndSt := '' + EndEndSt; end; if PrevHiLight then begin StartStartSt := StartStartSt + ''; StartEndSt := '' + StartEndSt; end; if HiLight then begin EndStartSt := EndStartSt + ''; EndEndSt := '' + EndEndSt; end; if PrevUnderline then begin StartStartSt := StartStartSt + ''; StartEndSt := '' + StartEndSt; // EndEndSt := '' + EndEndSt; end; if Underline then begin EndStartSt := EndStartSt + ''; EndEndSt := '' + EndEndSt; end; if PrevStrikeout then begin StartStartSt := StartStartSt + ''; StartEndSt := '' + StartEndSt; end; if Strikeout then begin EndStartSt := EndStartSt + ''; EndEndSt := '' + EndEndSt; end; if PrevFixedWidth then begin StartStartSt := StartStartSt + ''; StartEndSt := '' + StartEndSt; // EndEndSt := '' + EndEndSt; end; if FixedWidth then begin EndStartSt := EndStartSt + ''; EndEndSt := '' + EndEndSt; end; if PrevFSize <> Sett.FontNormal then begin StartStartSt := StartStartSt + SetFontXML(PrevFSize, False); StartEndSt := SetFontXML(PrevFSize, True) + StartEndSt; end; if FSize <> Sett.FontNormal then begin EndStartSt := EndStartSt + SetFontXML(FSize, False); EndEndSt := SetFontXML(FSize, True) + EndEndSt; end; // writeLn('Buff at Start [' + Buff + ']'); // writeln('StartStart [' + StartStartSt + ']'); // writeln('StartEnd [' + StartEndSt + ']'); // writeln('EndStart [' + EndStartSt + ']'); // writeln('EndEnd [' + EndEndSt + ']'); Buff := StartEndSt + Buff + EndStartSt; case Level of BulletOne : iLevel := 1; BulletTwo : iLevel := 2; BulletThree : iLevel := 3; BulletFour : iLevel := 4; BulletFive : iLevel := 5; BulletSix : iLevel := 6; BulletSeven : iLevel := 7; BulletEight : iLevel := 8; otherwise iLevel := 8; end; while iLevel > 0 do begin Buff := '' + Buff + ''; dec(iLevel); end; Buff := StartStartSt + Buff + EndEndSt; {Buff := StartStartSt + '' + StartEndSt + Buff + EndStartSt + '' + EndEndSt;} // writeLn('Buff at End [' + Buff + ']'); // ************************************** // writeln('---'); end; // This is just a debug function. function TBSaveNote.BlockAttributes(Bk : TKMemoBlock) : AnsiString; begin Result := TKMemoTextBlock(BK).ClassName; if fsBold in TKMemoTextBlock(BK).TextStyle.Font.Style then Result := Result + ' Bold '; if fsItalic in TKMemoTextBlock(BK).TextStyle.Font.Style then Result := Result + ' Italic '; if TKMemoTextBlock(BK).TextStyle.Brush.Color = Sett.HiColour then Result := Result + ' HighLight '; Result := Result + ' size=' + inttostr(TKMemoTextBlock(BK).TextStyle.Font.Size); if fsUnderline in TKMemoTextBlock(BK).TextStyle.Font.Style then Result := Result + ' Underline '; if fsStrikeout in TKMemoTextBlock(BK).TextStyle.Font.Style then Result := Result + ' Strikeout '; if TKMemoTextBlock(BK).TextStyle.Font.Pitch = fpFixed then Result := Result + ' FixedWidth '; if TKMemoTextBlock(BK).ClassNameIs('TKMemoTextBlock') then Result := Result + ' [' + TKMemoTextBlock(BK).Text + ']'; //else Result := 'Not Text'; end; procedure SaveNewTemplate(NotebookName : ANSIString); var GUID : TGUID; OStream:TFilestream; Buff{, ID} : ANSIString; Loc : TNoteUpdateRec {TNoteLocation}; begin CreateGUID(GUID); //Title := NotebookName + ' Template'; Loc.FFName := copy(GUIDToString(GUID), 2, 36) + '.note'; SearchForm.NoteLister.AddNoteBook(Loc.FFname, NotebookName, True); Ostream :=TFilestream.Create(Sett.NoteDirectory + Loc.FFName, fmCreate); Loc.Y := '20'; Loc.X := '20'; Loc.Height := '200'; Loc.Width:='300'; Loc.OOS := 'False'; Loc.CPos:='1'; Loc.LastChangeDate := TB_GetLocalTime(); try Buff := Header(RemoveBadXMLCharacters(NotebookName) + ' Template'); OStream.Write(Buff[1], length(Buff)); Buff := RemoveBadXMLCharacters(NotebookName) + ' Template' + #10#10#10; OStream.Write(Buff[1], length(Buff)); Buff := Footer(Loc); OStream.Write(Buff[1], length(Buff)); finally OStream.Free; end; end; procedure TBSaveNote.CopyLastFontAttr(); begin PrevFSize := FSize; PrevBold := Bold; PrevItalics := Italics; PrevHiLight := HiLight; PrevUnderline := Underline; PrevStrikeout := Strikeout; PrevFixedWidth := FixedWidth; PrevFSize := FSize; end; // NEW : if passed a created StringList, we write to the list rather than to the // Memory Buffer. Still need to deal with Header and Footer in a line by line mode. procedure TBSaveNote.ReadKMemo(FileName : ANSIString; Title : string; KM1 : TKMemo; STL : TStringList = nil); var Buff : ANSIstring = ''; // OutStream:TFilestream; BlockNo : integer = 0; Block : TKMemoBlock; NextBlock : integer; // BlankFont : TFont; begin KM := KM1; FSize := Sett.FontNormal; Bold := false; Italics := False; HiLight := False; Underline := False; InList := false; FixedWidth := False; ID := ExtractFileNameOnly(FileName) + '.note'; // ID needs to be set so we can get list of notebooks for the footer. // Must deal with an empty list ! // try if STL = nil then outstream :=TMemoryStream.Create({FileName, fmCreate}); // Write and WriteBuffer accept a buffer, not a string ! Need to start at pos 1 // when sending string or ANSIstring otherwise it uses first byte which makes it look like a binary file. // http://free-pascal-general.1045716.n5.nabble.com/Creating-text-files-with-TFileStream-td2824859.html Buff := Header(Title); if STL = Nil then OutStream.Write(Buff[1], length(Buff)) else STL.Add(Buff); Buff := ''; try repeat CopyLastFontAttr(); repeat Block := KM1.Blocks.Items[BlockNo]; // debugln('Block=' + inttostr(BlockNo) + ' ' +BlockAttributes(Block)); if Block.ClassNameIs('TKMemoParagraph') then break; // discard end prev para if Block.ClassNameIs('TKMemoTextBlock') then begin if Block.Text.Length > 0 then begin AddTag(TKMemoTextBlock(Block), Buff); Buff := Buff + RemoveBadXMLCharacters(Block.Text); end; end; if Block.ClassNameIs('TKMemoHyperlink') then begin AddTag(TKMemoHyperlink(Block), Buff); Buff := Buff + RemoveBadXMLCharacters(Block.Text); end; //debugln('Block=' + inttostr(BlockNo) + ' ' +BlockAttributes(Block)); inc(BlockNo); if BlockNo >= KM1.Blocks.Count then break; // debugln('Inner Buff=[' + Buff + ']'); until KM1.Blocks.Items[BlockNo].ClassNameIs('TKMemoParagraph'); if BlockNo >= KM1.Blocks.Count then break; if TKMemoParagraph(KM1.Blocks.Items[BlockNo]).Numbering <> pnuNone then BulletList(TKMemoParagraph(KM1.Blocks.Items[BlockNo]).Numbering, Buff); {if TKMemoParagraph(KM1.Blocks.Items[BlockNo]).Numbering = pnuBullets then BulletList(Buff); } // Add tags about to terminate to end of line, pretty XML // However does not work for font size changes ! // Note - para blocks CAN have font attributs (eg, underline etc). // debugln('Outer 1 Buff=[' + Buff + ']'); // Now, look ahead and see if we need close things .... // This makes bad decision for font size changes, we end up with empty tags but does no real harm. NextBlock := BlockNo + 1; while NextBlock < KM1.Blocks.Count do begin if KM1.Blocks.Items[NextBlock].ClassNameIs('TKMemoTextBlock') then begin AddTag(TKMemoTextBlock(KM1.Blocks.Items[NextBlock]), Buff, True); break; end else inc(NextBlock); end; if STL = Nil then begin Buff := Buff + LineEnding; OutStream.Write(Buff[1], length(Buff)) end else STL.Add(Buff); Buff := ''; // debugln('Block=' + inttostr(BlockNo) + ' ' +BlockAttributes(KM1.Blocks.Items[BlockNo])); inc(BlockNo); if BlockNo >= KM1.Blocks.Count then break; until false; { At this point we may have unsaved content in Buff cos last block was not a Para. But it cannot be Bullet. If it was a Para, Buff is empty. But we could still have hanging xml tags. So either case, send it to add tag with an empty Font. } if Buff <> '' then begin if STL = Nil then OutStream.Write(Buff[1], length(Buff)) else STL.Add(Buff); end; Buff := ''; if Bold then Buff := ''; if Italics then Buff := Buff + ''; if HiLight then Buff := Buff + ''; if Underline then Buff := Buff + ''; if Strikeout then Buff := Buff + ''; if FixedWidth then Buff := Buff + ''; if FSize <> Sett.FontNormal then Buff := Buff + SetFontXML(FSize, False); if length(Buff) > 0 then begin if STL = Nil then OutStream.Write(Buff[1], length(Buff)) else STL.Add(Buff); end; Except on EListError do begin debugln('ERROR - EListError while writing note to stream.'); { we now do footer in the WriteToDisk() Buff := Footer(); OutStream.Write(Buff[1], length(Buff)); } end; end; { finally OutStream.Free; end; } end; // gets called (from outside) after all content assembled. Its done from outside // as the calling unit has control of KMemo's locking. function TBSaveNote.WriteToDisk(const FileName: ANSIString; var NoteLoc : TNoteUpdateRec) : boolean; var Buff : string = ''; TmpName : string = ''; {$ifdef WINDOWS}FileAttr : longint; ErrorMsg : string; {$endif} begin Result := True; // we write out the footer here so we can do the searching to notebook stuff // after we have released to lock on KMemo. Buff := Footer(NoteLoc); OutStream.Write(Buff[1], length(Buff)); // We save the file in tmp, when closed, // move it over to the actual position. That will prevent, to some extent, poweroff // crashes messing with files. May generate an EStreamError //{$define STAGEDWRITE} //{$ifdef STAGEDWRITE} {$ifdef WINDOWS} // temp kludge until I understand the problem RenameFileUTF has with smb shares. // this will now work OK on all linux file systems but without the write, delete.move process. TmpName := AppendPathDelim(Sett.NoteDirectory) + 'tmp'; if not DirectoryExists(TmpName) then if not CreateDir(AppendPathDelim(tmpname)) then begin NoteLoc.ErrorStr:='Failed Create Dir'; exit(False); end; TmpName := TmpName + pathDelim + extractFileName(FileName); try OutStream.SaveToFile(TmpName); finally OutStream.Free; OutStream := nil; end; {$ifdef WINDOWS} if FileExists(FileName) then // will not be there if its a new note. if not SafeWindowsDelete(FileName, ErrorMsg) then exit(false); {$endif} //showmessage('T=' + TmpName + ' and F=' + FileName); result := RenameFileUTF8(TmpName, FileName); // Unix ok to over write, windows is not ! // ToDo : Note that the above line seems to fail on a smb shared directory. Must get to bottom .... {$else} // thats the ifdef StagedWrite, here we write directly to note file. try OutStream.SavetoFile(FileName); finally OutStream.Free; OutStream := nil; end; {$endif} // thats the ifdef StagedWrite if not Result then NoteLoc.ErrorStr:='Failed Rename T=' + TmpName + ' and F=' + FileName; end; function Header(Title : string): ANSIstring; var S1, S2, S3, S4 : ANSIString; begin // Add a BOM at the start, not essencial, Tomboy did it, makes the note no longer a plain text file. ?? //S1 := #239#187#191''#10''#10''; S4 := ''#10' '; Result := S1 + S2 + S3 + RemoveBadXMLCharacters(Title) + S4; end; { Sets TimeStamp, a public SaveNote var that is later used by EditBox to set the value stored in NoteLister. And NoteLister is not thread safe. This method also reads NoteLister for NoteBookTags. Maybe or maybe NOT safe. } function Footer(Loc : TNoteUpdateRec): ANSIstring; var S1, S2, S3, S4, S5, S6 : string; begin if Loc.LastChangeDate = '' then begin debugln('------------------------------------------------------------------------'); debugln('ERROR, ERROR passed an blank change date to Footer, not nice.'); debugln('------------------------------------------------------------------------'); Loc.LastChangeDate := TB_GetLocalTime(); // no, thats just a temp fix, do something about it end; (* if Loc.LastChangeDate = '' then TimeStamp := TB_GetLocalTime() // get actual time date in format like Tomboy's else TimeStamp := Loc.LastChangeDate; *) S1 := ''#10' '; S2 := ''#10' '; S3 := ''#10' '; S4 := ''#10' ' + Loc.CPos + ''#10' 1'#10; S5 := ' ' + Loc.Width + ''#10' ' + Loc.Height + ''#10' ' + Loc.X + ''#10' ' + Loc.Y + ''#10; S6 := ' ' + Loc.OOS + ''#10''; if Loc.CreateDate = '' then Loc.CreateDate := Loc.LastChangeDate; if SearchForm.NoteLister <> Nil then Result := S1 + Loc.LastChangeDate + S2 + Loc.LastChangeDate + S3 + Loc.CreateDate + S4 + S5 + SearchForm.NoteLister.NoteBookTags(ExtractFileName(Loc.FFName)) + S6 else Result := S1 + Loc.LastChangeDate + S2 + Loc.LastChangeDate + S3 + Loc.CreateDate + S4 + S5 + S6; // That will mean no Notebook tags in single note mode, is that an issue ? // Most singe notes are out of their repo so won't have notebooks anyway but we could // save any tag list and restore it on save ?? end; end. tomboy-ng_0.34-1/source/notifier.pas0000644000175000017500000001061214145033507017241 0ustar dbannondbannonunit notifier; {$mode objfpc}{$H+} { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ A trivial unit that uses libnotify on Linux and a timed out TPopupNotify on other platforms. Does very little, on linux it just calls libnotify, https://github.com/ik5/libnotify-fpc On Non-Linux, it calls TPopupNotifier, sets a timer and removes the Popup after the set time (in mS). In both cases, it then destroys itself ! Yes, you call create but YOU DO NOT FREE it ! To use it, grab libnotify.pas, add it and this unit to your Lazarus project and do something like this - procedure TForm1.Button2Click(Sender: TObject); var Notifier : TNotifier; begin Notifier := TNotifier.Create; Notifier.ShowTheMessage('This is Title', 'and this is the message', 15000); // 15 seconds // Note, don't free it, it frees itself. end; } (* On Linux, multitheading must be enabled, in the project (lpr) file, add {$DEFINE UseCThreads} immediatly above the first "uses" line. On Linux, to compile you need the dev version of libnotify but at run time all that is needed is libnotify and it appears to be installed on most if not all distros. On tomboy-ng, my model is that "oh, you might like to know" type notifications take the common 6 seconds. Things the end user might really need to know, such as sync drive not being available I give 12 seconds. Something, really urgent (I don't have any) might get longer. Its incorrect to leave messages that really don't need user action there for very long. *) interface // {$undef LINUX} uses Classes, SysUtils, fpTimer{$ifdef Linux}, libnotify{$else}, PopupNotifier {$endif} ; Type { TNotifier } TNotifier = class private {$ifdef LINUX} LNotifier : PNotifyNotification; {$else} APopupNotifier: TPopupNotifier; procedure TimerFinished( Sender : TObject ); {$endif} public procedure ShowTheMessage(const Title, Message : string; ShowTime : integer = 6000); destructor Destroy; Override; constructor Create(); end; type TTFProc = procedure(Send : TObject) of object; implementation //uses MainUnit; // just while testing Balloon Notifier Windows and Mac var // These are here so Finalization can get to them. TFProc : TTFProc; LocalTimer : TFPTimer; procedure TNotifier.ShowTheMessage(const Title, Message : string; ShowTime : integer); begin {$ifdef LINUX} notify_init(argv[0]); LNotifier := notify_notification_new (pchar(Title), pchar(Message), pchar('dialog-information')); notify_notification_set_timeout(LNotifier, ShowTime); // figure is mS notify_notification_show (LNotifier, nil); notify_uninit; Destroy; // Should also check for errors and use TPopupNotifier if Notify won't work // But that will have to wait until I find a Linux where it does not work ..... {$else} MainForm.TrayIcon.BalloonTitle := Title; MainForm.TrayIcon.BalloonHint := Message; MainForm.TrayIcon.ShowBalloonHint; // Non Linux must use TPopupNotifier (* APopupNotifier := TPopupNotifier.Create(nil); APopupNotifier.Text := Message; APopupNotifier.Title := Title; APopupNotifier.Color:= $909090; APopupNotifier.show; LocalTimer := TFPTimer.create(nil); LocalTimer.Interval := ShowTime; LocalTimer.OnTimer:= @TimerFinished; LocalTimer.Enabled := True; *) {$endif} end; {$ifndef LINUX} procedure TNotifier.TimerFinished( Sender : TObject ); begin // writeln('Timer finished'); LocalTimer.Enabled := false; APopupNotifier.hide; Destroy; end; {$endif} destructor TNotifier.Destroy; begin {$ifndef LINUX} (* freeandnil(APopupNotifier); freeandnil(LocalTimer); *) {$endif} inherited Destroy; end; constructor TNotifier.Create(); begin inherited Create(); LocalTimer := Nil; TFProc := nil; {$ifndef LINUX} TFProc := @TimerFinished; // Something to call if quit app before timer elapsed. {$endif} end; finalization { This is used if the app quits while a notification is active. We just call same function called when timer finished. } if LocalTimer <> nil then TFProc(nil); end. tomboy-ng_0.34-1/source/colours.lfm0000644000175000017500000002273514145033507017114 0ustar dbannondbannonobject FormColours: TFormColours Left = 1133 Height = 274 Top = 200 Width = 450 Caption = 'FormColours' ClientHeight = 274 ClientWidth = 450 OnCreate = FormCreate OnShow = FormShow LCLVersion = '2.1.0.0' object KMemo1: TKMemo Left = 8 Height = 168 Top = 40 Width = 256 ContentPadding.Left = 5 ContentPadding.Top = 5 ContentPadding.Right = 5 ContentPadding.Bottom = 5 ParentFont = False TabOrder = 0 Visible = True end object Label1: TLabel Left = 10 Height = 19 Top = 16 Width = 53 Caption = 'Sample' ParentColor = False end object Label2: TLabel Left = 280 Height = 19 Top = 52 Width = 82 Caption = 'Set Colours' ParentColor = False end object SpeedTitle: TSpeedButton Left = 285 Height = 26 Top = 80 Width = 140 Caption = 'Title' OnClick = SpeedTitleClick end object SpeedText: TSpeedButton Left = 285 Height = 26 Top = 115 Width = 140 Caption = 'Text' OnClick = SpeedTextClick end object SpeedBackground: TSpeedButton Left = 285 Height = 26 Top = 151 Width = 140 Caption = 'Background' OnClick = SpeedBackgroundClick end object SpeedHighlight: TSpeedButton Left = 285 Height = 26 Top = 186 Width = 140 Caption = 'Highlight' OnClick = SpeedHighlightClick end object SpeedDefault: TSpeedButton Left = 128 Height = 26 Top = 224 Width = 100 Caption = 'Default' Glyph.Data = { 36040000424D3604000000000000360000002800000010000000100000000100 2000000000000004000064000000640000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00002F2F8EFF1F1F86FF1C1C85FF1C1C85FF1C1C85FF1C1C85FF1C1C85FF1C1C 84FF1C1C83FF1B1B81C61B1B7E6A1B1B7D070000000000000000000000000000 0000323299FF232392FF202091FF202091FF202091FF202091FF202091FF2020 91FF20208FFF1E1E8CFF1C1C85FF1B1B7FD51B1B7D1500000000000000000000 000039399EFF33339BFF32329AFF32329AFF32329AFF32329AFF32329AFF3232 9AFF31319AFF2E2E98FF252592FF1D1D88FF1A1A7FD51B1B7D07000000000000 0000000000000000000000000000000000000000000000000000000000000000 00003C3C9F0E3A3A9F6A35359CF8252592FF1C1C85FF1B1B7E6A000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000003A3A9F6A2E2E98FF1E1E8CFF1B1B81C6000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000003C3C9F0E30309AFF20208FFF1C1C83FF000000000000 0000000000002929842B00000000000000000000000000000000000000000000 0000000000000000000034349A0E2C2C97FF1F1F90FF1D1D85FF000000000000 000029298C2B222284EA00000000000000000000000000000000000000000000 000000000000000000002A2A956A232393FF1E1E8FFF1E1E86C6000000002929 8F2B24248EEA1C1C85FF00000000000000000000000000000000000000000000 00001F1F850E21218B6A212190F81E1E91FF1F1F8DFF2222876A3131932B2626 91EA1F1F90FF1C1C89FF1C1C85FF1C1C85FF1C1C85FF1C1C85FF1C1C85FF1C1C 85FF1D1D89FF1E1E8EFF1E1E91FF202091FF25258DD52727880738389AD52B2B 97FF202092FF1E1E90FF1F1F90FF202091FF202091FF202091FF202091FF2020 91FF202091FF212193FF252593FF2A2A92D52C2C8F15000000003C3C9F2B3838 9EEA2A2A97FF202092FF262694FF303099FF32329AFF32329AFF32329AFF3232 9AFF32329AFF313198C63232976A333394070000000000000000000000003C3C A02B38389DEA2A2A92FF00000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00003C3C9C2B363692EA00000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000003A3A8F2B00000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000 } OnClick = SpeedDefaultClick end object SpeedCancel: TSpeedButton Left = 232 Height = 26 Top = 224 Width = 100 Caption = 'Cancel' Glyph.Data = { 36040000424D3604000000000000360000002800000010000000100000000100 2000000000000004000064000000640000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000500B6690500B669000000000000000000000000000000000000 0000000000000500B6690500B669000000000000000000000000000000000000 00000200B5680C00CFE90D00D0EB0500B66D0000000000000000000000000000 00000200B56B0C00CFE90D00D0EB0500B86B0000000000000000000000000000 00000200B5680C00CFE91400E6FF0D00D0EB0500B66D00000000000000000200 B56B0C00CFE91400E6FF0D00D0EB0500B86B0000000000000000000000000000 0000000000000300B7660C00CFE91400E6FF0D00D1EB0500B66D0300B6650C00 CFE91400E6FF0D00D1EB0500B66D000000000000000000000000000000000000 000000000000000000000500B66C0C00CFEA1400E6FF0C00D0EA0C00D0EA1400 E6FF0C00CFEA0500B66C00000000000000000000000000000000000000000000 00000000000000000000000000000200B56B0C00D0E81400E6FF1400E6FF0D00 D0EB0500B66D0000000000000000000000000000000000000000000000000000 00000000000000000000000000000200B56B0C00D0E81400E6FF1400E6FF0D00 D0EB0500B66D0000000000000000000000000000000000000000000000000000 000000000000000000000500B66C0C00CFEA1400E6FF0C00D0EA0C00D0EA1400 E6FF0C00CFEA0500B66C00000000000000000000000000000000000000000000 0000000000000300B6650C00CFE91400E6FF0D00D1EB0500B66D0300B7660C00 CFE91400E6FF0D00D1EB0500B66D000000000000000000000000000000000000 00000200B5680C00CFE91400E6FF0D00D0EB0500B66D00000000000000000200 B56B0C00CFE91400E6FF0D00D0EB0500B86B0000000000000000000000000000 00000200B5680C00CFE90D00D0EB0500B66D0000000000000000000000000000 00000200B56B0C00CFE90D00D0EB0500B86B0000000000000000000000000000 0000000000000500B66C0500B66C000000000000000000000000000000000000 0000000000000500B6690500B669000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000 } OnClick = SpeedCancelClick end object SpeedOK: TSpeedButton Left = 336 Height = 26 Top = 224 Width = 100 Caption = 'OK' Glyph.Data = { 36040000424D3604000000000000360000002800000010000000100000000100 2000000000000004000064000000640000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000001007B001D00000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000010D9019A3149927DC0A870F33000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000010D9019A12CBA5AF937C771FF18A031DB0A870F330000 0000000000000000000000000000000000000000000000000000000000000000 0000000000010D9019A12CBA5AF937C871FF37C871FF37C771FF18A031DB0A87 0F33000000000000000000000000000000000000000000000000000000000000 00010D9019A32DBC5DF837C871FF2DBC5DF819A133E337C771FF37C771FF179E 30DB0A870F330000000000000000000000000000000000000000000000000A8D 159B2DBC5DF837C871FF2DBC5DF80D9019A30A890F34179E30DB37C771FF37C7 71FF179E30DB0A870F3300000000000000000000000000000000000000000587 0A31169D2EDA2EBD5EFA0E901AA6008000020000000005870A31169D2EDA37C7 70FF37C771FF18A031DB0A870F33000000000000000000000000000000000000 00000A870F330A8D149B000000010000000000000000000000000A870F33179E 30DB37C771FF37C771FF179E30DB0A870F330000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000587 0A31169D2EDA37C770FF37C771FF18A031DB0A870F3300000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000A870F33179E30DB37C771FF2DBC5DF80A8D159B00000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000005870A31139928DB0E901AA60000000100000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000007B001D000000010000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000 } OnClick = SpeedOKClick end object ColorDialog1: TColorDialog Color = clBlack CustomColors.Strings = ( 'ColorA=000000' 'ColorB=000080' 'ColorC=008000' 'ColorD=008080' 'ColorE=800000' 'ColorF=800080' 'ColorG=808000' 'ColorH=808080' 'ColorI=C0C0C0' 'ColorJ=0000FF' 'ColorK=00FF00' 'ColorL=00FFFF' 'ColorM=FF0000' 'ColorN=FF00FF' 'ColorO=FFFF00' 'ColorP=FFFFFF' 'ColorQ=C0DCC0' 'ColorR=F0CAA6' 'ColorS=F0FBFF' 'ColorT=A4A0A0' ) Left = 320 end end tomboy-ng_0.34-1/source/tomdroidfile.lfm0000644000175000017500000001566614145033507020114 0ustar dbannondbannonobject FormTomdroidFile: TFormTomdroidFile Left = 913 Height = 440 Top = 466 Width = 847 Caption = 'Tomdroid' ClientHeight = 440 ClientWidth = 847 OnShow = FormShow LCLVersion = '2.1.0.0' object ButtonClose: TButton AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 727 Height = 44 Top = 396 Width = 120 Anchors = [akRight, akBottom] Caption = 'Close' ModalResult = 11 TabOrder = 5 end object Panel1: TPanel AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = ButtonClose Left = 0 Height = 393 Top = 0 Width = 847 Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Bottom = 3 Caption = 'Panel1' ClientHeight = 393 ClientWidth = 847 TabOrder = 4 object Label1: TLabel Left = 28 Height = 21 Top = 17 Width = 332 Caption = 'Tomdroid Sync - be aware of limitations !' Font.Height = 18 ParentColor = False ParentFont = False end object Panel2: TPanel AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = PanelAdvice AnchorSideTop.Side = asrBottom AnchorSideRight.Control = Panel1 AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Label6 Left = 22 Height = 240 Top = 121 Width = 808 Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Left = 20 BorderSpacing.Top = 9 BorderSpacing.Right = 16 BorderSpacing.Bottom = 7 Caption = 'Panel2' ClientHeight = 240 ClientWidth = 808 TabOrder = 0 object Memo1: TMemo AnchorSideLeft.Control = Splitter1 AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel2 AnchorSideRight.Control = Panel2 AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Panel2 AnchorSideBottom.Side = asrBottom Left = 377 Height = 238 Top = 1 Width = 430 Anchors = [akTop, akLeft, akRight, akBottom] Lines.Strings = ( 'Memo1' ) TabOrder = 0 TabStop = False end object Splitter1: TSplitter AnchorSideTop.Control = Panel2 AnchorSideBottom.Control = Panel2 AnchorSideBottom.Side = asrBottom Left = 365 Height = 238 Top = 1 Width = 12 Align = alNone Anchors = [akTop, akBottom] ResizeAnchor = akRight end object StringGridReport: TStringGrid AnchorSideLeft.Control = Panel2 AnchorSideTop.Control = Panel2 AnchorSideRight.Control = Splitter1 AnchorSideBottom.Control = Panel2 AnchorSideBottom.Side = asrBottom Left = 1 Height = 238 Top = 1 Width = 364 Anchors = [akTop, akLeft, akRight, akBottom] ColCount = 0 FixedCols = 0 FixedRows = 0 Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goThumbTracking, goSmoothScroll, goCellHints] RowCount = 0 TabOrder = 2 end end object CheckBoxTestRun: TCheckBox AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Label1 AnchorSideRight.Control = Panel1 AnchorSideRight.Side = asrBottom Left = 748 Height = 24 Top = 17 Width = 88 Anchors = [akTop, akRight] BorderSpacing.Left = 10 BorderSpacing.Right = 10 Caption = 'Test Run' Enabled = False TabOrder = 1 TabStop = False end object PanelAdvice: TPanel AnchorSideLeft.Control = Panel1 AnchorSideTop.Control = Label1 AnchorSideTop.Side = asrBottom AnchorSideRight.Control = Panel1 AnchorSideRight.Side = asrBottom Left = 3 Height = 70 Top = 42 Width = 841 Anchors = [akTop, akLeft, akRight] BorderSpacing.Left = 2 BorderSpacing.Top = 4 BorderSpacing.Right = 2 ClientHeight = 70 ClientWidth = 841 TabOrder = 2 object LabelAdvice: TLabel AnchorSideLeft.Control = PanelAdvice AnchorSideTop.Control = PanelAdvice Left = 25 Height = 19 Top = 12 Width = 48 BorderSpacing.Left = 24 BorderSpacing.Top = 11 Caption = 'Advice' ParentColor = False end object LabelAdvice1: TLabel AnchorSideLeft.Control = LabelAdvice AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = LabelAdvice AnchorSideTop.Side = asrCenter Left = 93 Height = 19 Top = 12 Width = 95 BorderSpacing.Left = 20 Caption = 'LabelAdvice1' ParentColor = False end object LabelAdvice2: TLabel AnchorSideLeft.Control = LabelAdvice1 AnchorSideTop.Control = LabelAdvice1 AnchorSideTop.Side = asrBottom Left = 93 Height = 19 Top = 36 Width = 95 BorderSpacing.Top = 5 Caption = 'LabelAdvice2' ParentColor = False end end object Label6: TLabel AnchorSideLeft.Control = Panel2 AnchorSideTop.Side = asrBottom AnchorSideBottom.Control = Panel1 AnchorSideBottom.Side = asrBottom Left = 22 Height = 19 Top = 368 Width = 354 Anchors = [akLeft, akBottom] BorderSpacing.Top = 6 BorderSpacing.Bottom = 5 Caption = 'Upload means from tomboy-ng to Android Device' ParentColor = False end end object ButtonSync: TButton AnchorSideRight.Control = ButtonClose AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 607 Height = 45 Top = 395 Width = 120 Anchors = [akRight, akBottom] Caption = 'Sync' OnClick = ButtonSyncClick TabOrder = 3 end object ButtonHelp: TButton AnchorSideRight.Control = ButtonJoin AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 367 Height = 45 Top = 395 Width = 120 Anchors = [akRight, akBottom] Caption = 'Help' OnClick = ButtonHelpClick TabOrder = 1 end object ButtonJoin: TButton AnchorSideRight.Control = ButtonSync AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 487 Height = 45 Top = 395 Width = 120 Anchors = [akRight, akBottom] Caption = 'Join' OnClick = ButtonJoinClick TabOrder = 2 end object ButtonOldSSH: TButton AnchorSideTop.Control = ButtonHelp AnchorSideRight.Control = ButtonHelp AnchorSideBottom.Control = ButtonHelp AnchorSideBottom.Side = asrBottom Left = 200 Height = 45 Top = 395 Width = 167 Anchors = [akTop, akLeft, akRight, akBottom] Caption = 'Use old SSH model' OnClick = ButtonOldSSHClick TabOrder = 0 end end tomboy-ng_0.34-1/source/Tomboy_NG.lpi0000644000175000017500000010646714145033507017276 0ustar dbannondbannon <Scaled Value="True"/> <ResourceType Value="res"/> <UseXPManifest Value="True"/> <XPManifest> <DpiAware Value="True"/> <TextName Value="DRB"/> <TextDesc Value=""/> </XPManifest> <Icon Value="0"/> </General> <i18n> <EnableI18N Value="True"/> <OutDir Value="../po"/> <ExcludedIdentifiers Count="5"> <Item1 Value="LabelToken"/> <Item2 Value="Index out of bounds"/> <Item3 Value="Node is not a container"/> <Item4 Value="Error while parsing text"/> <Item5 Value="Root node must be an array or object"/> </ExcludedIdentifiers> <ExcludedOriginals Count="63"> <Item1 Value="LabelToken"/> <Item2 Value="Index out of bounds"/> <Item3 Value="Node is not a container"/> <Item4 Value="Error while parsing text"/> <Item5 Value="Root node must be an array or object"/> <Item6 Value="Form Caption"/> <Item7 Value="LabelAdvice1"/> <Item8 Value="LabelAdvice2"/> <Item9 Value="Advice"/> <Item10 Value="EditSearch"/> <Item11 Value="EditBoxForm"/> <Item12 Value="LabelSearchInfo"/> <Item13 Value="FormColours"/> <Item14 Value="FormRecover"/> <Item15 Value="LabelFileSyncInfo1"/> <Item16 Value="LabelFileSyncInfo2"/> <Item17 Value="PanelSearch"/> <Item18 Value="Form Caption"/> <Item19 Value="TimeEdit1"/> <Item20 Value="Label1"/> <Item21 Value="LabelExistingAdvice"/> <Item22 Value="LabelExistingAdvice2"/> <Item23 Value="LabelNoteErrors"/> <Item24 Value="Label2"/> <Item25 Value="Label7"/> <Item26 Value="Panel3"/> <Item27 Value="0.0.0.0"/> <Item28 Value="EditProfileName"/> <Item29 Value="LabelServerID"/> <Item30 Value="Panel1"/> <Item31 Value="Panel2"/> <Item32 Value="LabelNoDismiss1"/> <Item33 Value="LabelNoDismiss2"/> <Item34 Value="NoteBookPick"/> <Item35 Value="Label3"/> <Item36 Value="LabelContext"/> <Item37 Value="LabelDic"/> <Item38 Value="LabelDicPrompt"/> <Item39 Value="LabelDicStatus"/> <Item40 Value="LabelError"/> <Item41 Value="LabelLibrary"/> <Item42 Value="LabelLibraryStatus"/> <Item43 Value="LabelNotesPath"/> <Item44 Value="LabelSettingPath"/> <Item45 Value="LabelStatus"/> <Item46 Value="LabelSuspect"/> <Item47 Value="LabelWaitForSync"/> <Item48 Value="Label15"/> <Item49 Value="tsett.label10.caption"/> <Item50 Value="tsett.label11.caption"/> <Item51 Value="x"/> <Item52 Value="X"/> <Item53 Value="FormMarkdown"/> <Item54 Value="FormRollBack"/> <Item55 Value="LabelOpn"/> <Item56 Value="LabelOpnTitle"/> <Item57 Value="Labelttl"/> <Item58 Value="LabelttlTitle"/> <Item59 Value="LabelRemote"/> <Item60 Value="LabelLocal"/> <Item61 Value="LabelBadNoteAdvice"/> <Item62 Value="LabelFileSyncinfo1"/> <Item63 Value="LabelFileSyncinfo2"/> </ExcludedOriginals> </i18n> <BuildModes Count="18"> <Item1 Name="Default" Default="True"/> <Item2 Name="Debug"> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <Parsing> <SyntaxOptions> <IncludeAssertionCode Value="True"/> </SyntaxOptions> </Parsing> <CodeGeneration> <Checks> <IOChecks Value="True"/> <RangeChecks Value="True"/> <OverflowChecks Value="True"/> <StackChecks Value="True"/> </Checks> <VerifyObjMethodCallValidity Value="True"/> <Optimizations> <OptimizationLevel Value="0"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <DebugInfoType Value="dsDwarf2Set"/> <UseHeaptrc Value="True"/> <TrashVariables Value="True"/> </Debugging> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <CompilerMessages> <IgnoredMessages idx6058="True" idx5024="True"/> </CompilerMessages> <OtherDefines Count="4"> <Define0 Value="DisableLCLGIF"/> <Define1 Value="DisableLCLJPEG"/> <Define2 Value="DisableLCLPNM"/> <Define3 Value="DisableLCLTIFF"/> </OtherDefines> </Other> </CompilerOptions> </Item2> <Item3 Name="ReleaseLin64"> <MacroValues Count="1"> <Macro2 Name="LCLWidgetType" Value="gtk2"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng-64"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <SmartLinkUnit Value="True"/> <Optimizations> <OptimizationLevel Value="3"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> <DebugInfoType Value="dsDwarf3"/> <UseLineInfoUnit Value="False"/> </Debugging> <LinkSmart Value="True"/> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <Verbosity> <ShowHints Value="False"/> </Verbosity> <CompilerMessages> <IgnoredMessages idx6058="True"/> </CompilerMessages> <CustomOptions Value="-dDisableLCLGIF -dDisableLCLJPEG -dDisableLCLPNM -dDisableLCLTIFF"/> <OtherDefines Count="4"> <Define0 Value="DisableLCLGIF"/> <Define1 Value="DisableLCLJPEG"/> <Define2 Value="DisableLCLPNM"/> <Define3 Value="DisableLCLTIFF"/> </OtherDefines> </Other> </CompilerOptions> </Item3> <Item4 Name="ReleaseLin32"> <MacroValues Count="1"> <Macro2 Name="LCLWidgetType" Value="gtk2"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng-32"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <SmartLinkUnit Value="True"/> <TargetProcessor Value="80386"/> <TargetCPU Value="i386"/> <TargetOS Value="linux"/> <Optimizations> <OptimizationLevel Value="3"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> </Debugging> <LinkSmart Value="True"/> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <Verbosity> <ShowTriedFiles Value="True"/> </Verbosity> <CompilerMessages> <IgnoredMessages idx6058="True"/> </CompilerMessages> </Other> </CompilerOptions> </Item4> <Item5 Name="ReleaseWin64"> <MacroValues Count="1"> <Macro1 Name="LCLWidgetType" Value="win32"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng-64"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <SmartLinkUnit Value="True"/> <TargetCPU Value="x86_64"/> <TargetOS Value="win64"/> <Optimizations> <OptimizationLevel Value="3"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> </Debugging> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <Verbosity> <ShowHints Value="False"/> </Verbosity> <CompilerMessages> <IgnoredMessages idx6058="True"/> </CompilerMessages> <CompilerPath Value="ppcrossx64"/> </Other> </CompilerOptions> </Item5> <Item6 Name="ReleaseWin32"> <MacroValues Count="1"> <Macro1 Name="LCLWidgetType" Value="win32"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng-32"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <SmartLinkUnit Value="True"/> <TargetCPU Value="i386"/> <TargetOS Value="win32"/> <Optimizations> <OptimizationLevel Value="3"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> <UseLineInfoUnit Value="False"/> </Debugging> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <Verbosity> <ShowHints Value="False"/> </Verbosity> <CompilerMessages> <IgnoredMessages idx6058="True"/> </CompilerMessages> <CompilerPath Value="fpc"/> </Other> </CompilerOptions> </Item6> <Item7 Name="ReleaseRasPi"> <MacroValues Count="1"> <Macro2 Name="LCLWidgetType" Value="gtk2"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng-armhf"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <TargetCPU Value="arm"/> <Optimizations> <OptimizationLevel Value="0"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> <DebugInfoType Value="dsDwarf2Set"/> <UseLineInfoUnit Value="False"/> </Debugging> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <CompilerMessages> <IgnoredMessages idx6058="True" idx5024="True"/> </CompilerMessages> </Other> </CompilerOptions> </Item7> <Item8 Name="CocoaRelease"> <MacroValues Count="1"> <Macro5 Name="LCLWidgetType" Value="cocoa"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <SmartLinkUnit Value="True"/> <TargetCPU Value="x86_64"/> <Optimizations> <OptimizationLevel Value="3"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> <DebugInfoType Value="dsDwarf2Set"/> </Debugging> <LinkSmart Value="True"/> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <Verbosity> <ShowHints Value="False"/> </Verbosity> <CompilerMessages> <IgnoredMessages idx6058="True"/> </CompilerMessages> <CompilerPath Value="/usr/local/bin/ppcx64"/> </Other> </CompilerOptions> </Item8> <Item9 Name="CocoaDebug"> <MacroValues Count="1"> <Macro5 Name="LCLWidgetType" Value="cocoa"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <SmartLinkUnit Value="True"/> <TargetCPU Value="x86_64"/> </CodeGeneration> <Linking> <Debugging> <DebugInfoType Value="dsDwarf3"/> <UseHeaptrc Value="True"/> </Debugging> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <CompilerPath Value="fpc"/> </Other> </CompilerOptions> </Item9> <Item10 Name="CarbonDebug"> <MacroValues Count="1"> <Macro6 Name="LCLWidgetType" Value="carbon"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <Parsing> <SyntaxOptions> <IncludeAssertionCode Value="True"/> </SyntaxOptions> </Parsing> <CodeGeneration> <Checks> <IOChecks Value="True"/> <RangeChecks Value="True"/> <OverflowChecks Value="True"/> <StackChecks Value="True"/> </Checks> <VerifyObjMethodCallValidity Value="True"/> <TargetCPU Value="i386"/> </CodeGeneration> <Linking> <Debugging> <DebugInfoType Value="dsDwarf2Set"/> <UseHeaptrc Value="True"/> <TrashVariables Value="True"/> <UseExternalDbgSyms Value="True"/> </Debugging> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <CompilerMessages> <IgnoredMessages idx5024="True"/> </CompilerMessages> </Other> </CompilerOptions> </Item10> <Item11 Name="CarbonRelease"> <MacroValues Count="1"> <Macro6 Name="LCLWidgetType" Value="carbon"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <TargetCPU Value="i386"/> <Optimizations> <OptimizationLevel Value="3"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> <DebugInfoType Value="dsDwarf2Set"/> <UseLineInfoUnit Value="False"/> <UseExternalDbgSyms Value="True"/> </Debugging> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <CompilerMessages> <IgnoredMessages idx5024="True"/> </CompilerMessages> </Other> </CompilerOptions> </Item11> <Item12 Name="QT5Debug"> <MacroValues Count="1"> <Macro4 Name="LCLWidgetType" Value="qt5"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng-qt"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <SmartLinkUnit Value="True"/> </CodeGeneration> <Linking> <Debugging> <UseHeaptrc Value="True"/> </Debugging> <LinkSmart Value="True"/> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <Verbosity> <ShowHints Value="False"/> </Verbosity> <CompilerMessages> <IgnoredMessages idx6058="True"/> </CompilerMessages> <CustomOptions Value="-dDisableLCLGIF -dDisableLCLJPEG -dDisableLCLPNM -dDisableLCLTIFF"/> </Other> </CompilerOptions> </Item12> <Item13 Name="LeakCheckWin64"> <MacroValues Count="1"> <Macro1 Name="LCLWidgetType" Value="win32"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng64"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <SmartLinkUnit Value="True"/> <TargetCPU Value="x86_64"/> <TargetOS Value="win64"/> <Optimizations> <OptimizationLevel Value="3"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> <UseHeaptrc Value="True"/> </Debugging> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <Verbosity> <ShowHints Value="False"/> </Verbosity> <CompilerPath Value="/usr/bin/ppcrossx64"/> </Other> </CompilerOptions> </Item13> <Item14 Name="LeakCheckWin32"> <MacroValues Count="1"> <Macro1 Name="LCLWidgetType" Value="win32"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng32"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <SmartLinkUnit Value="True"/> <TargetCPU Value="i386"/> </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> <UseLineInfoUnit Value="False"/> <UseHeaptrc Value="True"/> </Debugging> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <Verbosity> <ShowHints Value="False"/> </Verbosity> <CompilerPath Value="/usr/bin/fpc"/> </Other> </CompilerOptions> </Item14> <Item15 Name="LeakCheckLin32"> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng32"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <SmartLinkUnit Value="True"/> <TargetProcessor Value="80386"/> <TargetCPU Value="i386"/> <TargetOS Value="linux"/> <Optimizations> <OptimizationLevel Value="3"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> <UseHeaptrc Value="True"/> </Debugging> <LinkSmart Value="True"/> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <Verbosity> <ShowTriedFiles Value="True"/> </Verbosity> </Other> </CompilerOptions> </Item15> <Item16 Name="LeakCheckLin64"> <MacroValues Count="1"> <Macro2 Name="LCLWidgetType" Value="gtk2"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <SmartLinkUnit Value="True"/> <TargetCPU Value="x86_64"/> <TargetOS Value="linux"/> <Optimizations> <OptimizationLevel Value="3"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> <UseHeaptrc Value="True"/> </Debugging> <LinkSmart Value="True"/> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <Verbosity> <ShowTriedFiles Value="True"/> </Verbosity> </Other> </CompilerOptions> </Item16> <Item17 Name="GTK3"> <MacroValues Count="1"> <Macro3 Name="LCLWidgetType" Value="gtk3"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <SmartLinkUnit Value="True"/> </CodeGeneration> <Linking> <Debugging> <UseHeaptrc Value="True"/> </Debugging> <LinkSmart Value="True"/> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <Verbosity> <ShowHints Value="False"/> </Verbosity> <CustomOptions Value="-dDisableLCLGIF -dDisableLCLJPEG -dDisableLCLPNM -dDisableLCLTIFF"/> </Other> </CompilerOptions> </Item17> <Item18 Name="ReleaseQT5"> <MacroValues Count="1"> <Macro4 Name="LCLWidgetType" Value="qt5"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng-qt-64"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <SmartLinkUnit Value="True"/> <TargetCPU Value="x86_64"/> <TargetOS Value="linux"/> <Optimizations> <OptimizationLevel Value="3"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> <UseLineInfoUnit Value="False"/> </Debugging> <LinkSmart Value="True"/> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <Verbosity> <ShowHints Value="False"/> </Verbosity> <CompilerMessages> <IgnoredMessages idx6058="True"/> </CompilerMessages> <CustomOptions Value="-dDisableLCLGIF -dDisableLCLJPEG -dDisableLCLPNM -dDisableLCLTIFF"/> </Other> </CompilerOptions> </Item18> <SharedMatrixOptions Count="6"> <Item1 ID="036726732034" Modes="ReleaseWin32,LeakCheckWin32,ReleaseWin64,LeakCheckWin64" Type="IDEMacro" MacroName="LCLWidgetType" Value="win32"/> <Item2 ID="418982182673" Modes="LeakCheckLin64,ReleaseRasPi,ReleaseLin64,ReleaseLin32" Type="IDEMacro" MacroName="LCLWidgetType" Value="gtk2"/> <Item3 ID="429153174386" Modes="GTK3" Type="IDEMacro" MacroName="LCLWidgetType" Value="gtk3"/> <Item4 ID="950048283013" Modes="QT5Debug,ReleaseQT5" Type="IDEMacro" MacroName="LCLWidgetType" Value="qt5"/> <Item5 ID="341789512381" Modes="CocoaDebug,CocoaRelease" Type="IDEMacro" MacroName="LCLWidgetType" Value="cocoa"/> <Item6 ID="231441956052" Modes="CarbonRelease,CarbonDebug" Type="IDEMacro" MacroName="LCLWidgetType" Value="carbon"/> </SharedMatrixOptions> </BuildModes> <PublishOptions> <Version Value="2"/> <DestinationDirectory Value="$(ProjPath)/published/"/> </PublishOptions> <RunParams> <local> <CommandLineParams Value="--config-dir=/home/dbannon/.config/tomboy-ng-small"/> </local> <environment> <UserOverrides Count="1"> <Variable0 Name="LAZUSEAPPIND" Value="info"/> </UserOverrides> </environment> <FormatVersion Value="2"/> <Modes Count="1"> <Mode0 Name="default"> <local> <CommandLineParams Value="--config-dir=/home/dbannon/.config/tomboy-ng-small"/> </local> <environment> <UserOverrides Count="1"> <Variable0 Name="LAZUSEAPPIND" Value="info"/> </UserOverrides> </environment> </Mode0> </Modes> </RunParams> <RequiredPackages Count="3"> <Item1> <PackageName Value="Printer4Lazarus"/> </Item1> <Item2> <PackageName Value="KControlsLaz"/> </Item2> <Item3> <PackageName Value="LCL"/> </Item3> </RequiredPackages> <Units Count="39"> <Unit0> <Filename Value="Tomboy_NG.lpr"/> <IsPartOfProject Value="True"/> </Unit0> <Unit1> <Filename Value="searchunit.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="SearchForm"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> <UnitName Value="SearchUnit"/> </Unit1> <Unit2> <Filename Value="editbox.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="EditBoxForm"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> <UnitName Value="EditBox"/> </Unit2> <Unit3> <Filename Value="savenote.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="SaveNote"/> </Unit3> <Unit4> <Filename Value="loadnote.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="LoadNote"/> </Unit4> <Unit5> <Filename Value="settings.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="Sett"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> </Unit5> <Unit6> <Filename Value="syncgui.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="FormSync"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> <UnitName Value="SyncGUI"/> </Unit6> <Unit7> <Filename Value="notebook.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="NoteBookPick"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> <UnitName Value="Notebook"/> </Unit7> <Unit8> <Filename Value="spelling.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="FormSpell"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> <UnitName Value="Spelling"/> </Unit8> <Unit9> <Filename Value="mainunit.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="MainForm"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> <UnitName Value="Mainunit"/> </Unit9> <Unit10> <Filename Value="backupview.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="FormBackupView"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> <UnitName Value="BackupView"/> </Unit10> <Unit11> <Filename Value="recover.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="FormRecover"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> </Unit11> <Unit12> <Filename Value="tomdroidfile.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="FormTomdroidFile"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> <UnitName Value="tomdroidFile"/> </Unit12> <Unit13> <Filename Value="index.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="FormIndex"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> <UnitName Value="Index"/> </Unit13> <Unit14> <Filename Value="autostart.pas"/> <IsPartOfProject Value="True"/> </Unit14> <Unit15> <Filename Value="note_lister.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="Note_Lister"/> </Unit15> <Unit16> <Filename Value="syncutils.pas"/> <IsPartOfProject Value="True"/> </Unit16> <Unit17> <Filename Value="sync.pas"/> <IsPartOfProject Value="True"/> </Unit17> <Unit18> <Filename Value="hunspell.pas"/> <IsPartOfProject Value="True"/> </Unit18> <Unit19> <Filename Value="transandroid.pas"/> <IsPartOfProject Value="True"/> </Unit19> <Unit20> <Filename Value="k_prn.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="K_Prn"/> </Unit20> <Unit21> <Filename Value="tb_sdiff.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="FormSDiff"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> <UnitName Value="TB_SDiff"/> </Unit21> <Unit22> <Filename Value="trans.pas"/> <IsPartOfProject Value="True"/> </Unit22> <Unit23> <Filename Value="transfile.pas"/> <IsPartOfProject Value="True"/> </Unit23> <Unit24> <Filename Value="resourcestr.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="ResourceStr"/> </Unit24> <Unit25> <Filename Value="colours.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="FormColours"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> </Unit25> <Unit26> <Filename Value="cli.pas"/> <IsPartOfProject Value="True"/> </Unit26> <Unit27> <Filename Value="libnotify.pas"/> <IsPartOfProject Value="True"/> </Unit27> <Unit28> <Filename Value="rollback.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="FormRollBack"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> <UnitName Value="RollBack"/> </Unit28> <Unit29> <Filename Value="transfileand.pas"/> <IsPartOfProject Value="True"/> </Unit29> <Unit30> <Filename Value="tb_utils.pas"/> <IsPartOfProject Value="True"/> </Unit30> <Unit31> <Filename Value="tomdroid.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="FormTomdroid"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> </Unit31> <Unit32> <Filename Value="commonmark.pas"/> <IsPartOfProject Value="True"/> </Unit32> <Unit33> <Filename Value="tbundo.pas"/> <IsPartOfProject Value="True"/> </Unit33> <Unit34> <Filename Value="hunspell.inc"/> <IsPartOfProject Value="True"/> </Unit34> <Unit35> <Filename Value="notenormal.pas"/> <IsPartOfProject Value="True"/> </Unit35> <Unit36> <Filename Value="transgithub.pas"/> <IsPartOfProject Value="True"/> </Unit36> <Unit37> <Filename Value="import_notes.pas"/> <IsPartOfProject Value="True"/> </Unit37> <Unit38> <Filename Value="jsontools.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="JsonTools"/> </Unit38> </Units> </ProjectOptions> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <SmartLinkUnit Value="True"/> <TargetCPU Value="x86_64"/> <Optimizations> <OptimizationLevel Value="0"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> <DebugInfoType Value="dsDwarf2Set"/> </Debugging> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <CompilerMessages> <IgnoredMessages idx6058="True"/> </CompilerMessages> </Other> </CompilerOptions> </CONFIG> ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������tomboy-ng_0.34-1/source/spelling.lrj����������������������������������������������������������������0000644�0001750�0001750�00000003253�14145033507�017246� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������{"version":1,"strings":[ {"hash":5925932,"name":"tformspell.caption","sourcebytes":[83,112,101,108,108],"value":"Spell"}, {"hash":165180142,"name":"tformspell.labelprompt.caption","sourcebytes":[67,108,105,99,107,32,97,32,119,111,114,100,32,116,111,32,117,115,101,32,105,116,46],"value":"Click a word to use it."}, {"hash":192952813,"name":"tformspell.label4.caption","sourcebytes":[83,117,115,112,101,99,116,32,119,111,114,100,32,45],"value":"Suspect word -"}, {"hash":267249588,"name":"tformspell.labelsuspect.caption","sourcebytes":[76,97,98,101,108,83,117,115,112,101,99,116],"value":"LabelSuspect"}, {"hash":125781284,"name":"tformspell.buttonuseandnextword.caption","sourcebytes":[85,115,101,32,97,110,100,32,78,101,120,116,32,87,111,114,100],"value":"Use and Next Word"}, {"hash":33092355,"name":"tformspell.labelstatus.caption","sourcebytes":[76,97,98,101,108,83,116,97,116,117,115],"value":"LabelStatus"}, {"hash":226631924,"name":"tformspell.labelcontext.caption","sourcebytes":[76,97,98,101,108,67,111,110,116,101,120,116],"value":"LabelContext"}, {"hash":136098853,"name":"tformspell.buttonskip.hint","sourcebytes":[83,107,105,112,32,106,117,115,116,32,116,104,105,115,32,105,110,115,116,97,110,99,101],"value":"Skip just this instance"}, {"hash":369152,"name":"tformspell.buttonskip.caption","sourcebytes":[83,107,105,112],"value":"Skip"}, {"hash":258652622,"name":"tformspell.buttonignore.hint","sourcebytes":[73,103,110,111,114,101,32,97,108,108,32,105,110,115,116,97,110,99,101,115,32,102,111,114,32,116,104,101,32,114,117,110],"value":"Ignore all instances for the run"}, {"hash":83777157,"name":"tformspell.buttonignore.caption","sourcebytes":[73,103,110,111,114,101],"value":"Ignore"} ]} �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������tomboy-ng_0.34-1/source/recover.lfm�����������������������������������������������������������������0000644�0001750�0001750�00000023010�14145033507�017056� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������object FormRecover: TFormRecover Left = 616 Height = 561 Top = 187 Width = 758 Caption = 'FormRecover' ClientHeight = 561 ClientWidth = 758 OnCreate = FormCreate OnDestroy = FormDestroy OnShow = FormShow LCLVersion = '2.1.0.0' object Label1: TLabel Left = 8 Height = 19 Top = 360 Width = 47 Caption = 'Label1' ParentColor = False end object ListBoxSnapshots: TListBox AnchorSideLeft.Control = Owner AnchorSideTop.Control = PanelSnapshots AnchorSideTop.Side = asrBottom AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 2 Height = 287 Hint = 'These are the currently known snapshots. ' Top = 274 Width = 278 Anchors = [akTop, akLeft, akBottom] BorderSpacing.Left = 2 BorderSpacing.Top = 2 ItemHeight = 0 OnClick = ListBoxSnapshotsClick OnDblClick = ListBoxSnapshotsDblClick ParentShowHint = False ScrollWidth = 276 ShowHint = True TabOrder = 0 TopIndex = -1 end object PageControl1: TPageControl AnchorSideLeft.Control = Owner AnchorSideTop.Control = Panel1 AnchorSideTop.Side = asrBottom AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom Left = 0 Height = 204 Top = 44 Width = 758 ActivePage = TabSheetRecoverNotes Anchors = [akTop, akLeft, akRight] TabIndex = 2 TabOrder = 1 object TabSheetIntro: TTabSheet Caption = 'Introduction' ClientHeight = 167 ClientWidth = 752 OnShow = TabSheetIntroShow object Label6: TLabel Left = 8 Height = 19 Top = 8 Width = 397 Caption = 'This tool might help you recover lost or damaged notes.' ParentColor = False end object Label7: TLabel Left = 8 Height = 19 Top = 64 Width = 408 Caption = 'Before you start, take a Snapshot of your notes directory.' ParentColor = False end object Label10: TLabel Left = 8 Height = 19 Top = 36 Width = 306 Caption = 'Please close any notes you may have open.' ParentColor = False end object ButtonMakeSafetySnap: TButton AnchorSideTop.Control = ButtonSnapHelp AnchorSideRight.Control = ButtonSnapHelp AnchorSideBottom.Control = TabSheetIntro AnchorSideBottom.Side = asrBottom Left = 450 Height = 31 Hint = 'Take a initial snapshot of your notes and config. Overwritten each time.' Top = 136 Width = 183 Anchors = [akTop, akRight, akBottom] AutoSize = True BorderSpacing.Right = 2 Caption = 'Take a manual Snapshot' OnClick = ButtonMakeSafetySnapClick ParentShowHint = False ShowHint = True TabOrder = 0 end object ButtonSnapHelp: TButton AnchorSideTop.Control = TabSheetIntro AnchorSideRight.Control = TabSheetIntro AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = TabSheetIntro AnchorSideBottom.Side = asrBottom Left = 635 Height = 31 Top = 136 Width = 115 Anchors = [akRight, akBottom] AutoSize = True BorderSpacing.Top = 2 BorderSpacing.Right = 2 Caption = 'Snapshot Help' OnClick = ButtonSnapHelpClick TabOrder = 1 end end object TabSheetBadNotes: TTabSheet Caption = 'Bad Notes' ClientHeight = 167 ClientWidth = 752 OnShow = TabSheetBadNotesShow object Label5: TLabel Left = 8 Height = 19 Top = 8 Width = 266 Caption = 'Looking for notes with damaged XML' ParentColor = False end object ButtonDeleteBadNotes: TButton AnchorSideRight.Control = TabSheetBadNotes AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = TabSheetBadNotes AnchorSideBottom.Side = asrBottom Left = 612 Height = 31 Top = 136 Width = 138 Anchors = [akTop, akRight, akBottom] AutoSize = True BorderSpacing.Right = 2 Caption = 'Delete Bad Notes' OnClick = ButtonDeleteBadNotesClick TabOrder = 0 end object LabelNoteErrors: TLabel Left = 8 Height = 19 Top = 36 Width = 117 Caption = 'LabelNoteErrors' ParentColor = False end object LabelExistingAdvice: TLabel Left = 10 Height = 19 Top = 64 Width = 142 Caption = 'LabelExistingAdvice' ParentColor = False end object LabelExistingAdvice2: TLabel Left = 11 Height = 19 Top = 92 Width = 151 Caption = 'LabelExistingAdvice2' ParentColor = False end end object TabSheetRecoverNotes: TTabSheet Caption = 'Recover Notes' ClientHeight = 167 ClientWidth = 752 OnShow = TabSheetRecoverNotesShow object Label9: TLabel Left = 10 Height = 19 Top = 8 Width = 373 Caption = 'From here you can view snapshot notes, one by one.' ParentColor = False end object Label14: TLabel Left = 10 Height = 19 Top = 36 Width = 327 Caption = 'Click an available snapshot to see its contents.' ParentColor = False end object Label16: TLabel Left = 11 Height = 19 Top = 64 Width = 394 Caption = 'You may chose to view, copy and paste into a new note.' ParentColor = False end end object TabSheetMergeSnapshot: TTabSheet Caption = 'Merge Snapshot' ClientHeight = 167 ClientWidth = 752 Enabled = False OnShow = TabSheetMergeSnapshotShow TabVisible = False object Label3: TLabel Left = 9 Height = 19 Top = 8 Width = 551 Caption = 'Restore any notes in the snapshot that are not in the existing notes directory.' ParentColor = False end end object TabSheetRecoverSnapshot: TTabSheet Caption = 'Recover Snapshot' ClientHeight = 167 ClientWidth = 752 OnShow = TabSheetRecoverSnapshotShow object Label4: TLabel Left = 8 Height = 19 Top = 8 Width = 427 Caption = 'Remove all existing notes and use the ones in the Snapshot.' ParentColor = False end object ButtonRecoverSnap: TButton AnchorSideTop.Control = TabSheetRecoverSnapshot AnchorSideRight.Control = TabSheetRecoverSnapshot AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = TabSheetRecoverSnapshot AnchorSideBottom.Side = asrBottom Left = 603 Height = 33 Top = 134 Width = 147 Anchors = [akRight, akBottom] BorderSpacing.Top = 2 BorderSpacing.Right = 2 Caption = 'Recover' OnClick = ButtonRecoverSnapClick TabOrder = 0 end object Label12: TLabel Left = 8 Height = 19 Top = 36 Width = 500 Caption = 'Don''t even consider this unless you have a backup Snapshot, Intro Tab.' ParentColor = False end object Label15: TLabel Left = 8 Height = 19 Top = 64 Width = 288 Caption = 'Click an available snapshot, click Recover' ParentColor = False end end end object Panel1: TPanel AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom Left = 0 Height = 44 Top = 0 Width = 758 Anchors = [akTop, akLeft, akRight] ClientHeight = 44 ClientWidth = 758 TabOrder = 2 object Label2: TLabel Left = 40 Height = 22 Top = 8 Width = 369 Caption = 'Please be careful, this is a dangerous place!' Font.Height = -19 ParentColor = False ParentFont = False end end object StringGridNotes: TStringGrid AnchorSideLeft.Control = ListBoxSnapshots AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = PanelNoteList AnchorSideTop.Side = asrBottom AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 282 Height = 287 Top = 274 Width = 476 Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Left = 2 BorderSpacing.Top = 2 Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goColSizing, goSmoothScroll] TabOrder = 3 OnDblClick = StringGridNotesDblClick end object PanelSnapshots: TPanel AnchorSideLeft.Control = Owner AnchorSideTop.Control = PageControl1 AnchorSideTop.Side = asrBottom AnchorSideRight.Control = ListBoxSnapshots AnchorSideRight.Side = asrBottom Left = 0 Height = 24 Top = 248 Width = 280 Anchors = [akTop, akLeft, akRight] Caption = 'Available Snapshots' TabOrder = 4 end object PanelNoteList: TPanel AnchorSideLeft.Control = StringGridNotes AnchorSideTop.Control = PageControl1 AnchorSideTop.Side = asrBottom AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = PanelSnapshots AnchorSideBottom.Side = asrBottom Left = 282 Height = 24 Top = 248 Width = 476 Anchors = [akTop, akLeft, akRight, akBottom] TabOrder = 5 end end ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������tomboy-ng_0.34-1/source/colours.lrj�����������������������������������������������������������������0000644�0001750�0001750�00000002302�14145033507�017111� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������{"version":1,"strings":[ {"hash":170919299,"name":"tformcolours.caption","sourcebytes":[70,111,114,109,67,111,108,111,117,114,115],"value":"FormColours"}, {"hash":93865765,"name":"tformcolours.label1.caption","sourcebytes":[83,97,109,112,108,101],"value":"Sample"}, {"hash":169650899,"name":"tformcolours.label2.caption","sourcebytes":[83,101,116,32,67,111,108,111,117,114,115],"value":"Set Colours"}, {"hash":5966629,"name":"tformcolours.speedtitle.caption","sourcebytes":[84,105,116,108,101],"value":"Title"}, {"hash":371956,"name":"tformcolours.speedtext.caption","sourcebytes":[84,101,120,116],"value":"Text"}, {"hash":32370148,"name":"tformcolours.speedbackground.caption","sourcebytes":[66,97,99,107,103,114,111,117,110,100],"value":"Background"}, {"hash":234009348,"name":"tformcolours.speedhighlight.caption","sourcebytes":[72,105,103,104,108,105,103,104,116],"value":"Highlight"}, {"hash":180128884,"name":"tformcolours.speeddefault.caption","sourcebytes":[68,101,102,97,117,108,116],"value":"Default"}, {"hash":77089212,"name":"tformcolours.speedcancel.caption","sourcebytes":[67,97,110,99,101,108],"value":"Cancel"}, {"hash":1339,"name":"tformcolours.speedok.caption","sourcebytes":[79,75],"value":"OK"} ]} ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������tomboy-ng_0.34-1/source/settings.pas����������������������������������������������������������������0000644�0001750�0001750�00000211626�14145033507�017272� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������unit settings; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ This form represents all the settings and will have most (?) of the constants. Makes sense for all units to 'use' this unit, ideally in the implmentation section. Launcher for Sync Engines, Backup, Snapshot RollBack systems. } { HISTORY 2017/9/27 - Created 2017/10/10 - added ability to set fonts to small, medium and big 2017/10/15 - gave the setting form Tabs, lot less cluttered. 2017/11/25 - added a button to notes path config to use the 'default' path that is, similar to what tomboy does. Code to make that path. 2017/11/28 - put a ; after a line of windows only code. 2017/12/08 - changed size of Mediun normal font, one size smaller 2017/12/28 - extensive changes so this form is now Main form. This is because Cocoa cannot handle Hide() in main form OnShow event. This makes more sense anyway. 2017/12/28 - Small change to force a Note Directory if user browses away from Settings screen that urges them to set it first ! Sigh... 2017/12/29 Further force of a Note Directory. 2017/12/30 We now set Search box lablepath after setting up a NotesPath Added a caption to tell user we are setting up sync. 2017/12/30 Added a call to IndexNotes after setting up sync, potentially slow. 2018/01/25 Changes to support Notebooks 2018/02/04 Added a Main menu because Macs work better with one. 2018/02/09 Added a means save export path but only until app exits, not saved to disk. 2018/02/14 Added check boxes to control search box 2018/02/23 Added capabily to configure spell check. 2018/03/18 Added a close button (really a hide button) and an ifdef to close on the Mac when ever asked to do so. Have disabled close icon but seems it still works on Linux but not mac, so thats OK (but funny). Issue #25 relates, untested. 2018/03/24 Added some checks to make sure spell libary and dictionary mentioned in config file is still valid. 2018/05/12 Extensive changes - MainUnit is now just that. 2018/05/20 NeedRefresh to indicate when need to refresh menus and mainform status. 2018/05/23 Added /usr/share/myspell/ to linux dictionary search path. Enabled Save button after dictionary selection. 2018/06/06 Substantial changes. Now create config dir at form creation. User no longer manually saves, config file is updated at each change. Extensive checks of config and notes directory before proceeding. 2018/06/14 Moved call to CheckSpelling() from OnShow to OnCreate. Select MediumFont in default settings. 2018/07/22 Removed an errant editbox that somehow appeared over small font button. 2018/08/18 Now call SpellCheck() after loading settings. Note, if settings file has an old library name and hunspell can find a new one, nothing is updated ! 2018/08/23 Ensured that an ini file without a notedir returns a sensible value, TEST 2018/10/28 Much changes, support Backup management, snapshots and new sync Model. 2018/11/01 Ensure we have a valid Spell, even after a hide ! 2018/11/05 Set default tab. 2018/11/29 Change Spelling UI when selecting Library and Dictionary 2018/12/03 Added show splash screen to settings, -g or an indexing error will force show 2018/12/03 disable checkshowTomdroid on all except Linux 2019/03/19 Added setting option to show search box at startup 2019/04/07 Restructured Main and Popup menus. Untested Win/Mac. 2019/04/13 Almost rid of NeedRefresh, SearchForm.IndexNotes() instead. 2019/04/27 Fix for Huge display font. 2019/05/06 Support saving pos and open on startup in note. 2019/05/14 Display strings all (?) moved to resourcestrings 2019/06/11 Moved some checkboxes and renamed 'Display' to 'Notes'. 2019/09/6 Button to download Help Notes in non-English 2019/09/07 User can now select a note font. 2019/12/18 Moved LinkScanRange to EditBox 2019/12/20 Ensure we have UsualFont set to something even during first start. 2019/12/24 Ensure we don't try to sync if its not yet setup. 2020/03/02 Force our guess fixed font if no config file. 2020/03/08 Don't call search refreshMenu(mkFileMenu after an initial sync, no need 2020/03/30 Added code to allow user to set display colours. 2020/04/07 As well as forcing Linux AltHelpNotes into config dir, must also do Windows ! 2020/04/08 Added some code to support SyncNextCloud, see define SHOW_NET_SYNC top of implementation section. 2020/04/10 Added Net and File sync mode to settings file, make labels consistent 2020/04/28 Put four random digits in place of the '0000' in GetLocalTime() 2020/04/04 Don't run autosync in singlenote mode. 2020/05/11 Moved all handling of the backup files to BackupView 2020/06/11 check if snapshot ok before flushing old ones. 2020/06/18 Ensure a default config file is written asap at first start. 2020/06/18 Removed unnecessary panel on Snap tab 2020/07/09 New help notes location. 2020/07/16 Drop Backup tab, merge to Snapshot tab, renamed 'Recover' 2020/07/24 Moved HELP notes from /usr/share/doc/tomboy-ng to /usr/share/tomboy-ng to suit debian 2020/08/01 Show better labels in HelpLangCombo. 2021/01/23 Save Search Auto Refresh check box status. 2021/04/24 Added setting to enable/disable undo/redo 2021/05/01 Remove HaveConfig and restructured config startup 2021/06/01 Add setting to disable Notifications 2021/09/27 Allow both File and Github sync, maybe its a good idea ?? SelectiveSync. 2021/10/06 Restructured the way we enter GH Token, all copy and paste now. 2021/10/26 User selectable date stamp format } {$mode objfpc}{$H+} interface uses Classes, SysUtils, {FileUtil,} Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons, ComCtrls, ExtCtrls, Menus, FileUtil, BackUpView, LCLIntf, Spin{, notifier}, base64; // Types; type TSyncOption = (AlwaysAsk, UseServer, UseLocal); // Relating to sync clash pref in config file type { TSett } TSett = class(TForm) ButtDefaultNoteDir: TButton; ButtonManualSnap: TButton; ButtonShowBackUp: TButton; ButtonSnapRecover: TButton; CheckAutoSnapEnabled: TCheckBox; CheckStampBold: TCheckBox; CheckStampItalics: TCheckBox; CheckStampSmall: TCheckBox; CheckSyncEnabled: TCheckBox; CheckNotifications: TCheckBox; CheckUseUndo: TCheckBox; CheckBoxAutoSync: TCheckBox; ComboDateFormat: TComboBox; ComboSyncType: TComboBox; ComboHelpLanguage: TComboBox; EditUserName: TEdit; GroupBoxSync: TGroupBox; Label10: TLabel; Label11: TLabel; Label16: TLabel; Label17: TLabel; LabelToken: TLabel; LabelSyncType: TLabel; Label5: TLabel; Label6: TLabel; Label7: TLabel; Label8: TLabel; Label9: TLabel; LabelSyncInfo2: TLabel; Label4: TLabel; LabelSyncInfo1: TLabel; LabelSyncRepo: TLabel; ButtonSetColours: TButton; ButtonFixedFont: TButton; ButtonFont: TButton; ButtonSetSpellLibrary: TButton; ButtonSetDictionary: TButton; ButtonSetNotePath: TButton; CheckAutoStart : TCheckBox; CheckManyNotebooks: TCheckBox; CheckShowSearchAtStart: TCheckBox; CheckShowSplash: TCheckBox; CheckShowExtLinks: TCheckBox; CheckShowIntLinks: TCheckBox; CheckShowTomdroid: TCheckBox; FontDialog1: TFontDialog; GroupBox4: TGroupBox; GroupBox5: TGroupBox; Label1: TLabel; Label12: TLabel; Label13: TLabel; Label14: TLabel; Label15: TLabel; LabelDicPrompt: TLabel; LabelDic: TLabel; LabelError: TLabel; LabelLibrary: TLabel; LabelDicStatus: TLabel; LabelLibraryStatus: TLabel; Label2: TLabel; Label3: TLabel; LabelNotesPath: TLabel; LabelSettingPath: TLabel; LabelSnapDir: TLabel; LabelLabelToken: TLabel; LabelUserName: TLabel; ListBoxDic: TListBox; OpenDialogLibrary: TOpenDialog; OpenDialogDictionary: TOpenDialog; PageControl1: TPageControl; Panel1: TPanel; Panel2: TPanel; Panel3: TPanel; PMenuMain: TPopupMenu; RadioAlwaysAsk: TRadioButton; RadioFontHuge: TRadioButton; RadioFontBig: TRadioButton; RadioFontMedium: TRadioButton; RadioFontSmall: TRadioButton; RadioUseLocal: TRadioButton; RadioUseServer: TRadioButton; SelectDirectoryDialog1: TSelectDirectoryDialog; SelectSnapDir: TSelectDirectoryDialog; SpeedButHide: TSpeedButton; SpeedButHelp: TSpeedButton; SpeedTokenCopy: TSpeedButton; SpeedTokenPaste: TSpeedButton; SpeedButtTBMenu: TSpeedButton; SpeedSetupSync: TSpeedButton; SpinDaysPerSnapshot: TSpinEdit; SpinMaxSnapshots: TSpinEdit; TabBasic: TTabSheet; TabBackUp: TTabSheet; TabSpell: TTabSheet; TabRecover: TTabSheet; TabSync: TTabSheet; TabDisplay: TTabSheet; TimerAutoSync: TTimer; procedure ButtDefaultNoteDirClick(Sender: TObject); procedure ButtonSetColoursClick(Sender: TObject); procedure ButtonFixedFontClick(Sender: TObject); procedure ButtonFontClick(Sender: TObject); procedure ButtonManualSnapClick(Sender: TObject); procedure ButtonSetDictionaryClick(Sender: TObject); procedure ButtonSetNotePathClick(Sender: TObject); procedure ButtonSetSnapDirClick(Sender: TObject); procedure ButtonSetSpellLibraryClick(Sender: TObject); procedure ButtonShowBackUpClick(Sender: TObject); procedure ButtonSnapRecoverClick(Sender: TObject); procedure CheckAutoSnapEnabledChange(Sender: TObject); procedure CheckAutostartChange(Sender: TObject); procedure CheckBoxAutoSyncChange(Sender: TObject); { Called when ANY of the setting check boxes change so we can save. } procedure SaveSettings(Sender: TObject); procedure CheckSyncEnabledChange(Sender: TObject); procedure ComboHelpLanguageChange(Sender: TObject); procedure ComboSyncTypeChange(Sender: TObject); procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormHide(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState ); procedure FormShow(Sender: TObject); procedure ListBoxDicClick(Sender: TObject); procedure PageControl1Change(Sender: TObject); procedure SpeedButHelpClick(Sender: TObject); procedure SpeedButHideClick(Sender: TObject); procedure SpeedButtTBMenuClick(Sender: TObject); procedure SpeedSetupSyncClick(Sender: TObject); procedure SpeedTokenCopyClick(Sender: TObject); procedure SpeedTokenPasteClick(Sender: TObject); procedure SpinDaysPerSnapshotChange(Sender: TObject); procedure TabBasicResize(Sender: TObject); procedure TabRecoverResize(Sender: TObject); procedure TabSpellResize(Sender: TObject); procedure TimerAutoSyncTimer(Sender: TObject); // Sets default colours, depending on dark or light theme procedure SetColours; private SyncFileEnabled, SyncGithubEnabled: boolean; SyncFileAuto, SyncGithubAuto: boolean; { eg /run/user/1000/gvfs/smb-share=greybox,share=store2/TB_Sync/ Being non empty indicates it worked sometime, ie is Valid } SyncFileRepo : string; { eg https://github.com/davidbannon/tb_test, being not empty means it was, at one stage, valid} SyncGithubRepo : string; AutoRefreshVar : boolean; UserSetColours : boolean; fExportPath : ANSIString; SearchIsCaseSensitive : boolean; NextAutoSnapshot : TDateTime; // Looks in expected place for help notes, populate combo and public vars, HelpNotesPath, HelpNotesLang. procedure LoadHelpLanguages(); // We load settings from confile or, if not available, sensible defaults, save. // then go on to check and make if necessary, other needed directories. // We proceed even if we cannot save settings, after all, user has been warned. procedure CheckConfigAndDirs; // Ret true and displays on screen if passed Full name is a usable dictonary // sets SpellConfig and triggers a config save if successful function CheckDictionary(const FullDicName : string): boolean; // Checks and/or makes indicatd dir, warns user if not there and writable. function CheckDirectory(DirPath: string): boolean; // Returns the number of files that could be dictionaries in indicated directory function CheckForDic(const DictPath: ANSIString): integer; { If LabelLib has a valid full name (of hunspell library), tests it, otherwise asks hunspell to guess some names. In either case, exits if fail, if successful then tries for a dictionary, either using default directories and populating listbox or if it finds one or a full name was provided in DicFullName, just tests that name. If successfull show on screen and saves config } procedure CheckSpelling(const DicFullName: string=''); procedure DicDefaults(out DicPathAlt: string); procedure DoAutoSnapshot; // Returns a good place to save config or user requested place if on cmdline, function GetDefaultConfigDir: string; // Returns the default place to store notes. It may not be present. function GetDefaultNoteDir: string; // Has a list of possible fixed font names, returns the first that 'works'. function GetFixedFont(): string; function MyBoolStr(const InBool: boolean) : string; procedure ReadConfigFile; procedure SetFontSizes; // Uses value of HelpNotesLang to make the Combobox agree. procedure SetHelpLanguage(); // Saves all current settings to disk. Call when any change is made. If unable // to write to disk, returns False, If IgnoreMask, writes even if masked. function WriteConfigFile(IgnoreMask : boolean = false): boolean; function fGetValidSync: boolean; // Must be passed either a valid sync repo address, rsSyncNotConfig or '' //procedure fSetValidSync(Repo: string); // Sets AutoRefresh and triggers a write of config file procedure fSetAutoRefresh(AR : boolean); // Just returns AutoRefresh function fGetAutoRefresh() : boolean; procedure SyncSettings; function fGetCaseSensitive : boolean; procedure fSetCaseSensitive(IsIt : boolean); //function ZipDate: string; public HelpNotesPath : string; // expected path to help note directories for this OS HelpNotesLang : string; // either two char code or '' AreClosing : boolean; // False until set true by mainUnit FormClose. BackGndColour : TColor; TextColour : TColor; HiColour : TColor; TitleColour : TColor; AltColour : TColor; // A colour similar to BackGndColour, alt rows in ListView, buttons in dark mode ? UsualFont : string; FixedFont : string; DefaultFixedFont : string; DarkTheme : boolean; DebugModeSpell : boolean; // Indicates SettingsChanged should not write out a new file cos we are loading from one. MaskSettingsChanged : boolean; AllowClose : Boolean; // review need for this // Indicates we should re-index notes when form hides //NeedRefresh : Boolean; FontSmall : Integer; FontLarge : Integer; FontHuge : Integer; FontTitle : Integer; // Do not set this to one of the other sizes ! FontNormal : Integer; { The directory expected to hold existing or new notes } NoteDirectory : string; { The dir expected to hold config file and, possibly local manifest } LocalConfig : string; SyncOption : TSyncOption; { Indicates user wants to see internal links } ShowIntLinks : boolean; { Says Notes should be treated as read only, a safe choice } NotesReadOnly : boolean; { Indicates Spell is configured and LabelLibrary and LabelDic should contain valid full file names.} SpellConfig : boolean; { Triggers a Sync, if its not all setup aready and working, user show and error } procedure Synchronise(); property ValidSync : boolean read fGetValidSync; property SearchCaseSensitive : boolean read fGetCaseSensitive write fSetCaseSensitive; property AutoRefresh : boolean read fGetAutoRefresh write fSetAutoRefresh; // Does not appear to be implemented property ExportPath : ANSIString Read fExportPath write fExportPath; // Called after notes are indexed (from SearchUnit), will start auto timer tha // controls both AutoSync and AutoSnap. Does nothing in SingleNoteMode. procedure StartAutoSyncAndSnap(); // Public : Returns the SyncFileRepo unless its empty, in which case its // returns unusable rubbish to ensure sync aborts. However, a special case // applies when setting up, SyncFileRepo will be empty but ComboSyncType set // to ItemsIndex=0 (being file sync) and a valid URL will be in LabelSyncRepo. function GetSyncFileRepo() : string; end; var Sett : TSett; const // Note we set DarkTheme colors and all HiLight colours in MainUnit ?? No, we set them here ! Placement = 45; // where we position an opening window. Its, on average, 1.5 time Placement; implementation {$R *.lfm} //{$DEFINE TESTAUTOSNAP} { TSett } uses IniFiles, LazLogger, LazFileUtils, // LazFileUtils needed for TrimFileName(), cross platform stuff; SearchUnit, // So we can call IndexNotes() after altering Notes Dir syncGUI, syncutils, tb_utils, recover, // Recover lost or damaged files mainunit, // so we can call ShowHelpNote() hunspell, // spelling check LCLType, // Keycodes .... Autostart, Colours, Clipbrd, ResourceStr; // only partially so far .... var Spell: THunspell; // Initially the first place we look for dictionaries, later its the path to // dictionaries listed in ListBoxDic DicPath : AnsiString; procedure TSett.SetFontSizes; begin if RadioFontHuge.checked then begin FontSmall := 11; FontLarge := 20; FontHuge := 23; FontTitle := 21; // Do not set this to one of the other sizes ! FontNormal := 16; end; if RadioFontBig.checked then begin FontSmall := 9; FontLarge := 17; FontHuge := 20; FontTitle := 18; // Do not set this to one of the other sizes ! FontNormal := 14; end; if RadioFontMedium.checked then begin FontSmall := 8; FontLarge := 14; FontHuge := 18; FontTitle := 16; // Do not set this to one of the other sizes ! FontNormal := 11; end; if RadioFontSmall.Checked then begin FontSmall := 7; FontLarge := 13; FontHuge := 16; FontTitle := 14; // Do not set this to one of the other sizes ! FontNormal := 10; end; end; { Make public things agree with internal ones. } procedure TSett.SyncSettings; begin if NoteDirectory <> '' then begin LabelNotespath.Caption := NoteDirectory; ShowIntLinks := CheckShowIntLinks.Checked; SetFontSizes(); if RadioAlwaysAsk.Checked then SyncOption := AlwaysAsk else if RadioUseLocal.Checked then SyncOption := UseLocal else if RadioUseServer.Checked then SyncOption := UseServer; end; end; function TSett.fGetCaseSensitive : boolean; begin result := SearchIsCaseSensitive; end; procedure TSett.fSetCaseSensitive(IsIt : boolean); begin SearchIsCaseSensitive := IsIt; if Not MaskSettingsChanged then WriteConfigFile(); end; procedure TSett.PageControl1Change(Sender: TObject); begin if NoteDirectory = '' then ButtDefaultNoteDirClick(self); Label15.Caption := ''; SpeedButHelp.Visible := (PageControl1.TabIndex = 2); // Only show for Sync Tab end; procedure TSett.SpeedButHelpClick(Sender: TObject); begin SearchForm.ShowHelpNote('sync-ng.note'); end; procedure TSett.SpeedButHideClick(Sender: TObject); begin Hide; end; procedure TSett.SpeedButtTBMenuClick(Sender: TObject); begin PMenuMain.Popup; end; procedure TSett.TabBasicResize(Sender: TObject); begin buttonSetNotePath.Width := (TabBasic.Width div 2) - 12; end; procedure TSett.TabRecoverResize(Sender: TObject); begin ButtonManualSnap.Width := (TabRecover.Width div 2) -10; end; procedure TSett.TabSpellResize(Sender: TObject); begin ButtonSetSpellLibrary.Width := (TabSpell.Width div 2) -7; ButtonSetDictionary.Width := ButtonSetSpellLibrary.Width; end; { ----------------- S P E L L I N G ----------------------} ResourceString rsSelectLibrary = 'Select your hunspell library'; rsSelectDictionary = 'Select the dictionary you want to use'; rsDictionaryLoaded = 'Dictionary Loaded OK'; rsDictionaryFailed = 'Library Not Loaded'; rsDictionaryNotFound = 'No Dictionary Found'; procedure TSett.ButtonSetSpellLibraryClick(Sender: TObject); begin OpenDialogLibrary.InitialDir := ExtractFilePath(LabelLibrary.Caption); OpenDialogLibrary.Filter := 'Library|libhunspell*'; OpenDialogLibrary.Title := rsSelectLibrary; if OpenDialogLibrary.Execute then begin LabelLibrary.Caption := TrimFilename(OpenDialogLibrary.FileName); CheckSpelling(); end; end; procedure TSett.ButtonSetDictionaryClick(Sender: TObject); begin OpenDialogDictionary.InitialDir := ExtractFilePath(LabelDic.Caption); OpenDialogDictionary.Filter := 'Dictionary|*.dic'; OpenDialogDictionary.Title := rsSelectDictionary; if OpenDialogDictionary.Execute then CheckDictionary(TrimFilename(OpenDialogDictionary.FileName)); end; function TSett.CheckForDic(const DictPath : ANSIString) : integer; var Info : TSearchRec; begin LabelError.Caption := ''; ListBoxDic.Clear; ListBoxDic.Enabled := False; if FindFirst(AppendPathDelim(DictPath) + '*.dic', faAnyFile and faDirectory, Info)=0 then begin repeat ListBoxDic.Items.Add(Info.Name); until FindNext(Info) <> 0; end; FindClose(Info); if DebugModeSpell then debugln('CheckForDic searched ' + DictPath + ' and found ' + inttostr(ListBoxDic.Items.Count)); if ListBoxDic.Items.Count > 0 then begin DicPath := DictPath; LabelDic.Caption := DictPath; end; exit(ListBoxDic.Items.Count); end; procedure TSett.ListBoxDicClick(Sender: TObject); begin if ListBoxDic.ItemIndex > -1 then CheckDictionary(AppendPathDelim(DicPath) + ListBoxDic.Items.Strings[ListBoxDic.ItemIndex]); end; function TSett.CheckDictionary(const FullDicName : string) : boolean; begin result := false; if fileexists(FullDicName) then begin if assigned(Spell) then begin SpellConfig := Spell.SetDictionary(FullDicName); if SpellConfig then begin LabelDicStatus.Caption := rsDictionaryLoaded; LabelDic.Caption := FullDicName; WriteConfigFile(); Result := True; end else begin LabelDicStatus.Caption := rsDictionaryNotFound; end; end; end else debugln('ERROR - called CheckDictionary with Spell nil'); if DebugModeSpell then debugln('CheckDictionary ' + FullDicName + ' return ' + booltostr(Result, True)); end; procedure TSett.DicDefaults(out DicPathAlt : string); begin DicPathAlt := ExtractFilePath(Application.ExeName); {$ifdef WINDOWS} DicPath := 'C:\Program Files\LibreOffice 5\share\extensions\dict-en\'; {$ENDIF} {$ifdef DARWIN} DicPath := '/Library/Spelling/'; DicPathAlt := '/Applications/tomboy-ng.app/Contents/Resources/'; {$endif} {$ifdef LINUX} DicPath := '/usr/share/hunspell/'; DicPathAlt := '/usr/share/myspell/'; {$ENDIF} end; procedure TSett.CheckSpelling(const DicFullName : string = ''); var DicPathAlt, DicToCheck : AnsiString; begin { The hunspell unit tries to find a library using some educated guesses. Once found, its saved in config and we pass that to hunspell as a suggested first place to try. We set likely dictionary locations here. } DicToCheck := ''; LabelError.Caption:=''; ListBoxDic.enabled:= False; LabelDic.Visible := False; LabelDicStatus.Visible := False; LabelDicPrompt.Visible := False; SpellConfig := False; if DicFullName = '' then DicDefaults(DicPathAlt); // startup mode DebugModeSpell := Application.HasOption('debug-spell'); // LabelLibrary.Caption := '/usr/local/Cellar/hunspell/1.6.2/lib/libhunspell-1.6.0.dylib'; if fileexists(LabelLibrary.Caption) then // make sure file from config is still valid Spell := THunspell.Create(DebugModeSpell, LabelLibrary.Caption) else Spell := THunspell.Create(DebugModeSpell); if Spell.ErrorMessage <> '' then begin LabelLibraryStatus.Caption := rsDictionaryFailed; exit(); end; if DebugModeSpell then debugln('Library OK, lets look for dictionary'); LabelLibraryStatus.caption := rsDictionaryLoaded; LabelLibrary.Caption := Spell.LibraryFullName; LabelDicStatus.Visible := True; LabelDic.Visible := True; if DicFullName = '' then begin if (not DirectoryExistsUTF8(LabelDic.Caption)) and (FileExistsUTF8(LabelDic.Caption)) then // we have a nominated file from config if CheckDictionary(LabelDic.Caption) then exit; // All good, use it ! if 0 = CheckForDic(DicPath) then begin // We'll try our defaults .... if 0 = CheckForDic(DicPathAlt) then begin LabelDicStatus.Caption := rsDictionaryNotFound; exit(); end; end; end else DicToCheck := DicFullName; if ListBoxDic.Items.Count = 1 then DicToCheck := AppendPathDelim(LabelDic.Caption) + ListBoxDic.Items.Strings[0]; if ListBoxDic.Items.Count > 1 then begin // user must select LabelDicStatus.Caption := rsSelectDictionary; ListBoxDic.Enabled:= True; exit(); end; // if to here, we have 1 candidate dictionary, either exactly 1 found or DicFullName has content if CheckDictionary(DicToCheck) then if DebugModeSpell then debugln('Spelling Configured.'); end; { --------------------- H O U S E K E E P I NG -------------------- } procedure TSett.FormHide(Sender: TObject); begin FreeandNil(Spell); //MaskSettingsChanged := True; May, 2020, why was this here ? { if NeedRefresh then begin SearchForm.IndexNotes(); NeedRefresh := False; end; } end; procedure TSett.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if {$ifdef DARWIN}ssMeta{$else}ssCtrl{$endif} in Shift then begin if key = ord('N') then begin SearchForm.OpenNote(''); Key := 0; exit(); end; if key = VK_Q then MainForm.Close(); end; end; procedure TSett.FormShow(Sender: TObject); begin if not assigned(Spell) then Spell := THunspell.Create(Application.HasOption('debug-spell'), LabelLibrary.Caption); // user user has 'closed' (ie hide) then Spell was freed. MaskSettingsChanged := False; Label15.Caption:=''; end; // We only really close when told by RTSearch that The Exit Menu choice from TrayIcon was clicked. procedure TSett.FormClose(Sender: TObject; var CloseAction: TCloseAction); begin if AllowClose then begin CloseAction := caFree; SearchForm.Close; end else CloseAction := caHide; end; procedure TSett.FormCreate(Sender: TObject); var i : integer; begin Caption := 'tomboy-ng Settings'; AreClosing := false; Top := 100; Left := 300; LoadHelpLanguages(); ComboDateFormat.Items.Clear; for i := 0 to MaxDateStampIndex do ComboDateFormat.Items.add(TB_DateStamp(i)); ComboDateFormat.ItemIndex := 0; DefaultFixedFont := GetFixedFont(); // Tests a list of likely suspects. PageControl1.ActivePage := TabBasic; MaskSettingsChanged := true; // don't trigger save while doing setup ExportPath := ''; LabelLibrary.Caption := ''; //HaveConfig := false; LocalConfig := GetDefaultConfigDir(); // sys dependant unless user has overridden LabelSettingPath.Caption := LocalConfig + 'tomboy-ng.cfg'; NoteDirectory := Sett.GetDefaultNoteDir; labelNotesPath.Caption := NoteDirectory; CheckShowTomdroid.Enabled := {$ifdef LINUX}True{$else}False{$endif}; CheckConfigAndDirs(); // write a new, default one if necessary CheckSpelling(); ComboSyncType.ItemIndex := 0; // Defaults to File if SyncGithubRepo <> '' then ComboSyncType.ItemIndex := 1; // But if we have Github, show that, more going on ComboSyncTypeChange(self); //LabelSyncInfo1.Caption := rsFileSyncInfo1; // ToDo : is this done in ComboSyncTypeChange //LabelSyncInfo2.Caption := rsFileSyncInfo2; MaskSettingsChanged := False; end; procedure TSett.FormDestroy(Sender: TObject); begin FreeandNil(Spell); end; { ------------------------- F I L E I / O --------------------------- } RESOURCESTRING rsErrorCreateDir = 'Unable to Create Directory'; rsErrorCannotWrite = 'Cannot write into'; function TSett.CheckDirectory(DirPath : string) : boolean; begin Result := False; if not DirectoryExistsUTF8(DirPath) then ForceDirectoriesUTF8(DirPath); if not DirectoryExistsUTF8(DirPath) then begin ShowMessage(rsErrorCreateDir + ' [' + DirPath + ']'); Debugln('Settings is unable to Create Directory [' + DirPath + ']'); exit(False); end; if DirectoryIsWritable(DirPath) then exit(True); ShowMessage(rsErrorCannotWrite + ' [' + DirPath + ']'); DebugLn('Settings cannot write into [' + DirPath + ']'); end; function TSett.GetDefaultConfigDir : string; begin Result := ''; if Application.HasOption('config-dir') then Result := Application.GetOptionValue('config-dir'); if Result = '' then begin {$ifdef DARWIN} // First we try the right place, if there use it, else try unix place, if // its not there, go back to right place. Result := GetEnvironmentVariable('HOME') + '/Library/Application Support/Tomboy-ng/Config'; if not DirectoryExistsUTF8(Result) then begin Result := GetAppConfigDirUTF8(False); if not DirectoryExistsUTF8(Result) then // must be new install, put in right place Result := GetEnvironmentVariable('HOME') + '/Library/Application Support/Tomboy-ng/Config'; end; {$else} Result := GetAppConfigDirUTF8(False); {$endif} end; Result := AppendPathDelim(Result); {$ifndef DARWIN} // MainForm.SetAltHelpPath(Result); // English help notes in read only space {$endif} end; function TSett.GetFixedFont() : string; var T : string; FontNames : array[1..7] of string = ('Monospace', 'Monaco', 'Nimbus Mono L', 'Liberation Mono', 'Lucida Console', 'Lucida Sans Typewriter', 'Courier New' ); // Add as many new names as you like but set array size. Chooses the first in the list it finds that works // Label does not seem to worry about us playing with its canvas. function IsMono(FontName : String) : boolean; begin Label1.Canvas.Font.Name := FontName; result := Label1.Canvas.TextWidth('i') = Label1.Canvas.TextWidth('w'); // I have no idea whats happening here, that line, above, somehow triggers a call // to the RadioFileSync OnChange handler. In turn, that calls SettingsChanged before // we have setup its config path. For now, because its not needed yet, I have // commented out the code in the OnChange end; function IsDifferentSizes() : boolean; // in case they are old non scalable, unlikely but .... var ASize : integer; begin Label1.Canvas.Font.Size := 13; ASize := Label1.Canvas.TextHeight('H'); Label1.Canvas.Font.Size := 14; if ASize = Label1.Canvas.TextHeight('H') then exit(False); ASize := Label1.Canvas.TextHeight('H'); Label1.Canvas.Font.Size := 15; If ASize = Label1.Canvas.TextHeight('H') then exit(False); result := True; end; begin Result := ''; for T in FontNames do begin if not IsMono(T) then continue; if not IsDifferentSizes() then continue; Result := T; exit; end; end; // Will read and apply the config file if available, else sets sensible defaults // Is only called at startup and assumes the config dir has been checked and // LabelSettingPath.Caption contains an appropriate file name. procedure TSett.ReadConfigFile; var ConfigFile : TINIFile; begin // TiniFile does not care it it does not find the config file, just returns default values. ConfigFile := TINIFile.Create(LabelSettingPath.Caption); try NoteDirectory := ConfigFile.readstring('BasicSettings', 'NotesPath', NoteDirectory); CheckShowIntLinks.Checked := ('true' = ConfigFile.readstring('BasicSettings', 'ShowIntLinks', 'true')); CheckShowExtLinks.Checked := ('true' = ConfigFile.readstring('BasicSettings', 'ShowExtLinks', 'true')); CheckManyNoteBooks.checked := ('true' = Configfile.readstring('BasicSettings', 'ManyNotebooks', 'true')); CheckUseUndo.Checked := ('true' = ConfigFile.readstring('BasicSettings', 'UseUndo', 'true')); SearchCaseSensitive := ('true' = Configfile.readstring('BasicSettings', 'CaseSensitive', 'false')); CheckShowTomdroid.Checked := ('true' = Configfile.readstring('BasicSettings', 'ShowTomdroid', 'false')); CheckShowSplash.Checked := ('true' = Configfile.ReadString('BasicSettings', 'ShowSplash', 'true')); CheckAutostart.Checked := ('true' = Configfile.ReadString('BasicSettings', 'Autostart', 'false')); CheckShowSearchAtStart.Checked := ('true' = Configfile.ReadString('BasicSettings', 'ShowSearchAtStart', 'false')); CheckNotifications.Checked := ('true' = Configfile.ReadString('BasicSettings', 'ShowNotifications', 'true')); case ConfigFile.readstring('BasicSettings', 'FontSize', 'medium') of 'huge' : RadioFontHuge.Checked := true; 'big' : RadioFontBig.Checked := true; 'medium' : RadioFontMedium.Checked := true; 'small' : RadioFontSmall.Checked := true; end; AutoRefresh := ('true' = ConfigFile.readstring('BasicSettings', 'AutoRefresh', 'true')); // ------------------- F O N T S ---------------------- UsualFont := ConfigFile.readstring('BasicSettings', 'UsualFont', GetFontData(Self.Font.Handle).Name); ButtonFont.Hint := UsualFont; FixedFont := ConfigFile.readstring('BasicSettings', 'FixedFont', DefaultFixedFont); if FixedFont = '' then FixedFont := DefaultFixedFont; ButtonFixedFont.Hint := FixedFont; BackGndColour:= StringToColor(Configfile.ReadString('BasicSettings', 'BackGndColour', '0')); HiColour := StringToColor(Configfile.ReadString('BasicSettings', 'HiColour', '0')); TextColour := StringToColor(Configfile.ReadString('BasicSettings', 'TextColour', '0')); TitleColour := StringToColor(Configfile.ReadString('BasicSettings', 'TitleColour', '0')); UserSetColours := not ((BackGndColour = 0) and (HiColour = 0) and (TextColour = 0) and (TitleColour = 0)); // Note - '0' is a valid colour, black. So, what says its not set is they are all '0'; HelpNotesLang := Configfile.ReadString('BasicSettings', 'HelpLanguage', HelpNotesLang); SetHelpLanguage(); // ------------------ S Y N C S E T T I N G S -------------------------- case ConfigFile.readstring('SyncSettings', 'SyncOption', 'AlwaysAsk') of 'AlwaysAsk' : begin SyncOption := AlwaysAsk; RadioAlwaysAsk.Checked := True; end; 'UseLocal' : begin SyncOption := UseLocal; RadioUseLocal.Checked := True; end; 'UseServer' : begin SyncOption := UseServer; RadioUseServer.Checked := True; end; end; SyncFileRepo := ConfigFile.readstring('SyncSettings', 'SyncRepo', ''); // that is for file sync SyncGithubRepo := ConfigFile.readstring('SyncSettings', 'SyncRepoGithub', ''); SyncFileAuto := ('true' = Configfile.ReadString('SyncSettings', 'Autosync', 'false')); SyncGithubAuto := ('true' = Configfile.ReadString('SyncSettings', 'AutosyncGit', 'false')); SyncFileEnabled := ('true' = Configfile.ReadString('SyncSettings', 'FileSyncEnabled', 'false')); SyncGithubEnabled := ('true' = Configfile.ReadString('SyncSettings', 'GitSyncEnabled', 'false')); LabelToken.caption := DecodeStringBase64(Configfile.ReadString('SyncSettings', 'GHPassword', '')); EditUserName.text := Configfile.ReadString('SyncSettings', 'GHUserName', ''); ComboSyncTypeChange(self); // remember that an old config file might contain stuff about Filesync, nextcloud, random rubbish ..... // ------------- S P E L L I N G --------------------------------------- LabelLibrary.Caption := ConfigFile.readstring('Spelling', 'Library', ''); LabelDic.Caption := ConfigFile.readstring('Spelling', 'Dictionary', ''); SpellConfig := (LabelLibrary.Caption <> '') and (LabelDic.Caption <> ''); // indicates it worked once... // ------------- S N A P S H O T S E T T I N G S ------------------- LabelSnapDir.Caption := ConfigFile.readstring('SnapSettings', 'SnapDir', NoteDirectory + 'Snapshot' + PathDelim); CheckAutoSnapEnabled.Checked := Configfile.ReadBool('Snapshot', 'AutoSnapEnabled', False); NextAutoSnapshot := Configfile.ReadDateTime('Snapshot', 'NextAutoSnapshot', now()); SpinDaysPerSnapshot.Value := Configfile.ReadInteger('Snapshot', 'DaysPerSnapshot', 7); SpinMaxSnapshots.Value := Configfile.ReadInteger('Snapshot', 'DaysMaxSnapshots', 20); // ------------- D A T E S T A M P S E T T I N G ----------------- CheckStampItalics.Checked := Configfile.ReadBool('DateStampSettings', 'Italics', False); CheckStampSmall.Checked := Configfile.ReadBool('DateStampSettings', 'Small', False); CheckStampBold.Checked := Configfile.ReadBool('DateStampSettings', 'Bold', False); ComboDateFormat.ItemIndex := Configfile.ReadInteger('DateStampSettings', 'Format', 0); finally ConfigFile.free; end; end; { Read config file if it exists or writes a default one. } procedure TSett.CheckConfigAndDirs; //var // ConfigFile : TINIFile; begin CheckDirectory(LocalConfig); // so its created if needed, shows message on error. ReadConfigFile(); // will ensure sensible default config even if file is not present. if LabelSettingPath.Caption = 'LabelSettingPath' then showmessage('WARNING, TSett.CheckConfigFile - writing config before setting filename') else if not fileexists(LabelSettingPath.Caption) then // must be first run WriteConfigFile(True); // write a initial default file, shows user message on error CheckDirectory(NoteDirectory); // user will get a message on error, their problem CheckDirectory(NoteDirectory + 'Backup'); CheckDirectory(LabelSnapDir.Caption); SyncSettings(); // ToDo : can we discard this ? end; procedure TSett.fSetAutoRefresh(AR: boolean); begin AutoRefreshVar := AR; WriteConfigFile(); end; function TSett.fGetAutoRefresh() : boolean; begin Result := AutoRefreshVar; end; function TSett.MyBoolStr(const InBool : boolean) : string; begin if InBool then result := 'true' else result := 'false'; end; function TSett.WriteConfigFile(IgnoreMask : boolean = false) : boolean; var ConfigFile : TINIFile; begin Result := True; if MaskSettingsChanged and (not IgnoreMask) then exit(); { if LabelSettingPath.Caption = 'LabelSettingPath' then // ToDo : I very occasionally create a file called LabelSettingPath, cannot reproduce showmessage('WARNING, TSett.SettingsChanged - writing config before setting filename'); } ConfigFile := TINIFile.Create(LabelSettingPath.Caption); try try ConfigFile.writestring('BasicSettings', 'NotesPath', NoteDirectory); Configfile.writestring('BasicSettings', 'ManyNotebooks', MyBoolStr(CheckManyNoteBooks.checked)); Configfile.writestring('BasicSettings', 'CaseSensitive', MyBoolStr(SearchCaseSensitive)); ConfigFile.writestring('BasicSettings', 'ShowIntLinks', MyBoolStr(CheckShowIntLinks.Checked)); ConfigFile.writestring('BasicSettings', 'ShowExtLinks', MyBoolStr(CheckShowExtLinks.Checked)); ConfigFile.writestring('BasicSettings', 'ShowTomdroid', MyBoolStr(CheckShowTomdroid.Checked)); ConfigFile.WriteString('BasicSettings', 'ShowSplash', MyBoolStr(CheckShowSplash.Checked)); ConfigFile.WriteString('BasicSettings', 'Autostart', MyBoolStr(CheckAutostart.Checked)); ConfigFile.WriteString('BasicSettings', 'ShowSearchAtStart', MyBoolStr(CheckShowSearchAtStart.Checked)); ConfigFile.WriteString('BasicSettings', 'ShowNotifications', MyBoolStr(CheckNotifications.Checked)); ConfigFile.WriteString('BasicSettings', 'AutoRefresh', MyBoolStr(AutoRefresh)); ConfigFile.WriteString('BasicSettings', 'UseUndo', MyBoolStr(CheckUseUndo.Checked)); if RadioFontBig.Checked then ConfigFile.writestring('BasicSettings', 'FontSize', 'big') else if RadioFontMedium.Checked then ConfigFile.writestring('BasicSettings', 'FontSize', 'medium') else if RadioFontSmall.Checked then ConfigFile.writestring('BasicSettings', 'FontSize', 'small') else if RadioFontHuge.Checked then ConfigFile.writestring('BasicSettings', 'FontSize', 'huge'); ConfigFile.writestring('BasicSettings', 'UsualFont', UsualFont); ConfigFile.writestring('BasicSettings', 'FixedFont', FixedFont); //(Sel_CText = 0) and (Sel_CBack = 0) and (Sel_CHiBack = 0) and (Sel_CTitle = 0) if UserSetColours then begin ConfigFile.writestring('BasicSettings', 'BackGndColour', ColorToString(BackGndColour)); ConfigFile.writestring('BasicSettings', 'HiColour', ColorToString(HiColour)); ConfigFile.writestring('BasicSettings', 'TextColour', ColorToString(TextColour)); ConfigFile.writestring('BasicSettings', 'TitleColour', ColorToString(TitleColour)); end else begin ConfigFile.writestring('BasicSettings', 'BackGndColour', '0'); ConfigFile.writestring('BasicSettings', 'HiColour', '0'); ConfigFile.writestring('BasicSettings', 'TextColour', '0'); ConfigFile.writestring('BasicSettings', 'TitleColour', '0'); end; if HelpNotesLang <> '' then ConfigFile.writestring('BasicSettings', 'HelpLanguage', HelpNotesLang); // --------- S Y N C S E T T I N G S ---------------------------- { Other entries, such as SyncRepoURL, SyncURL, FileSyncRepo, UseFileSync are distractions introduced by a nasty pull request I stupidly let through, ignore them, they will not go away unless manually deleted ! } ConfigFile.WriteString('SyncSettings', 'Autosync', MyBoolStr(SyncFileAuto)); ConfigFile.WriteString('SyncSettings', 'AutosyncGit', MyBoolStr(SyncGithubAuto)); ConfigFile.WriteString('SyncSettings', 'FileSyncEnabled', MyBoolStr(SyncFileEnabled)); ConfigFile.WriteString('SyncSettings', 'GitSyncEnabled', MyBoolStr(SyncGithubEnabled)); if RadioAlwaysAsk.Checked then ConfigFile.writestring('SyncSettings', 'SyncOption', 'AlwaysAsk') else if RadioUseLocal.Checked then ConfigFile.writestring('SyncSettings', 'SyncOption', 'UseLocal') else if RadioUseServer.Checked then ConfigFile.writestring('SyncSettings', 'SyncOption', 'UseServer'); //ConfigFile.writestring('SyncSettings', 'SyncType', SyncType); // Extend sync type here. ConfigFile.writestring('SyncSettings', 'SyncRepo', SyncFileRepo); ConfigFile.writestring('SyncSettings', 'SyncRepoGithub', SyncGithubRepo); ConfigFile.writestring('SyncSettings', 'GHPassword', EncodeStringBase64(LabelToken.Caption)); ConfigFile.writestring('SyncSettings', 'GHUserName', EditUserName.text); // --------- S P E L L S E T T I N G S ---------------------------- if SpellConfig then begin ConfigFile.writestring('Spelling', 'Library', LabelLibrary.Caption); ConfigFile.writestring('Spelling', 'Dictionary', LabelDic.Caption); end; // --------- S N A P S H O T S E T T I N G S ------------------- configfile.WriteBool('Snapshot', 'AutoSnapEnabled', CheckAutoSnapEnabled.Checked); configfile.WriteDateTime('Snapshot', 'NextAutoSnapshot', NextAutoSnapshot); // Format can (?) be set in SysUtils but does not matter as long as its consistent on this machine configfile.WriteInteger('Snapshot', 'DaysPerSnapshot', SpinDaysPerSnapshot.Value); configfile.WriteInteger('Snapshot', 'DaysMaxSnapshots', SpinMaxSnapshots.Value); // --------- D A T E S T A M P S E T T I N G ----------------- configfile.Writebool('DateStampSettings', 'Italics', CheckStampItalics.Checked); configfile.Writebool('DateStampSettings', 'Small', CheckStampSmall.Checked); configfile.Writebool('DateStampSettings', 'Bold', CheckStampBold.Checked); configfile.WriteInteger('DateStampSettings', 'Format', ComboDateFormat.ItemIndex); finally ConfigFile.Free; end; except on E: Exception do begin showmessage('Unable to write config to ' + LabelSettingPath.Caption); Result := False; end; end; // debugln('just wrote a settings file out'); end; function TSett.GetDefaultNoteDir : string; begin {$IFDEF UNIX} Result := GetEnvironmentVariable('HOME') + '/.local/share/tomboy-ng/'; {$ENDIF} {$IFDEF DARWIN} // try the correct place first, if not there, lets try the old, wrong place // if at neither, we go back to correct place. Result := GetEnvironmentVariable('HOME') + '/Library/Application Support/Tomboy-ng/Notes/'; if DirectoryExistsUTF8(Result) then exit; Result := GetEnvironmentVariable('HOME') + '/.local/share/tomboy-ng/'; if not DirectoryExistsUTF8(Result) then Result := GetEnvironmentVariable('HOME') + '/Library/Application Support/Tomboy-ng/Notes/'; {$ENDIF} {$IFDEF WINDOWS} Result := GetEnvironmentVariable('APPDATA') + '\tomboy-ng\notes\'; // %APPDATA%\Tomboy\notes\ {$ENDIF} end; procedure TSett.ButtDefaultNoteDirClick(Sender: TObject); begin NoteDirectory := GetDefaultNoteDir(); if not CheckDirectory(NoteDirectory) then NoteDirectory := Sett.LabelNotesPath.Caption else begin WriteConfigFile(); SyncSettings(); SearchForm.IndexNotes(); end; end; procedure TSett.SetColours; // pink = $EEEEFF, White is $FFFFFF, Black is $000000 begin if DarkTheme then // ToDo : must add this to user set colours, sigh ..... //AltColour := $282828 // Gray, BackGround Colour of Alternating rows in some ListViews AltColour := $606060 // A colour that will show both black and white test else AltColour := clDefault; // it gets used as a background and needs to be a bit near it if UserSetColours then exit; // will have already been set by config or by colour form. if DarkTheme then begin //debugln('Its definltly a Dark Theme'); BackGndColour:= clBlack; // eg $000000 HiColour := clDkGray; TextColour := clLtGray; TitleColour:= clTeal; end else begin BackGndColour := clCream; HiColour := clYellow; TextColour := clBlack; TitleColour := clBlue; end; end; procedure TSett.SetHelpLanguage(); var HelpIndex : integer = 0; begin while HelpIndex < ComboHelpLanguage.Items.Count do begin if HelpNotesLang = copy(ComboHelpLanguage.Items[HelpIndex], 1, 2) then begin ComboHelpLanguage.ItemIndex := HelpIndex; break; end; inc(HelpIndex); end; end; procedure TSett.LoadHelpLanguages(); var Info : TSearchRec; begin {$ifdef WINDOWS}HelpNotesPath := AppendPathDelim(ExtractFileDir(Application.ExeName)) + 'HELP' + PathDelim;{$endif} {$ifdef LINUX} HelpNotesPath := '/usr/share/tomboy-ng/HELP/'; {$endif} {$ifdef DARWIN} HelpNotesPath := ExtractFileDir(ExtractFileDir(Application.ExeName))+'/Resources/HELP/';{$endif} HelpNotesLang:= ''; ComboHelpLanguage.enabled := False; ComboHelpLanguage.Items.Clear; if FindFirst(HelpNotesPath + '*', faDirectory, Info)=0 then begin repeat if (((Info.attr and faDirectory) > 0) and (Info.name[1] <> '.')) then begin case Info.Name of 'EN' : ComboHelpLanguage.Items.Add('EN - English'); 'ES' : ComboHelpLanguage.Items.Add('ES - Español'); otherwise ComboHelpLanguage.Items.Add(Info.Name); end; end; until FindNext(Info) <> 0; end; FindClose(Info); if ComboHelpLanguage.Items.Count > 0 then begin ComboHelpLanguage.enabled := True; if ComboHelpLanguage.Items.IndexOf('EN - English') < 0 then // default to EN if present, else first found. HelpNotesLang:= copy(ComboHelpLanguage.Items[0], 1, 2) else HelpNotesLang:= 'EN'; end; SetHelpLanguage(); end; procedure TSett.ComboHelpLanguageChange(Sender: TObject); begin if ComboHelpLanguage.ItemIndex > -1 then begin HelpNotesLang:= copy(ComboHelpLanguage.Items[ComboHelpLanguage.ItemIndex], 1, 2); WriteConfigFile(); SearchForm.RefreshMenus(mkHelpMenu); end; end; procedure TSett.ButtonSetColoursClick(Sender: TObject); begin FormColours.CBack := BackGndColour; FormColours.CHiBack := HiColour; FormColours.CText := TextColour; FormColours.CTitle := TitleColour; case FormColours.ShowModal of mrRetry : begin UserSetColours := False; SetColours(); WriteConfigFile(); end; mrOK : begin BackGndColour := FormColours.CBack; HiColour := FormColours.CHiBack; TextColour := FormColours.CText; TitleColour := FormColours.CTitle; UserSetColours := True; WriteConfigFile(); end; end; end; procedure TSett.ButtonFixedFontClick(Sender: TObject); begin FontDialog1.Font.Name := FixedFont; FontDialog1.Font.Size := 10; FontDialog1.Title := 'Select Fixed Spacing Font'; FontDialog1.PreviewText:= 'abcdef ABCDEF 012345'; // showmessage(FixedFont); FontDialog1.Options := FontDialog1.Options + [fdFixedPitchOnly]; If FontDialog1.Execute then BEGIN FixedFont := FontDialog1.Font.name; WriteConfigFile(); end; ButtonFixedFont.Hint := FixedFont; end; procedure TSett.ButtonFontClick(Sender: TObject); begin FontDialog1.Font.Name := UsualFont; FontDialog1.Font.Size := 10; FontDialog1.Title := 'Select Usual Font'; FontDialog1.PreviewText:= 'abcdef ABCDEF 012345'; If FontDialog1.Execute then BEGIN UsualFont := FontDialog1.Font.name; WriteConfigFile(); end; ButtonFont.Hint := UsualFont; end; RESOURCESTRING rsDirHasNoNotes = 'That directory does not contain any notes. That is OK, if I can make my own there.'; { Allow user to point to what they want to call their notes dir. If there are no notes there, pops up a warning and proceeds. } procedure TSett.ButtonSetNotePathClick(Sender: TObject); var Info : TSearchRec; begin if SelectDirectoryDialog1.Execute then begin NoteDirectory := TrimFilename(SelectDirectoryDialog1.FileName + PathDelim); if CheckDirectory(NoteDirectory) then begin if not FindFirst(NoteDirectory + '*.note', faAnyFile and faDirectory, Info)=0 then begin showmessage(rsDirHasNoNotes); end; FindClose(Info); CheckShowIntLinks.enabled := true; // CheckReadOnly.enabled := true; SyncFileAuto :=False; SyncGithubAuto :=False; ComboSyncTypeChange(self); WriteConfigFile(); SyncSettings(); SearchForm.IndexNotes(); end else NoteDirectory := LabelNotesPath.caption; end; end; { --------------------- S N A P S H O T S ------------------- } { Totally unvalidated rule of thumb - About a 200 notes = ~ 400K bytes, we get about 4:1 compression with zipper. 120ms on lowend laptop. } procedure TSett.SpinDaysPerSnapshotChange(Sender: TObject); begin if CheckAutoSnapEnabled.Checked then DoAutoSnapShot(); WriteConfigFile(); end; procedure TSett.DoAutoSnapshot; var FR : TFormRecover; {$ifdef TESTAUTOSNAP} Tick, Tock : qword;{$endif} //Notifier : TNotifier; begin if MaskSettingsChanged then exit; // don't trigger this while GUI is being setup. {$ifdef TESTAUTOSNAP} Tick := gettickcount64(); {$endif} FR := TFormRecover.Create(self); try FR.NoteDir := NoteDirectory; FR.FullSnapDir := LabelSnapDir.Caption; FR.ConfigDir:= AppendPathDelim(Sett.LocalConfig); if ('' <> FR.CreateSnapshot(False)) then FR.CleanUpSnapshots(SpinMaxSnapshots.Value); finally FR.Free; end; // do this after snapshot run to ensure we don't queue up a list of calls. {$ifdef TESTAUTOSNAP} tock := gettickcount64(); debugln('DoAutoSnapshot - Finished snapshot, took ' + dbgs(Tock - Tick) + 'mS'); NextAutoSnapshot := now() + (SpinDaysPerSnapshot.value / (24*60)) ; {$else} NextAutoSnapshot := now() + SpinDaysPerSnapshot.value; {$endif} WriteConfigFile(); SearchForm.UpdateStatusBar(rsAutosnapshotRun); if CheckNotifications.Checked then begin {$ifdef LINUX} ShowNotification('tomboy-ng', rsAutosnapshotRun); (* Notifier := TNotifier.Create; Notifier.ShowTheMessage('tomboy-ng', rsAutosnapshotRun); *) {$else} MainForm.TrayIcon.BalloonTitle := 'tomboy-ng'; Mainform.TrayIcon.BalloonHint := 'rsAutosnapshotRun'; Mainform.TrayIcon.ShowBalloonHint; {$endif} // Note, don't free it, it frees itself. end; end; procedure TSett.CheckAutoSnapEnabledChange(Sender: TObject); begin if CheckAutoSnapEnabled.Checked then begin DoAutoSnapShot(); end; end; procedure TSett.ButtonManualSnapClick(Sender: TObject); var FR : TFormRecover; FullName : string; begin FR := TFormRecover.Create(self); try FR.NoteDir := NoteDirectory; FR.FullSnapDir := LabelSnapDir.Caption; FR.ConfigDir:= AppendPathDelim(Sett.LocalConfig); FullName := FR.CreateSnapshot(True); if mrYes = QuestionDlg('Snapshot created', FullName + ' ' + rsSnapShotCreated , mtConfirmation, [mrYes, mrNo], 0) then if SelectSnapDir.Execute then if not CopyFile(FullName, TrimFilename(SelectSnapDir.FileName + PathDelim) + ExtractFileNameOnly(FullName) + '.zip') then showmessage(rsErrorCopyFile + ' ' + TrimFilename(SelectSnapDir.FileName + PathDelim) + ExtractFileNameOnly(FullName) + '.zip'); finally FR.Free; end; end; procedure TSett.ButtonSetSnapDirClick(Sender: TObject); begin SelectSnapDir.FileName := LabelSnapDir.Caption; if SelectSnapDir.Execute then begin LabelSnapDir.Caption := TrimFilename(SelectSnapDir.FileName + PathDelim); end; CheckDirectory(LabelSnapDir.Caption); end; procedure TSett.ButtonSnapRecoverClick(Sender: TObject); var FR : TFormRecover; begin FR := TFormRecover.Create(self); try FR.NoteDir := NoteDirectory; FR.FullSnapDir := LabelSnapDir.Caption; FR.ConfigDir:= AppendPathDelim(Sett.LocalConfig); // Danger Will Robertson ! We cannot assume LocalConfig has a trailing slash ! FR.Showmodal; if FR.RequiresIndex then SearchForm.IndexNotes(); finally FR.Free; end; end; // ============================= S Y N C S T U F F ========================= { Note that AutoSync and AutoSnapshot share a timer. AutoSync runs on each 'tick' of the timer, that is, hourly, but autosnapshop looks at NextAutoSnapshot to decide if its time to do its thing. } { This method manages display of all the controls associated with setting up Sync connections. } procedure TSett.ComboSyncTypeChange(Sender: TObject); var Ctrl : TControl; RememberMask : boolean; begin RememberMask := MaskSettingsChanged; MaskSettingsChanged := true; case ComboSyncType.ItemIndex of 0 : begin LabelSyncInfo1.caption := rsFileSyncInfo1; LabelSyncInfo2.caption := rsFileSyncInfo2; CheckBoxAutoSync.Checked := SyncFileAuto; CheckSyncEnabled.Checked := SyncFileEnabled; for Ctrl in [LabelLabelToken, SpeedTokenCopy, SpeedTokenPaste, LabelToken, LabelUserName, EditUserName] do Ctrl.Visible := False; if SyncFileRepo = '' then LabelSyncRepo.Caption := rsSyncNotConfig else LabelSyncRepo.Caption := SyncFileRepo; end; 1 : begin LabelSyncInfo1.caption := rsGithubSyncInfo1; LabelSyncInfo2.caption := rsGithubSyncInfo2; CheckBoxAutoSync.Checked := SyncGithubAuto; CheckSyncEnabled.Checked := SyncGithubEnabled; for Ctrl in [LabelLabelToken, SpeedTokenCopy, SpeedTokenPaste, LabelToken, LabelUserName, EditUserName] do Ctrl.Visible := True; if SyncGithubRepo = '' then LabelSyncRepo.Caption := rsSyncNotConfig else LabelSyncRepo.Caption := SyncGithubRepo; end; end; if (LabelSyncRepo.Caption = rsSyncNotConfig) or (LabelSyncRepo.Caption = '') then begin SpeedSetUpSync.Caption := rsSetUp; CheckBoxAutoSync.enabled := false; CheckSyncEnabled.enabled := false; end else begin SpeedSetUpSync.Caption := rsChangeSync; CheckBoxAutoSync.enabled := true; CheckSyncEnabled.enabled := true; end; MaskSettingsChanged := RememberMask; end; procedure TSett.SpeedSetupSyncClick(Sender: TObject); var SyncType : integer; begin { Used by both File and Github sync } if NoteDirectory = '' then ButtDefaultNoteDirClick(self); FormSync.NoteDirectory := NoteDirectory; FormSync.LocalConfig := LocalConfig; FormSync.SetupSync := True; SyncType := ComboSyncType.ItemIndex; case SyncType of 0 : begin // File Sync if FileExists(LocalConfig + 'manifest.xml') and (mrYes <> QuestionDlg('Warning', rsChangeExistingSync, mtConfirmation, [mrYes, mrNo], 0)) then exit; if SelectDirectoryDialog1.Execute then LabelSyncRepo.Caption := TrimFilename(SelectDirectoryDialog1.FileName + PathDelim) else exit(); SyncFileRepo := ''; // So Sync unit does not use the old one. FormSync.Transport:=TSyncTransport.SyncFile; // The Sync unit will get the remote dir from SyncFileRepo end; 1 : begin if FileExists(LocalConfig + SyncTransportName(SyncGithub) + PathDelim + 'manifest.xml') and (mrYes <> QuestionDlg('Warning', rsChangeExistingSync, mtConfirmation, [mrYes, mrNo], 0)) then exit; FormSync.Transport:=TSyncTransport.SyncGithub; FormSync.Password := LabelToken.Caption; FormSync.UserName := EditUserName.text; // SyncGUI will update LabelSyncRepo.Caption if successful. end; end; if mrOK = FormSync.ShowModal then begin case SyncType of 0 : SyncFileRepo := LabelSyncRepo.Caption; 1 : SyncGithubRepo := LabelSyncRepo.Caption; end; CheckSyncEnabled.Checked := True; WriteConfigFile(); ComboSyncTypeChange(self); // update button label end; end; procedure TSett.SpeedTokenCopyClick(Sender: TObject); begin Clipboard.AsText := LabelToken.Caption; end; procedure TSett.SpeedTokenPasteClick(Sender: TObject); begin LabelToken.Caption := Clipboard.AsText; SaveSettings(self); LabelToken.Hint := ''; end; function TSett.fGetValidSync: boolean; begin result := (SyncFileRepo <> '') or (SyncGithubRepo <> ''); end; procedure TSett.CheckAutostartChange(Sender: TObject); var Auto : TAutoStartCtrl; begin // This is being called at startup, it should only be called when user changes it. if not visible then exit; Auto := TAutoStartCtrl.Create('tomboy-ng', CheckAutostart.Checked); if Auto.ErrorMessage <> '' then ShowMessage('Error setting autostart' + Auto.ErrorMessage); FreeAndNil(Auto); SaveSettings(Sender); end; procedure TSett.CheckSyncEnabledChange(Sender: TObject); begin if MAskSettingsChanged then exit; case ComboSyncType.ItemIndex of 0 : SyncFileEnabled := CheckSyncEnabled.Checked; 1 : SyncGithubEnabled := CheckSyncEnabled.Checked; end; SaveSettings(self); end; procedure TSett.CheckBoxAutoSyncChange(Sender: TObject); begin // debugln('WARNING - CheckBoxAutoSyncChange called'); if MAskSettingsChanged then exit; // Don't trigger timer during setup if CheckBoxAutoSync.Checked then begin case ComboSyncType.ItemIndex of 0 : SyncFileAuto := True; 1 : SyncGithubAuto := True; otherwise exit; end; TimerAutoSync.Enabled := false; TimerAutoSync.Interval:= 1000; // wait a second, then sync. AutoSnap will also be checked. TimerAutoSync.Enabled := true; end else case ComboSyncType.ItemIndex of 0 : SyncFileAuto := False; 1 : SyncGithubAuto := True; otherwise exit; end; SaveSettings(Self); end; procedure TSett.Synchronise(); begin FormSync.NoteDirectory := Sett.NoteDirectory; FormSync.LocalConfig := AppendPathDelim(Sett.LocalConfig); // ToDo : this will not be enough when we save our notes in a second thread. // Might need to check, somehow, that no threads are still running ? How ? SearchForm.FlushOpenNotes(); FormSync.SetupSync := False; if SyncFileEnabled then begin FormSync.Transport:=TSyncTransport.SyncFile; if FormSync.busy or FormSync.Visible then // busy should be enough but to be sure .... FormSync.Show else FormSync.ShowModal; end; if SyncGithubEnabled then begin FormSync.Transport:=TSyncTransport.SyncGithub; if FormSync.busy or FormSync.Visible then // busy should be enough but to be sure .... FormSync.Show else FormSync.ShowModal; end; end; procedure TSett.StartAutoSyncAndSnap(); begin if (MainUnit.SingleNoteFileName = '') then begin TimerAutoSync.Interval:= 15000; // wait 15 seconds after indexing to allow settling down TimerAutoSync.Enabled := true; // Note that this timer will also trigger checking of AutoSnapshot. But AutoSnapshot only // does something if NextAutoSnapshot is > now(), while AutoSync always runs on timer if enabled. end; end; function TSett.GetSyncFileRepo(): string; begin if SyncFileRepo <> '' then Result := SyncFileRepo else if (ComboSyncType.ItemIndex = 0) and (LabelSyncRepo.Caption <> rsSyncNotConfig) and (LabelSyncRepo.Caption <> '') then result := LabelSyncRepo.Caption else Result := 'File Sync is not configured'; end; procedure TSett.TimerAutoSyncTimer(Sender: TObject); begin // TimerAutoSync.enabled := False; TimerAutoSync.Interval:= 60*60*1000; // do it again in one hour {$IFDEF TESTAUTOSNAP} TimerAutoSync.Interval:= 60*1000; debugln('WARNING - TESTAUTOSNAP is defined, timer called, MSC is ' + dbgs(MAskSettingsChanged)); {$ENDIF} //if (ValidSync <> '') and CheckBoxAutoSync.checked and (not FormSync.Busy) then begin if SyncFileAuto and (SyncFileRepo <> '') and SyncFileEnabled and (not FormSync.Busy) then begin FormSync.NoteDirectory := Sett.NoteDirectory; FormSync.LocalConfig := AppendPathDelim(Sett.LocalConfig); FormSync.Transport:=TSyncTransport.SyncFile; FormSync.SetupSync := False; // That is, we are not, now, trying to setup sync FormSync.RunSyncHidden() end; if SyncGithubAuto and (SyncGithubRepo <> '') and SyncGithubEnabled and (not FormSync.Busy) then begin FormSync.NoteDirectory := Sett.NoteDirectory; FormSync.LocalConfig := AppendPathDelim(Sett.LocalConfig); FormSync.Transport:=TSyncTransport.SyncGithub; FormSync.SetupSync := False; FormSync.RunSyncHidden() end; // debugln('Now its about ' + DateTimeToStr(now)); // debugln('Next Snap due ' + DateTimeToStr(NextAutoSnapshot)); if CheckAutoSnapEnabled.Checked and (NextAutoSnapshot < now()) then DoAutoSnapshot; end; procedure TSett.ButtonShowBackUpClick(Sender: TObject); var BV : TFormBackupView; begin BV := TFormBackupView.Create(self); try BV.ShowModal; finally FreeandNil(BV); end; end; procedure TSett.SaveSettings(Sender: TObject); begin WriteConfigFile(); // Write to disk SyncSettings(); if not MaskSettingsChanged then if Sender.ClassNameIs('TCheckBox') then begin if TCheckBox(Sender).Name = 'CheckShowTomdroid' then begin SearchForm.RefreshMenus(mkFileMenu); SearchForm.RefreshMenus(mkHelpMenu); end; end; end; end. (* This is getmem's blowfish model, might use it to encrypt both notes and token https://forum.lazarus.freepascal.org/index.php/topic,56489.msg419952.html#msg419952 unit uCrypto; {$mode objfpc}{$H+} interface uses Classes, SysUtils, BlowFish, Base64; function Encrypt(const AKey, AText: String): String; function Decrypt(const AKey, AText: String): String; implementation function Encrypt(const AKey, AText: String): String; var SS: TStringStream; BES: TBlowFishEncryptStream; begin Result := ''; if Trim(AText) = '' then Exit; SS := TStringStream.Create(''); try BES := TBlowFishEncryptStream.Create(AKey, SS); try BES.Write(Pointer(AText)^, Length(AText)); finally BES.Free; end; Result := EncodeStringBase64(SS.DataString); finally SS.Free; end; end; function Decrypt(const AKey, AText: String): String; var SS: TStringStream; BDS: TBlowFishDeCryptStream; Str, Txt: String; begin Result := ''; if Trim(AText) = '' then Exit; Str := ''; Txt := DecodeStringBase64(AText); SS := TStringStream.Create(Txt); try BDS := TBlowFishDeCryptStream.Create(AKey, SS); try SetLength(Str, SS.Size); BDS.Read(Pointer(Str)^, SS.Size); Result := Str; finally BDS.Free; end; finally SS.Free; end; end; end. *) ����������������������������������������������������������������������������������������������������������tomboy-ng_0.34-1/source/tomdroid.lrj����������������������������������������������������������������0000644�0001750�0001750�00000007254�14145033507�017257� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������{"version":1,"strings":[ {"hash":104566852,"name":"tformtomdroid.caption","sourcebytes":[84,111,109,100,114,111,105,100],"value":"Tomdroid"}, {"hash":4863637,"name":"tformtomdroid.buttonclose.caption","sourcebytes":[67,108,111,115,101],"value":"Close"}, {"hash":90721265,"name":"tformtomdroid.panel1.caption","sourcebytes":[80,97,110,101,108,49],"value":"Panel1"}, {"hash":173705863,"name":"tformtomdroid.editprofilename.hint","sourcebytes":[101,103,32,77,121,83,97,109,115,117,110,103,78,111,116,101,55],"value":"eg MySamsungNote7"}, {"hash":12556981,"name":"tformtomdroid.editprofilename.text","sourcebytes":[69,100,105,116,80,114,111,102,105,108,101,78,97,109,101],"value":"EditProfileName"}, {"hash":140743214,"name":"tformtomdroid.label1.caption","sourcebytes":[84,111,109,100,114,111,105,100,32,83,83,72,32,83,121,110,99,32,45,32,100,101,112,114,101,99,97,116,101,100,44,32,119,105,108,108,32,98,101,32,100,114,111,112,112,101,100,32,115,111,111,110,46],"value":"Tomdroid SSH Sync - deprecated, will be dropped soon."}, {"hash":118364981,"name":"tformtomdroid.label3.caption","sourcebytes":[80,114,111,102,105,108,101,32,78,97,109,101],"value":"Profile Name"}, {"hash":51581728,"name":"tformtomdroid.editipaddress.text","sourcebytes":[48,46,48,46,48,46,48],"value":"0.0.0.0"}, {"hash":141432181,"name":"tformtomdroid.label4.caption","sourcebytes":[73,80,32,97,100,100,114,101,115,115,32,111,102,32,100,101,118,105,99,101],"value":"IP address of device"}, {"hash":135848421,"name":"tformtomdroid.label5.caption","sourcebytes":[83,83,72,32,80,97,115,115,119,111,114,100,32,102,111,114,32,100,101,118,105,99,101],"value":"SSH Password for device"}, {"hash":366789,"name":"tformtomdroid.checksavepassword.caption","sourcebytes":[83,97,118,101],"value":"Save"}, {"hash":90721266,"name":"tformtomdroid.panel2.caption","sourcebytes":[80,97,110,101,108,50],"value":"Panel2"}, {"hash":249825044,"name":"tformtomdroid.labelserverid.caption","sourcebytes":[76,97,98,101,108,83,101,114,118,101,114,73,68],"value":"LabelServerID"}, {"hash":242626844,"name":"tformtomdroid.checkboxdebugmode.hint","sourcebytes":[119,114,105,116,101,115,32,100,101,98,117,103,32,109,101,115,115,97,103,101,115,32,116,111,32,116,101,114,109,105,110,97,108],"value":"writes debug messages to terminal"}, {"hash":194096693,"name":"tformtomdroid.checkboxdebugmode.caption","sourcebytes":[68,101,98,117,103,32,77,111,100,101],"value":"Debug Mode"}, {"hash":212229150,"name":"tformtomdroid.checkboxtestrun.caption","sourcebytes":[84,101,115,116,32,82,117,110],"value":"Test Run"}, {"hash":172922656,"name":"tformtomdroid.label2.caption","sourcebytes":[83,101,108,101,99,116,32,97,110,32,101,120,105,115,116,105,110,103,32,112,114,111,102,105,108,101,32,40,111,114,32,101,110,116,101,114,32,100,97,116,97,41,32],"value":"Select an existing profile (or enter data) "}, {"hash":194459653,"name":"tformtomdroid.label6.caption","sourcebytes":[85,112,108,111,97,100,32,109,101,97,110,115,32,102,114,111,109,32,116,111,109,98,111,121,45,110,103,32,116,111,32,65,110,100,114,111,105,100,32,68,101,118,105,99,101],"value":"Upload means from tomboy-ng to Android Device"}, {"hash":372803,"name":"tformtomdroid.buttonsync.caption","sourcebytes":[83,121,110,99],"value":"Sync"}, {"hash":36505973,"name":"tformtomdroid.buttonsaveprofile.caption","sourcebytes":[83,97,118,101,32,80,114,111,102,105,108,101],"value":"Save Profile"}, {"hash":322608,"name":"tformtomdroid.buttonhelp.caption","sourcebytes":[72,101,108,112],"value":"Help"}, {"hash":333310,"name":"tformtomdroid.buttonjoin.caption","sourcebytes":[74,111,105,110],"value":"Join"}, {"hash":196701653,"name":"tformtomdroid.buttondelete.caption","sourcebytes":[68,101,108,101,116,101,32,80,114,111,102,105,108,101],"value":"Delete Profile"} ]} ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������tomboy-ng_0.34-1/source/tb_utils.pas����������������������������������������������������������������0000644�0001750�0001750�00000047316�14145033507�017262� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������unit tb_utils; { Copyright (C) 2017-2021 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ } { A very simple unit that provides some utilities and simple Date / Time functions specificially tuned for tomboy-ng. It provides a means to convert a ISO8601 string to a TDataTime and back again with microSecond precision. Note that while the TDateTime will store it with that sort of precision, existing methods like now() are limited to milliSecond. TryISO8601ToDate() will accept no decimal places after a second or exactly three. No more or no less. So, we will pass unchanged if no decimal point, if there is one, we will remove it and process the content ourselves. A safe way to make a human readable date time string from any UTC TDateTime - var DT : TDateTime; St : string; if MyTryISO8601ToDate(DateSt, DT) then St := MyFormatDateTime(DT) else BadThingsHappened(); We could make a simpler function that just does it but I have found real problems with date strings and am inclined to be careful. ------- This unit is used in both TomboyTools and tomboy-ng, keep them in sync !!!! ------- HISTORY : 2021/01/29 Added TB_MakeFileName 2021/05/11 FindInStringList was not checking last line of list 2021/07/30 Added some methods from TT_Utils, need to merge back to TB-NG 2021/07/31 A fix to ensure that </note-content> is removed with metadata 2021/08/02 Merged back here from TomboyTools. 2021/08/27 Added the constants for multilevel bullets. 2021/10/26 User selectable date stamp format } {$mode objfpc}{$H+} interface uses Classes, SysUtils {$ifndef TESTRIG}, KMemo {$ifdef Linux}, libnotify{$endif}{$endif}; // pass 0 to MaxDateStampIndex, various datetime formats function TB_DateStamp(Index : integer) : string; // True if looks like an ID, 36 char and dash as #9 function IDLooksOK(const ID : string) : boolean; // Gets sent a string that is converted into something suitable to use as base filename function TB_MakeFileName(const Candidate : string) : string; function MyFormatDateTime(aUTCDateTime : TDateTime; HumanReadable : boolean = false) : string; // Will take a range of ISO-8601 dates and convert to DateTime, either local or UTC // Uses TryISO8601ToDate for all greater than uSec, then adds uSec back in. // If ReturnUTC is false returns local time function MyTryISO8601ToDate(DateSt : string; out OutDT : TDateTime; ReturnUTC : boolean = true) : boolean; function GetUTCOffset() : string; // returns a string with current datetime in a format like the Tomboy schema function TB_GetLocalTime: ANSIstring; // A version of MyTryISO8601ToDate that does not report errors as well. function TB_GetGMTFromStr(const DateStr: ANSIString): TDateTime; // Use whenever we are writing content that may contain <>& to XML files // If DoQuotes is true, we also convert ' and " (for xml attributes). function RemoveBadXMLCharacters(const InStr : ANSIString; DoQuotes : boolean = false) : ANSIString; // Note we restore only < > &, Tomboy does not encode " or ' in Values (but must in attributes) function RestoreBadXMLChar(const Str : AnsiString) : AnsiString; // returns a version of passed string with anything between < > removed function RemoveXml(const St : AnsiString) : AnsiString; // Returns (0-x) index of string that contains passed term, -1 if not present function FindInStringList(const StL : TStringList; const FindMe : string) : integer; // Passed FFN, thats <path><ID><.note> and returns the Title, munge indicates // make it suitable for use as a file name, an empty ret string indicates error function GetTitleFromFFN(FFN: string; Munge : boolean{; out LenTitle : integer}): string; // Remove all content up to and including <note-content ...> and all content // including and after </note-content>. Because we cannot guarantee that these // lines are on their own, we will need to poke into individual lines. // Maybe tolerant of gnote format. procedure RemoveNoteMetaData(STL : TStringList); function SayDebugSafe(st: string) : boolean; function TB_ReplaceFile(const SourceFile, DestFile : string) : boolean; // Escapes any double inverted commas and backslashs it finds in passed string. function EscapeJSON(St : string) : string; // Removes a NoteBook tag from a note function RemoveNoteBookTag(const FullFileName, NB : string) : boolean; {$ifdef Linux} // Linux only uses libnotify, Win and MacOS work through TrayIcon procedure ShowNotification(const Title, Message : string; ShowTime : integer = 6000); {$endif} // These are constants that refer to Bullet Levels, we map the KMemo names here. // Using them requires that we 'use' kmemo here. If not use'd, will still compile. // Each one MUST resolve to a different value in KMemo, do not overload. {$if declared(pnuCircleBullets)} // Defined in KMemo in later versions (mid to late 2021) const BulletOne = pnuTriangleBullets; BulletTwo = pnuBullets; BulletThree = pnuCircleBullets; BulletFour = pnuArrowOneBullets; BulletFive = pnuArrowTwoBullets; BulletSix = pnuLetterlo; BulletSeven = pnuRomanLo; BulletEight = pnuArabic; // BulletNine = pnuArabic; // Messes with case statements, 8 is our limit ! {$endif} const MaxDateStampIndex = 4; // Zero based index to date/Time Formats implementation uses dateutils, {$IFDEF LCL}LazLogger, {$ENDIF} {$ifdef LINUX} Unix, {$endif} // We call a ReReadLocalTime(); laz2_DOM, laz2_XMLRead, FileUtil; const ValueMicroSecond=0.000000000011574074; // ie double(1) / double(24*60*60*1000*1000); {$ifdef Linux} // Linux only uses libnotify, Win and MacOS work through TrayIcon procedure ShowNotification(const Title, Message : string; ShowTime : integer = 6000); {$ifndef TESTRIG} var LNotifier : PNotifyNotification; begin notify_init(argv[0]); LNotifier := notify_notification_new (pchar(Title), pchar(Message), pchar('dialog-information')); notify_notification_set_timeout(LNotifier, ShowTime); // figure is mS notify_notification_show (LNotifier, nil); notify_uninit; {$else} begin {$endif} end; {$endif} function RemoveNoteBookTag(const FullFileName, NB : string) : boolean; var InFile, OutFile: TextFile; InString : string; begin AssignFile(InFile, FullFileName); AssignFile(OutFile, FullFileName + '-temp'); Reset(InFile); Rewrite(OutFile); while not eof(InFile) do begin readln(InFile, InString); // Note, this leaves an empty set of <tags></tags>, does that matter ? if Pos('<tag>system:notebook:' + NB + '</tag>', InString) = 0 then writeln(OutFile, InString); end; CloseFile(OutFile); CloseFile(InFile); Result := TB_ReplaceFile(FullFileName + '-temp', FullFileName); if not Result then debugln('ERROR, RemoveNoteBookTag failed to mv ' + FullFileName+ '-temp to ' + FullFileName); end; function TB_ReplaceFile(const SourceFile, DestFile : string) : boolean; begin if not FileExists(SourceFile) then exit(SayDebugSafe('TB_ReplaceFile Failed to find ' + SourceFile)); {$ifdef WINDOWS} if not DeleteFile(DestFile) then exit(SayDebugSafe('TB_ReplaceFile Failed to delete ' + DestFile)); {$endif} result := RenameFile(SourceFile, DestFile); if not Result then SayDebugSafe('TB_ReplaceFile Failed to rename ' + SourceFile + ' to ' + DestFile); end; function TB_DateStamp(Index : Integer) : string; // make sure that you adjust MaxDateStampIndex (above) if adding formats begin result := ' date error '; case Index of 0 : result := FormatDateTime(' YYYY-MM-DD hh:mm:ss ', now()); // ISO 8601, 2020-09-14 08:37 1 : result := FormatDateTime(' dddd dd mmmm YYYY hh:mm am/pm ', now()); // Monday 29 December 2021 8:37 am much of the world 2 : result := FormatDateTime(' dddd, mmmm dd, YYYY hh:mm am/pm ', now()); // Monday, December 29, 2021 8:37 am US style 3 : result := FormatDateTime(' mmmm dd, YYYY hh:mm am/pm ', now()); // January 21, 2016 8:37 am US without DOW 4 : result := FormatDateTime(' YYYY-MM-DD dddd hh:mm:ss ', now()); // Monday 2020-09-14 08:37 ISO with added DOW end; end; // Escapes any double inverted commas and backslashs it finds in passed string. function EscapeJSON(St : string) : string; begin Result := St.Replace('\', '\\', [rfReplaceAll] ); Result := Result.Replace('"', '\"', [rfReplaceAll] ); end; function IDLooksOK(const ID : string) : boolean; begin if length(ID) <> 36 then exit(false); if pos('-', ID) <> 9 then exit(false); result := True; end; // Gets sent a string that is converted into something suitable to use as base filename function TB_MakeFileName(const Candidate : string) : string; var Ch : char; begin Result := StringReplace(Candidate, #32, '_', [rfReplaceAll]); for ch in [ '/', '\', '*', '.', '#', '%', '{', '}', '?', '&' ] do Result := StringReplace(Result, Ch, '-', [rfReplaceAll]); if Result.EndsWith('-') or Result.endswith('_') then Result := Result.Remove(Result.Length-1); end; function GetUTCOffset() : string; var Off : longint; begin Off := GetLocalTimeOffset(); // We assume that we are passed a UTC time ! if (Off div -60) >= 0 then Result := '+' else Result := '-'; if abs(Off div -60) < 10 then Result := Result + '0'; Result := Result + inttostr(abs(Off div -60)) + ':'; if (Off mod 60) = 0 then Result := result + '00' else Result := Result + inttostr(abs(Off mod 60)); end; function MyFormatDateTime(aUTCDateTime : TDateTime; HumanReadable : boolean = false) : string; var mSec, Cnt : longint; Remainder : double; DT : TDateTime; St : string; begin DT := UniversalTimeToLocal(aUTCDateTime); Result := FormatDateTime('YYYY-MM-DD', DT); if HumanReadable then exit(Result + ' ' + FormatDateTime('hh:mm:ss', DT)); // Gee, that was easy ! mSec := trunc(Frac(DT) / OneMilliSecond); remainder := frac(DT) - (mSec * OneMilliSecond); Cnt := trunc((1000*remainder) / OneMilliSecond); if Cnt > 999 then Cnt := 999; // We are playing down near limits of precision St := inttostr(Cnt); while length(St) < 4 do St := St + '0'; // NOTE : I require exactly 7 decimal places, you may not ! Result := Result + 'T' + FormatDateTime('hh:mm:ss.zzz', mSec * OneMilliSecond) + St; Result := Result + GetUTCOffset(); end; function MyTryISO8601ToDate(DateSt : string; out OutDT : TDateTime; ReturnUTC : boolean = true) : boolean; var I : integer; St : string = ''; begin OutDT := 0.0; if DateSt = '' then exit(False); Result := True; I := pos('.', DateSt); // if we have decimal point, we have stuff to do. if I > 0 then begin // TryISO8601ToDate cannot handle string with decimals of a second delete(DateSt, I, 1); // Remove decimal point while I < length(DateSt) do begin if DateSt[I] in ['0'..'9'] then begin St := St + DateSt[I]; // save digits to use later delete(DateSt, I, 1); end else break; end; // The first six digits in St represent microseconds. we will stop there. while length(St) > 6 do delete(St, length(St), 1); while length(St) < 6 do St := St + '0'; end; if TryISO8601ToDate(DateSt, OutDT, ReturnUTC) then begin // WARNING - apparently this is a FPC320 only feature if I > 0 then OutDT := OutDT + (St.ToDouble() * ValueMicroSecond); // ValueMicroSecond is Regional const, eg end else result := False; // ValueMicroSecond := 1.0 / double(24*60*60*1000*1000); end; function TB_GetLocalTime: ANSIstring; // The retuned date string includes four digits at the end representing a count // of 100 picoSeconds units. We cannot get that sort of precision and who needs it but // I have realised as tomboy-ng uses the datestring as a key to check that notes // are identical during a blind sync. So, instead of making those four digits 0000 // I will add a random number, not significent for timing but a usefull increase // in certaintly. var ThisMoment : TDateTime; Res : ANSIString; Off : longint; PicoSeconds : string; begin {$ifdef LINUX} ReReadLocalTime(); // in case we are near daylight saving time changeover {$endif} ThisMoment:=Now; PicoSeconds := inttostr(random(9999)); while length(PicoSeconds) < 4 do PicoSeconds := '0' + PicoSeconds; Result := FormatDateTime('YYYY-MM-DD',ThisMoment) + 'T' // + FormatDateTime('hh:mm:ss.zzz"0000"',ThisMoment); + FormatDateTime('hh:mm:ss.zzz',ThisMoment) + PicoSeconds; Off := GetLocalTimeOffset(); if (Off div -60) >= 0 then Res := '+' else Res := '-'; if abs(Off div -60) < 10 then Res := Res + '0'; Res := Res + inttostr(abs(Off div -60)) + ':'; if (Off mod 60) = 0 then Res := res + '00' else Res := Res + inttostr(abs(Off mod 60)); Result := Result + res; end; function TB_GetGMTFromStr(const DateStr: ANSIString): TDateTime; begin MyTryISO8601ToDate(DateStr, Result, True); end; function RemoveBadXMLCharacters(const InStr : ANSIString; DoQuotes : boolean = false) : ANSIString; // Don't use UTF8 versions of Copy() and Length(), we are working bytes ! // It appears that Tomboy only processes <, > and & , we also process single and double quote. // http://xml.silmaril.ie/specials.html var //Res : ANSIString; Index : longint = 1; Start : longint = 1; begin Result := ''; while Index <= length(InStr) do begin if InStr[Index] = '<' then begin Result := Result + Copy(InStr, Start, Index - Start); Result := Result + '<'; inc(Index); Start := Index; continue; end; if InStr[Index] = '>' then begin Result := Result + Copy(InStr, Start, Index - Start); Result := Result + '>'; inc(Index); Start := Index; continue; end; if InStr[Index] = '&' then begin // debugln('Start=' + inttostr(Start) + ' Index=' + inttostr(Index)); Result := Result + Copy(InStr, Start, Index - Start); Result := Result + '&'; inc(Index); Start := Index; continue; end; if DoQuotes then begin if InStr[Index] = '''' then begin // Ahhhh how to escape a single quote ???? Result := Result + Copy(InStr, Start, Index - Start); Result := Result + '''; inc(Index); Start := Index; continue; end; if InStr[Index] = '"' then begin Result := Result + Copy(InStr, Start, Index - Start); Result := Result + '"'; inc(Index); Start := Index; continue; end; end; inc(Index); end; Result := Result + Copy(InStr, Start, Index - Start); end; // Note we restore only < > &, Tomboy does not encode " or ' in Values (but must in attributes) function RestoreBadXMLChar(const Str : AnsiString) : AnsiString; var index : longint = 1; Start : longint = 1; begin // Don't use UTF8 functions here, we are working with bytes ! Result := ''; while Index <= Length(Str) do begin if '<' = Copy(Str, Index, 4) then begin Result := Result + Copy(Str, Start, Index - Start) + '<'; inc(Index); Start := Index + 3; Continue; end; if '>' = Copy(Str, Index, 4) then begin Result := Result + Copy(Str, Start, Index - Start) + '>'; inc(Index); Start := Index + 3; Continue; end; if '&' = Copy(Str, Index, 5) then begin Result := Result + Copy(Str, Start, Index - Start) + '&'; inc(Index); Start := Index + 4; Continue; end; inc(Index); end; Result := Result + Copy(Str, Start, Index - Start); end; function RemoveXml(const St : AnsiString) : AnsiString; var X, Y : integer; FoundOne : boolean = false; begin Result := St; repeat FoundOne := False; X := Pos('<', Result); // don't use UTF8Pos for byte operations if X > 0 then begin Y := Pos('>', Result); if Y > 0 then begin Delete(Result, X, Y-X+1); FoundOne := True; end; end; until not FoundOne; Result := trim(Result); end; function FindInStringList(const StL : TStringList; const FindMe : string) : integer; var I : integer = 0; begin if Stl = nil then exit(-1); while i < StL.Count {-1} do begin if pos(FindMe, StL.strings[i]) > 0 then exit(i); inc(i); end; result := -1; end; function SayDebugSafe(st: string) : boolean; begin {$ifdef LCL}Debugln{$else}writeln{$endif}(St); result := false; end; function GetTitleFromFFN(FFN: string; Munge : boolean{; out LenTitle : integer}): string; var Doc : TXMLDocument; Node : TDOMNode; // Index : integer = 1; begin if not FileExists(FFN) then begin SayDebugSafe('ERROR : File does not exist = ' + FFN); exit(''); end; ReadXMLFile(Doc, FFN); try Node := Doc.DocumentElement.FindNode('title'); result := Node.FirstChild.NodeValue; finally Doc.free; end; if Munge then Result := TB_MakeFileName(Result); { begin // remove char that don't belong in a file name while Index <= length(Result) do begin if Result[Index] in [ ' ', ':', '.', '/', '\', '|', '"', '''' ] then begin Result[Index] := '_'; end; inc(Index); end; Result := copy(Result, 1, 42); // Because 42 is the meaning of life end; } if Result = '' then SayDebugSafe('Title not found' + FFN); //LenTitle := length(Result); end; // Remove all content up to and including <note-content ...> and all content // including and after </note-content>. Because we cannot guarantee that these // lines are on their own, we will need to poke into individual lines. procedure RemoveNoteMetaData(STL : TStringList); var Index, CutOff : integer; St : string; begin // First, the trailing end. Index := FindInStringList(StL, '</note-content>'); // this is the line its on but we may have content on the same line St := Stl[Index]; CutOff := pos('</note-content>', St); if CutOff <> 1 then begin delete(St, CutOff, 1000); STL.Delete(Index); STL.Insert(Index, St); inc(Index); end; // Now Get rid of the remainder. while Index < StL.Count do StL.Delete(Index); // OK, now the start of the list Index := FindInStringList(StL, '<note-content'); while Index > 0 do begin STL.Delete(0); dec(Index); end; St := STL[0]; CutOff := St.IndexOf('>', St.IndexOf('<note-content')) +1; // Zero based index ! delete(St, 1, CutOff); STL.Delete(0); STL.Insert(0, St); end; end. ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������tomboy-ng_0.34-1/source/Tomboy_NG.lpr���������������������������������������������������������������0000644�0001750�0001750�00000003227�14145033507�017275� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������program Tomboy_NG; { Copyright (C) 2017-2021 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ History 27/12/2017 - Altered order to make the settings form the main one instead of RTSearch } {$mode objfpc}{$H+} {$define TOMBOY_NG} uses {$DEFINE UseCThreads} {$IFDEF UNIX}{$IFDEF UseCThreads} cmem, cthreads, {$ENDIF}{$ENDIF} Interfaces, // this includes the LCL widgetset LCLProc, Forms, Dialogs, printer4lazarus, SearchUnit, settings, SyncGUI, Notebook, Spelling, Mainunit, BackupView, recover, tomdroidFile, Index, autostart, hunspell, sync, syncutils, transandroid, ResourceStr, colours, cli, RollBack, commonmark, transfileand, notenormal, transgithub, import_notes, JsonTools; {$R *.res} begin Application.Scaled:=True; Application.Title:='tomboy-ng'; RequireDerivedFormResource:=True; Application.Initialize; if ContinueToGUI then begin Application.CreateForm(TMainForm, MainForm); Application.CreateForm(TSett, Sett); Application.CreateForm(TSearchForm, SearchForm); Application.CreateForm(TFormSync, FormSync); Application.CreateForm(TFormTomdroidFile, FormTomdroidFile); Application.CreateForm(TFormColours, FormColours); Application.CreateForm(TFormRollBack, FormRollBack); {$ifdef LINUX} {$endif} // Application.CreateForm(TNoteBookPick, NoteBookPick); // Application.CreateForm(TFormSpell, FormSpell); // Application.CreateForm(TEditBoxForm, EditBoxForm); Application.Run; end; end. �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������tomboy-ng_0.34-1/source/transfile.pas���������������������������������������������������������������0000644�0001750�0001750�00000031745�14145033507�017423� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������unit transfile; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ A unit that does the file transfer side of a FileSync operation HISTORY 2018/10/25 Much testing, support for Tomdroid. 2018/06/05 Change to doing Tomboy's sync dir names, rev 431 is in ~/4/341 2019/10/17 Ensure DownloadFile returns true remote dir name, irrespective of above. 2021/09/15 Added progress indicator to uploads and downloads } {$mode objfpc}{$H+} interface uses Classes, SysUtils, trans, SyncUtils, tb_utils, ResourceStr; // we share resources with GithubSync type { TFileSync } TFileSync = Class(TTomboyTrans) private function GetNoteLastChange(const FullFileName: string): string; // Reads the (filesync) remote Manifest for synced note details. It gets ID, RevNo // and, if its there the LastChangeDate. If LCD is not in manifest and GetLCD // is True, gets it from the file. function ReadRemoteManifest(const NoteMeta: TNoteInfoList; const GetLCD : boolean): boolean; public //RemoteDir : string; // where the remote filesync repo lives. function SetTransport(): TSyncAvailable; override; function TestTransport(const WriteNewServerID : boolean = False) : TSyncAvailable; override; function GetRemoteNotes(const NoteMeta : TNoteInfoList; const GetLCD : boolean) : boolean; override; function DownloadNotes(const DownLoads : TNoteInfoList) : boolean; override; function DeleteNote(const ID : string; const ExistRev : integer) : boolean; override; function UploadNotes(const Uploads : TStringList) : boolean; override; function DoRemoteManifest(const RemoteManifest : string; MetaData : TNoteInfoList = nil) : boolean; override; function DownLoadNote(const ID : string; const RevNo : Integer) : string; Override; // function SetRemoteRepo(ManFile : string = '') : boolean; override; constructor Create(); end; implementation uses laz2_DOM, laz2_XMLRead, LazFileUtils, FileUtil, LazLogger; { TFileSync } function TFileSync.SetTransport(): TSyncAvailable; begin Result := SyncReady; end; function TFileSync.TestTransport(const WriteNewServerID : boolean = False): TSyncAvailable; var Doc : TXMLDocument; GUID : TGUID; ManExists, ZeroExists : boolean; // for readability of code only begin RemoteAddress := AppendPathDelim(RemoteAddress); if not DirectoryExists(RemoteAddress) then if not DirectoryExists(RemoteAddress) then begin // try again because it might be just remounted. ErrorString := 'Remote Dir does not exist ' + #10 + RemoteAddress; exit(SyncNoRemoteDir); end; if not DirectoryIsWritable(RemoteAddress) then begin ErrorString := 'Remote directory NOT writable ' + RemoteAddress; exit(SyncNoRemoteWrite); end; if ANewRepo then begin CreateGUID(GUID); ServerID := copy(GUIDToString(GUID), 2, 36); // it arrives here wrapped in {} RemoteServerRev := -1; exit(SyncReady); end; ManExists := FileExists(RemoteAddress + 'manifest.xml'); ZeroExists := DirectoryExists(RemoteAddress + '0'); if (not ManExists) and (not ZeroExists) then begin ErrorString := 'Remote dir does not contain a Repo ' + RemoteAddress; exit(SyncNoRemoteRepo); end; if (ManExists) and (not ZeroExists) then begin ErrorString := 'Apparently damaged repo, missing 0 dir at ' + RemoteAddress; exit(SyncBadRemote); end; if (not ManExists) and (ZeroExists) then begin ErrorString := 'Apparently damaged repo, missing manifest at ' + RemoteAddress; exit(SyncBadRemote); end; // If to here, looks and feels like a repo, lets see what it can tell ! try try ReadXMLFile(Doc, RemoteAddress + 'manifest.xml'); ServerID := Doc.DocumentElement.GetAttribute('server-id'); { ToDo : must check for error on next line } RemoteServerRev := strtoint(Doc.DocumentElement.GetAttribute('revision')); finally Doc.Free; end; except on E: EAccessViolation do begin ErrorString := E.Message; exit(SyncXMLERROR); // probably means we did not find an expected attribute end; on E: EFOpenError do begin ErrorString := E.Message; exit(SyncNoRemoteMan); // File is not present. end; end; if 36 <> length(ServerID) then begin ErrorString := 'Invalid ServerID'; exit(SyncXMLError); end; Result := SyncReady; end; function TFileSync.GetRemoteNotes(const NoteMeta: TNoteInfoList; const GetLCD : boolean): boolean; begin if NoteMeta = Nil then begin ErrorString := 'Passed an uncreated list to GetNewNotes()'; exit(False); end; if FileExists(RemoteAddress + 'manifest.xml') then ReadRemoteManifest(NoteMeta, GetLCD); // No remote manifest is aceptable here, new repo result := True; end; function TFileSync.ReadRemoteManifest(const NoteMeta: TNoteInfoList; const GetLCD : boolean) : boolean; var Doc : TXMLDocument; NodeList : TDOMNodeList; Node : TDOMNode; j : integer; NoteInfo : PNoteInfo; begin Result := true; try try ReadXMLFile(Doc, RemoteAddress + 'manifest.xml'); NodeList := Doc.DocumentElement.ChildNodes; if assigned(NodeList) then begin for j := 0 to NodeList.Count-1 do begin new(NoteInfo); NoteInfo^.Action:=SyUnset; Node := NodeList.Item[j].Attributes.GetNamedItem('id'); NoteInfo^.ID := Node.NodeValue; // ID does not contain '.note'; Node := NodeList.Item[j].Attributes.GetNamedItem('rev'); NoteInfo^.Rev := strtoint(Node.NodeValue); // what happens if its empty ? Node := NodeList.Item[j].Attributes.GetNamedItem('last-change-date'); if assigned(node) then NoteInfo^.LastChange:=Node.NodeValue else if GetLCD then begin // Only bother to get it if we really need it if UsingRightRevisionPath(RemoteAddress, NoteInfo^.Rev) then NoteInfo^.LastChange := GetNoteLastChange(GetRevisionDirPath(RemoteAddress, NoteInfo^.Rev, NoteInfo^.ID)) else NoteInfo^.LastChange := GetNoteLastChange(RemoteAddress + '0' + pathdelim + inttostr(NoteInfo^.Rev) // Ugly Hack + pathdelim + NoteInfo^.ID + '.note'); end; if NoteInfo^.LastChange <> '' then NoteInfo^.LastChangeGMT := TB_GetGMTFromStr(NoteInfo^.LastChange); NoteMeta.Add(NoteInfo); end; end; finally Doc.Free; end; except on E: EAccessViolation do Result := false; // probably means we did not find an expected attribute on E: EFOpenError do Result := False; // File is not present. end; if Result = True then begin if debugmode then Debugln('Transfile.ReadRemoteManifest - read OK'); end else DebugLn('We failed to read the remote manifest file ', RemoteAddress + 'manifest.xml'); end; function TFileSync.GetNoteLastChange(const FullFileName : string) : string; begin Result := GetNoteLastChangeSt(FullFileName, ErrorString); // syncutils function end; function TFileSync.DownloadNotes(const DownLoads: TNoteInfoList): boolean; var I : integer; DLCount : integer = 0; FullFileName : string; DownCount : integer = 0; begin if ProgressProcedure <> nil then progressProcedure(rsDownloadNotes); if not DirectoryExists(NotesDir + 'Backup') then if not ForceDirectory(NotesDir + 'Backup') then begin ErrorString := 'Failed to create Backup directory.'; exit(False); end; for I := 0 to DownLoads.Count-1 do begin if DownLoads.Items[I]^.Action = SyDownLoad then begin inc(DLCount); if (DLCount mod 5 = 0) and (ProgressProcedure <> nil) then ProgressProcedure(rsDownLoaded + ' ' + inttostr(DLCount) + ' notes'); if FileExists(NotesDir + Downloads.Items[I]^.ID + '.note') then // First make a Backup copy if not CopyFile(NotesDir + Downloads.Items[I]^.ID + '.note', NotesDir + 'Backup' + PathDelim + Downloads.Items[I]^.ID + '.note') then begin ErrorString := 'Failed to copy file to Backup ' + NotesDir + Downloads.Items[I]^.ID + '.note'; exit(False); end; // OK, now copy the file. if UsingRightRevisionPath(RemoteAddress, DownLoads.Items[i]^.Rev) then FullFilename := GetRevisionDirPath(RemoteAddress, DownLoads.Items[i]^.Rev , Downloads.Items[I]^.ID) else FullFilename := RemoteAddress + '0' + pathdelim + inttostr(DownLoads.Items[i]^.Rev) // Ugly Hack + pathdelim + Downloads.Items[I]^.ID + '.note'; if DebugMode then debugln('Will download ' + FullFilename); if not CopyFile(FullFileName, NotesDir + Downloads.Items[I]^.ID + '.note') then begin ErrorString := 'Failed to copy ' + Downloads.Items[I]^.ID + '.note'; exit(False); end; inc(DownCount); if (DownCount mod 10 = 0) then if ProgressProcedure <> nil then ProgressProcedure(rsDownLoaded + ' ' + inttostr(DownCount) + ' notes'); end; end; result := True; end; function TFileSync.DeleteNote(const ID: string; const ExistRev : integer ): boolean; begin // I _THINK_ all that happens is deleted note is not listed in remote manifest // and that is done. But other thansport modes might need to do something here ? result := True; end; function TFileSync.UploadNotes(const Uploads: TStringList): boolean; var Index : integer; UpCount : integer = 0; FullDirName : string; begin if ProgressProcedure <> nil then progressProcedure('Uploading ' + inttostr(UpLoads.Count) + ' notes'); if UsingRightRevisionPath(RemoteAddress, RemoteServerRev + 1) then FullDirName := GetRevisionDirPath(RemoteAddress, RemoteServerRev + 1) else FullDirName := RemoteAddress + '0' + PathDelim + inttostr(RemoteServerRev + 1) + PathDelim; // Ugly Hack for Index := 0 to Uploads.Count -1 do begin if DebugMode then debugln(rsUpLoading + ' ' + Uploads.Strings[Index] + '.note'); if not copyFile(NotesDir + Uploads.Strings[Index] + '.note', FullDirname + Uploads.Strings[Index] + '.note') then begin ErrorString := 'ERROR copying ' + NotesDir + Uploads.Strings[Index] + '.note to ' + FullDirName + Uploads.Strings[Index] + '.note'; debugln(ErrorString); exit(False); end; inc(UpCount); if (UpCount mod 5 = 0) and (ProgressProcedure <> nil) then progressProcedure(rsUpLoaded + ' ' + inttostr(UpCount) + ' notes'); end; result := True; end; function TFileSync.DoRemoteManifest(const RemoteManifest: string; MetaData : TNoteInfoList = nil): boolean; begin if not ForceDirectoriesUTF8(GetRevisionDirPath(RemoteAddress, RemoteServerRev + 1)) then begin ErrorString := 'Failed to create new remote revision dir ' + GetRevisionDirPath(RemoteAddress, RemoteServerRev + 1); debugln(ErrorString); exit(False); end; if debugmode then debugln('Remote Manifest is ' + RemoteManifest); if not CopyFile(RemoteManifest, RemoteAddress + 'manifest.xml') then begin ErrorString := 'Failed to move new root remote manifest file ' + RemoteManifest; debugln(ErrorString); exit(False); end; if not CopyFile(RemoteManifest, GetRevisionDirPath(RemoteAddress, RemoteServerRev + 1) + 'manifest.xml') then begin ErrorString := 'Failed to move new remote manifest file to revision dir'; debugln(ErrorString); exit(False); end; Result := True; end; function TFileSync.DownLoadNote(const ID: string; const RevNo: Integer): string; begin //Result := RemoteAddress + '0' + PathDelim + inttostr(RevNo) + PathDelim + ID + '.note'; // Due to early bug in -ng, its possible that a file on eg sync rev 393 is in // either ~/0/393 or in ~/3/393 - we cannot assume here folks ! Result := GetRevisionDirPath(RemoteAddress, RevNo, ID); if FileExists(Result) then exit; Result := RemoteAddress + '0' + PathDelim + inttostr(RevNo) + PathDelim + ID + '.note'; if not FileExists(Result) then debugln('transfile -> Download() Unable to locate file ' + inttostr(RevNo) + ' ' + ID); end; constructor TFileSync.Create(); begin ProgressProcedure := nil; end; end. ���������������������������tomboy-ng_0.34-1/source/notebook.pas����������������������������������������������������������������0000644�0001750�0001750�00000062235�14145033507�017252� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������unit Notebook; { Copyright (C) 2017-2021 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ This GUI based unit has a form to allow user to see and select what notebooks the current note is a member of. It looks at settings to see if we are allowing a particular note to be a member of more than one notebook. If not, will cancel a previous choice if a user selects a new notebook. This form is created dynamically and shown modal, the user can only open one at a time. If shown non-modal, there is a danger form will get lost .... History - 2018/01/30 -replaced the function that cancels previous Notebook selection when a new one is made (if settings so demand). This one works on Macs and is a better job on the other platforms too. 2018/04/13 Now call NotebookPick Form dynamically and ShowModal to ensure two notes don't share. 2018/05/12 Extensive changes - MainUnit is now just that. Only change here relates to naming of MainUnit and SearchUnit. 2019/05/18 Corrected alignment Label1 and 3 2019/05/19 Display strings all (?) moved to resourcestrings 2020/02/19 Do not escape new notebook title as sent to notelister. 2020/05/19 Do not go through ButtonOKOnClick if ModalResult is already set to mrOK 2020/08/10 In Windows, SetFocus was setting ModalRes to 1, so, would immediatly close ?? 2021/11/04 Extensive changes to support new Notebook management model from SearchForm } {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, CheckLst, ExtCtrls, StdCtrls, Buttons, ComCtrls; type NotebookMode = ( // Changing name of a notebook, need Name in .... nbChangeName, // Open in TabChangeName, hide all others. Call from Search // Set the Notebooks a note is in, need FullFileName, Title. Call from nbSetNoteBooks, // the note itself. Open in TabExisting, also show TabNewNoteBook, hide others // Make a new NoteBook, nbMakeNewNoteBook, // Open in TabNewNoteBook, also show but disable TabSetNotes, hide others // Set the notes that are a member of this noteook, need NBName nbSetNotesInNoteBook // Open in TabSetNotes, hide all others ); type { TNoteBookPick } TNoteBookPick = class(TForm) Button1: TButton; ButtonOK: TButton; CheckListBox1: TCheckListBox; CheckListAddNotes: TCheckListBox; EditNewNotebookName: TEdit; EditNewNotebook: TEdit; Label1: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; Label5: TLabel; Label6: TLabel; Label7: TLabel; Label8: TLabel; Label9: TLabel; PageControl1: TPageControl; Panel1: TPanel; TabExisting: TTabSheet; TabNewNoteBook: TTabSheet; TabChangeName: TTabSheet; TabSetNotes: TTabSheet; procedure ButtonOKClick(Sender: TObject); procedure CheckListBox1ItemClick(Sender: TObject; Index: integer); procedure EditNewNotebookKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure EditNewNotebookNameEditingDone(Sender: TObject); procedure FormShow(Sender: TObject); procedure SetupForAddNotes(); procedure TabNewNoteBookShow(Sender: TObject); private { A list pointer that will point to list of notes that are members of the notebook who's name we are about to change } NBIDList : TStringList; { Actually do all the stuff necessary when we change a notebook name } procedure AdjustNBookNotes(); function ChangeNoteBookName(NewName: string): boolean; procedure InsertNoteBookTag(const FullFileName, NB: string); function MakeNewNoteBook: boolean; function RewriteTempate(const FileName, NewName: string ): boolean; function RewriteWithNewNotebookName(FileName: string): boolean; procedure SetNoteBooks; { User wants to change the name of a Notebook, Title is name of Notebook } procedure SetupForChange(); { Allow user to select an existing Notebook or make a new one } procedure SetupForNewSelect(); public TheMode : NoteBookMode; // Just what are we doing here ? FullFileName : ANSIString; // The filename of the Note that invoked self. So, apply to this note oonly. Title : ANSIString; // Title of note that invoked self. NBName : string; // Notebook Name, means we are working with just this notebook. ChangeMode : boolean; // Indicates we wish to rename existing notebook. end; {var NoteBookPick: TNoteBookPick; } implementation {$R *.lfm} { TNoteBookPick } uses SearchUnit, LazFileUtils, LCLProc, LCLType, Settings, SaveNote, EditBox, resourcestr, tb_utils, note_lister {$ifdef WINDOWS}, SyncUtils{$endif}; // SafeWindowsDelete procedure TNoteBookPick.SetupForNewSelect(); var SL : TStringList; Index, I : Integer; begin PageControl1.ActivePage := TabExisting; TabExisting.TabVisible := True; TabNewNotebook.TabVisible := True; TabSetNotes.TabVisible := False; TabChangeName.TabVisible := False; Label1.Caption := Title; Label3.Caption := rsSetTheNotebooks; SL := TStringList.Create; TheNoteLister.GetNotebooks(SL, ''); CheckListBox1.Items.Assign(SL); SL.Free; SL := TStringList.Create; TheNoteLister.GetNotebooks(SL, ExtractFileNameOnly(FullFileName) + '.note'); for I := 0 to CheckListBox1.Count-1 do CheckListBox1.Checked[I] := False; for Index := 0 to SL.Count -1 do for I := 0 to CheckListBox1.Count-1 do if SL[Index] = CheckListBox1.Items[I] then CheckListBox1.Checked[I] := True; SL.Free; end; procedure TNoteBookPick.SetupForChange(); {var NoteID : String;} begin // Note : NBIDList does not need to be created or freed. Just a pointer. PageControl1.ActivePage := TabChangeName; TabNewNotebook.TabVisible := False; TabSetNotes.TabVisible := False; TabChangeName.TabVisible := True; TabExisting.TabVisible := False; Label3.Caption := rsChangeNameofNotebook; Label7.Caption := Title; if not TheNoteLister.GetNotesInNoteBook(NBIDList, Title) then debugln('ERROR - Notebook.pas #152 No member notes found'); Label1.Caption := format(rsNumbNotesAffected, [NBIDList.Count]); EditNewNotebookName.SetFocus; end; procedure TNoteBookPick.SetupForAddNotes(); var STL : TStringList=Nil; // does not require create/free Index, I : integer; begin PageControl1.ActivePage := TabSetNotes; TabSetNotes.Enabled := True; TabExisting.TabVisible := False; TabNewNotebook.TabVisible := False; TabChangeName.TabVisible := False; Label1.Caption := NBName; Label3.Caption := rsAddNotesToNotebook; TheNoteLister.LoadStrings(CheckListAddNotes.Items); TheNoteLister.GetNotesInNoteBook(STL, NBName); // Might set STL to nil if (STL <> Nil) and (STL.Count > 0) then begin for Index := 0 to CheckListAddNotes.Count -1 do begin for i := 0 to STL.Count-1 do begin if CheckListAddNotes.Items[Index] = TheNoteLister.GetTitle(STL[i]) then begin CheckListAddNotes.Checked[Index] := True; continue; end; end; end; end; end; procedure TNoteBookPick.TabNewNoteBookShow(Sender: TObject); begin EditNewNotebook.SetFocus; end; { If ChangeMode we are changing the name of a notebook. Messy. Else - If FullFileName has something in it, then we are managing the NoteBooks that note is in. If its neither ChangeMode nor FullFileName then its one of If NBName has something, we are managing the notes that are in that NoteBook. } procedure TNoteBookPick.FormShow(Sender: TObject); begin if Sett.CheckManyNotebooks.Checked then Label2.Caption := rsMultipleNoteBooks else Label2.Caption := rsOneNoteBook; case TheMode of nbSetNoteBooks : SetupForNewSelect(); nbMakeNewNoteBook : begin Label5.Caption := rsEnterNewNotebook; PageControl1.ActivePage := TabNewNotebook; TabExisting.TabVisible := False; TabNewNotebook.TabVisible := True; TabSetNotes.Visible := True; TabChangeName.TabVisible := False; TabSetNotes.Enabled := False; end; nbSetNotesInNoteBook : SetupForAddNotes(); nbChangeName : SetUpForChange(); end; ModalResult := 0; // On windows, 'something' in setfocus sets this to 1 ! end; procedure TNoteBookPick.CheckListBox1ItemClick(Sender: TObject; Index: integer); var I : integer; begin if Sett.CheckManyNotebooks.Checked then exit; // ensure only one clicked. if (Sender as TCheckListBox).Checked[Index] then begin for I := 0 to CheckListBox1.Count -1 do CheckListBox1.Checked[I] := False; CheckListBox1.Checked[Index] := True; end; end; procedure TNoteBookPick.EditNewNotebookKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key = VK_RETURN then begin key := 0; ButtonOK.Click; end; end; procedure TNoteBookPick.EditNewNotebookNameEditingDone(Sender: TObject); // this one for change begin ButtonOK.Click; end; function TNoteBookPick.RewriteWithNewNotebookName(FileName : string) : boolean; var InFile, OutFile: TextFile; {NoteDateSt, }InString, TempName, NextSeekString : string; begin if not fileexists(Sett.NoteDirectory + FileName) then exit(false); // if its not there, the note has just been deleted TempName := AppendPathDelim(Sett.NoteDirectory) + 'tmp'; if not DirectoryExists(TempName) then CreateDir(AppendPathDelim(tempname)); TempName := tempName + pathDelim + FileName; AssignFile(InFile, Sett.NoteDirectory + FileName); AssignFile(OutFile, TempName); try try Reset(InFile); Rewrite(OutFile); NextSeekString := '<last-change-date>'; while not eof(InFile) do begin readln(InFile, InString); if (Pos(NextSeekString, InString) > 0) then begin case NextSeekString of '<last-change-date>' : begin writeln(outFile, ' <last-change-date>' + TB_GetLocalTime() + '</last-change-date>'); NextSeekString := '<last-metadata-change-date>'; end; '<last-metadata-change-date>' : begin writeln(outFile, ' <last-metadata-change-date>' + TB_GetLocalTime() + '</last-metadata-change-date>'); NextSeekString := '<y>'; end; '<y>' : begin writeln(OutFile, InString); write(OutFile, TheNoteLister.NoteBookTags(Filename)); NextSeekString := '<tags>'; end; '<tags>' : begin readln(InFile, InString); // Danger, wot if we hit EOF ? while pos('<tag>', Instring) > 0 do readln(InFile, InString); // now we have the </tags> line. NextSeekString := '321-blar-blar-blar-blar-123'; end; end; end else writeln(OutFile, InString); end; // end of while loop. //writeln(OutFile, '</note>'); finally CloseFile(OutFile); CloseFile(InFile); end; except on E: EInOutError do begin debugln('File handling error occurred updating clean note location. Details: ' + E.Message); exit(False); end; end; {$ifdef WINDOWS} if not SafeWindowsDelete(Sett.NoteDirectory + FileName, NextSeekstring) then begin showmessage(NextSeekString); exit(false); end; {$endif} result := CopyFile(TempName, Sett.NoteDirectory + FileName); end; function TNoteBookPick.RewriteTempate(const FileName, NewName : string) : boolean; var InFile, OutFile: TextFile; InString, TempName, NextSeekString : string; begin if not fileexists(Sett.NoteDirectory + FileName) then exit(false); // if its not there, the note has just been deleted TempName := AppendPathDelim(Sett.NoteDirectory) + 'tmp'; if not DirectoryExists(TempName) then CreateDir(AppendPathDelim(tempname)); TempName := tempName + pathDelim + FileName; AssignFile(InFile, Sett.NoteDirectory + FileName); AssignFile(OutFile, TempName); try try Reset(InFile); Rewrite(OutFile); NextSeekString := '<title>'; while not eof(InFile) do begin readln(InFile, InString); if (Pos(NextSeekString, InString) > 0) then begin case NextSeekString of '<title>' : begin writeln(outFile, '<title>' + NewName + ' Template'); NextSeekString := '' + NewName + ' Template'); NextSeekString := ''; end; '' : begin writeln(outFile, ' ' + TB_GetLocalTime() + ''); NextSeekString := ''; end; '' : begin writeln(outFile, ' ' + TB_GetLocalTime() + ''); NextSeekString := ''; end; '' : begin writeln(OutFile, InString); writeln(OutFile, ' '); writeln(OutFile, ' system:template'); writeln(OutFile, ' system:notebook:' + NewName + ''); writeln(OutFile, ' '); NextSeekString := ''; end; '' : begin // just drop on floor. readln(InFile, InString); // Danger, wot if we hit EOF ? while pos('', Instring) > 0 do readln(InFile, InString); // now we have the line. NextSeekString := '321-blar-blar-blar-blar-123'; // wow, if we find that ??? end; end; end else writeln(OutFile, InString); end; // end of while loop. finally CloseFile(OutFile); CloseFile(InFile); end; except on E: EInOutError do begin debugln('File handling error occurred updating template. Details: ' + E.Message); exit(False); end; end; {$ifdef WINDOWS} if not SafeWindowsDelete(Sett.NoteDirectory + FileName, NextSeekstring) then begin showmessage(NextSeekString); exit(false); end; {$endif} result := CopyFile(TempName, Sett.NoteDirectory + FileName); end; function TNoteBookPick.ChangeNoteBookName(NewName : string) : boolean; { 1. We have a list of all the notes that are members of this notebook. 2. Change the Notebook name stored in the Notebook data structure. 3. For notes that are open, just force a write, reach in and mark dirty.... 4. For notes that are not open, we rewrite them, setting a new list of notebook tags according to the data structure, a new last-change-date and a last-metadata-change-date. 5. Rewrite Template, give it a new Title (which is new Notebook Name plus ' Template') which needs to be written twice, updated last-change-date and last-metadata-change-date, finally remove its one Notebook name and replace it with new notebook name. VERY IMPORTANT that end user has fully sync'ed before doing this. Else we might leave notes on remote machine that believe they belong to a missing notebook. } var IDstr, TemplateID : string; OpenForm : TForm; //TEditBoxForm; begin result := true; TemplateID := Thenotelister.NotebookTemplateID(Title); if TemplateID = '' then begin showmessage('Failed to ID Template [' + Title + '] (' + NewName + ')'); exit(false); end; TheNoteLister.AlterNotebook(Title, NewName); for IDstr in NBIDList do begin if TheNoteLister.IsThisNoteOpen(IDStr, OpenForm) then TEditBoxForm(OpenForm).Dirty:= true else RewriteWithNewNotebookName(IDstr); end; // OK, now change template ...... // debugln('template is ' + SearchForm.notelister.NotebookTemplateID(Title)); RewriteTempate(TemplateID, RemoveBadXMLCharacters(NewName)); ModalResult := mrOK; close; end; { After use presses OK on AddNotes tab, we need to make the file/notelister notebook status agree with the displayed CheckListBox. Its for one particular Notebook, so I ask notelister for a list of notes it believes belong to this NoteBook } procedure TNoteBookPick.InsertNoteBookTag(const FullFileName, NB : string); var InFile, OutFile: TextFile; InString : string; begin AssignFile(InFile, FullFileName); AssignFile(OutFile, FullFileName + '-temp'); try try Reset(InFile); Rewrite(OutFile); while not eof(InFile) do begin readln(InFile, InString); if (Pos('', InString) > 0) then begin // OK, next line may already have .... writeln(OutFile, InString); readln(InFile, InString); if (Pos('', InString) > 0) then begin // Already has , we add ours writeln(outFile, InString); // Thats writeln(outFile, ' system:notebook:' + NB + ''); end else begin // we need to add the lot writeln(outFile, ' '#10' system:notebook:' + NB + ' '#10''); writeln(outFile, InString); // whatever it is end; end else writeln(OutFile, InString); end; finally CloseFile(OutFile); CloseFile(InFile); end; except on E: EInOutError do debugln('File handling error occurred. Details: ' + E.Message); end; if not TB_ReplaceFile(FullFileName + '-temp', FullFileName) then debugln('ERROR, TNoteBookPick.InsertNoteBookTag failed to mv ' + FullFileName + '-temp to ' + FullFileName); end; { Will adjust on disk note file and NoteLister to agree with NoteBook content shown in CheckListAddNotes. } procedure TNoteBookPick.AdjustNBookNotes(); var STL : TStringList; // gets set to point to a list of FNames of notes in NBName Index, i : integer; InNoteList, InCheckList : boolean; // if true, Note is a member of NBName (in relevent view) FName : string; Dummy : TForm; begin TheNoteLister.GetNotesInNoteBook(STL, NBName); // Might set STL to nil for Index := 0 to CheckListAddNotes.Count -1 do begin // A list of note Titles // So, of the IDs in STL, does one of them have a title to match the one in CheckListAddNotes[Index] ? InNoteList := False; i := 0; while i < STL.count do begin //for i := 0 to STL.count - 1 do if TheNoteLister.GetTitle(STL[i]) = CheckListAddNotes.Items[Index] then begin InNoteList := True; break; end; inc(i); end; InCheckList := CheckListAddNotes.Checked[Index]; if InNoteList and InCheckList then continue; if not (InNoteList or InCheckList) then continue; // OK, some action is required FName := string(CheckListAddNotes.Items.Objects[Index]); // Thats the short file name, ID.note if InNoteList and (not InCheckList) then begin // remove tag from note and notelister STL.Delete(i); // Remove the NoteLister entry RemoveNoteBookTag(Sett.NoteDirectory+FName, NBName); end; if (not InNoteList) and InCheckList then begin // add tag to note and notelister TheNoteLister.AddNoteBook(FName, NBName, false); // Update internal data view if not TheNoteLister.IsThisNoteOpen(FName, Dummy) then // update on disk files InsertNoteBookTag(Sett.NoteDirectory+FName, NBName); end; end; end; // Makes a new NoteBook from TabNewNoteBook function TNoteBookPick.MakeNewNoteBook : boolean; begin if TheNoteLister.IsANotebookTitle(EditNewNotebook.Text) then begin showmessage('That notebook already exists.'); exit(false); end; if EditNewNotebook.Text = '' then begin showmessage(rsEnterNewNotebook); exit(false); end; SaveNewTemplate(EditNewNotebook.Text); // that will also add the notebook to Note_Lister NBName := EditNewNotebook.Text; if TheMode = nbMakeNewNoteBook then SetupForAddNotes() else begin TheNoteLister.AddNoteBook(ExtractFileNameOnly(FullFileName) + '.note', EditNewNotebook.Text, False); // that adds the current note to the newly created notebook. SearchForm.RefreshNotebooks(); end; end; // Sets one note to be a member of the Notebooks checked in TabExisting. procedure TNotebookPick.SetNoteBooks; var SL : TStringList; Index : Integer; begin SL := TStringList.Create; // That is TabExisting try for Index := 0 to CheckListBox1.Count -1 do if CheckListBox1.Checked[Index] then SL.Add(CheckListBox1.Items[Index]); TheNoteLister.SetNotebookMembership(ExtractFileNameOnly(FullFileName) + '.note', SL); finally Sl.Free; end; end; procedure TNoteBookPick.ButtonOKClick(Sender: TObject); begin if ModalResult = mrOK then exit; case TheMode of nbSetNoteBooks : if PageControl1.ActivePage = TabExisting then SetNoteBooks else MakeNewNoteBook; nbMakeNewNoteBook : if not MakeNewNoteBook then exit; // Exit if invalid NB name nbSetNotesInNoteBook : AdjustNBookNotes; // Make file/notelister agree with user selctions nbChangeName : if EditNewNotebookName.Text <> '' then if not ChangeNoteBookName(EditNewNotebookName.Text) then exit; end; if TheMode = nbMakeNewNoteBook then begin // don't close, mv to SetNotes mode TheMode := nbSetNotesInNoteBook; exit; end; ModalResult := mrOK; end; end. tomboy-ng_0.34-1/source/recover.lrj0000644000175000017500000001570214145033507017100 0ustar dbannondbannon{"version":1,"strings":[ {"hash":150275554,"name":"tformrecover.caption","sourcebytes":[70,111,114,109,82,101,99,111,118,101,114],"value":"FormRecover"}, {"hash":86477809,"name":"tformrecover.label1.caption","sourcebytes":[76,97,98,101,108,49],"value":"Label1"}, {"hash":115464352,"name":"tformrecover.listboxsnapshots.hint","sourcebytes":[84,104,101,115,101,32,97,114,101,32,116,104,101,32,99,117,114,114,101,110,116,108,121,32,107,110,111,119,110,32,115,110,97,112,115,104,111,116,115,46,32],"value":"These are the currently known snapshots. "}, {"hash":247404302,"name":"tformrecover.tabsheetintro.caption","sourcebytes":[73,110,116,114,111,100,117,99,116,105,111,110],"value":"Introduction"}, {"hash":77890286,"name":"tformrecover.label6.caption","sourcebytes":[84,104,105,115,32,116,111,111,108,32,109,105,103,104,116,32,104,101,108,112,32,121,111,117,32,114,101,99,111,118,101,114,32,108,111,115,116,32,111,114,32,100,97,109,97,103,101,100,32,110,111,116,101,115,46],"value":"This tool might help you recover lost or damaged notes."}, {"hash":82347246,"name":"tformrecover.label7.caption","sourcebytes":[66,101,102,111,114,101,32,121,111,117,32,115,116,97,114,116,44,32,116,97,107,101,32,97,32,83,110,97,112,115,104,111,116,32,111,102,32,121,111,117,114,32,110,111,116,101,115,32,100,105,114,101,99,116,111,114,121,46],"value":"Before you start, take a Snapshot of your notes directory."}, {"hash":256349950,"name":"tformrecover.label10.caption","sourcebytes":[80,108,101,97,115,101,32,99,108,111,115,101,32,97,110,121,32,110,111,116,101,115,32,121,111,117,32,109,97,121,32,104,97,118,101,32,111,112,101,110,46],"value":"Please close any notes you may have open."}, {"hash":26163774,"name":"tformrecover.buttonmakesafetysnap.hint","sourcebytes":[84,97,107,101,32,97,32,105,110,105,116,105,97,108,32,115,110,97,112,115,104,111,116,32,111,102,32,121,111,117,114,32,110,111,116,101,115,32,97,110,100,32,99,111,110,102,105,103,46,32,79,118,101,114,119,114,105,116,116,101,110,32,101,97,99,104,32,116,105,109,101,46],"value":"Take a initial snapshot of your notes and config. Overwritten each time."}, {"hash":106340756,"name":"tformrecover.buttonmakesafetysnap.caption","sourcebytes":[84,97,107,101,32,97,32,109,97,110,117,97,108,32,83,110,97,112,115,104,111,116],"value":"Take a manual Snapshot"}, {"hash":204248048,"name":"tformrecover.buttonsnaphelp.caption","sourcebytes":[83,110,97,112,115,104,111,116,32,72,101,108,112],"value":"Snapshot Help"}, {"hash":106242739,"name":"tformrecover.tabsheetbadnotes.caption","sourcebytes":[66,97,100,32,78,111,116,101,115],"value":"Bad Notes"}, {"hash":264440540,"name":"tformrecover.label5.caption","sourcebytes":[76,111,111,107,105,110,103,32,102,111,114,32,110,111,116,101,115,32,119,105,116,104,32,100,97,109,97,103,101,100,32,88,77,76],"value":"Looking for notes with damaged XML"}, {"hash":184061587,"name":"tformrecover.buttondeletebadnotes.caption","sourcebytes":[68,101,108,101,116,101,32,66,97,100,32,78,111,116,101,115],"value":"Delete Bad Notes"}, {"hash":17347139,"name":"tformrecover.labelnoteerrors.caption","sourcebytes":[76,97,98,101,108,78,111,116,101,69,114,114,111,114,115],"value":"LabelNoteErrors"}, {"hash":101302085,"name":"tformrecover.labelexistingadvice.caption","sourcebytes":[76,97,98,101,108,69,120,105,115,116,105,110,103,65,100,118,105,99,101],"value":"LabelExistingAdvice"}, {"hash":10220770,"name":"tformrecover.labelexistingadvice2.caption","sourcebytes":[76,97,98,101,108,69,120,105,115,116,105,110,103,65,100,118,105,99,101,50],"value":"LabelExistingAdvice2"}, {"hash":219088467,"name":"tformrecover.tabsheetrecovernotes.caption","sourcebytes":[82,101,99,111,118,101,114,32,78,111,116,101,115],"value":"Recover Notes"}, {"hash":8653518,"name":"tformrecover.label9.caption","sourcebytes":[70,114,111,109,32,104,101,114,101,32,121,111,117,32,99,97,110,32,118,105,101,119,32,115,110,97,112,115,104,111,116,32,110,111,116,101,115,44,32,111,110,101,32,98,121,32,111,110,101,46],"value":"From here you can view snapshot notes, one by one."}, {"hash":262948446,"name":"tformrecover.label14.caption","sourcebytes":[67,108,105,99,107,32,97,110,32,97,118,97,105,108,97,98,108,101,32,115,110,97,112,115,104,111,116,32,116,111,32,115,101,101,32,105,116,115,32,99,111,110,116,101,110,116,115,46],"value":"Click an available snapshot to see its contents."}, {"hash":89899246,"name":"tformrecover.label16.caption","sourcebytes":[89,111,117,32,109,97,121,32,99,104,111,115,101,32,116,111,32,118,105,101,119,44,32,99,111,112,121,32,97,110,100,32,112,97,115,116,101,32,105,110,116,111,32,97,32,110,101,119,32,110,111,116,101,46],"value":"You may chose to view, copy and paste into a new note."}, {"hash":134934484,"name":"tformrecover.tabsheetmergesnapshot.caption","sourcebytes":[77,101,114,103,101,32,83,110,97,112,115,104,111,116],"value":"Merge Snapshot"}, {"hash":248739630,"name":"tformrecover.label3.caption","sourcebytes":[82,101,115,116,111,114,101,32,97,110,121,32,110,111,116,101,115,32,105,110,32,116,104,101,32,115,110,97,112,115,104,111,116,32,116,104,97,116,32,97,114,101,32,110,111,116,32,105,110,32,116,104,101,32,101,120,105,115,116,105,110,103,32,110,111,116,101,115,32,100,105,114,101,99,116,111,114,121,46],"value":"Restore any notes in the snapshot that are not in the existing notes directory."}, {"hash":38687012,"name":"tformrecover.tabsheetrecoversnapshot.caption","sourcebytes":[82,101,99,111,118,101,114,32,83,110,97,112,115,104,111,116],"value":"Recover Snapshot"}, {"hash":238976622,"name":"tformrecover.label4.caption","sourcebytes":[82,101,109,111,118,101,32,97,108,108,32,101,120,105,115,116,105,110,103,32,110,111,116,101,115,32,97,110,100,32,117,115,101,32,116,104,101,32,111,110,101,115,32,105,110,32,116,104,101,32,83,110,97,112,115,104,111,116,46],"value":"Remove all existing notes and use the ones in the Snapshot."}, {"hash":146435218,"name":"tformrecover.buttonrecoversnap.caption","sourcebytes":[82,101,99,111,118,101,114],"value":"Recover"}, {"hash":35664446,"name":"tformrecover.label12.caption","sourcebytes":[68,111,110,39,116,32,101,118,101,110,32,99,111,110,115,105,100,101,114,32,116,104,105,115,32,117,110,108,101,115,115,32,121,111,117,32,104,97,118,101,32,97,32,98,97,99,107,117,112,32,83,110,97,112,115,104,111,116,44,32,73,110,116,114,111,32,84,97,98,46],"value":"Don't even consider this unless you have a backup Snapshot, Intro Tab."}, {"hash":190528946,"name":"tformrecover.label15.caption","sourcebytes":[67,108,105,99,107,32,97,110,32,97,118,97,105,108,97,98,108,101,32,115,110,97,112,115,104,111,116,44,32,99,108,105,99,107,32,82,101,99,111,118,101,114],"value":"Click an available snapshot, click Recover"}, {"hash":215257073,"name":"tformrecover.label2.caption","sourcebytes":[80,108,101,97,115,101,32,98,101,32,99,97,114,101,102,117,108,44,32,116,104,105,115,32,105,115,32,97,32,100,97,110,103,101,114,111,117,115,32,112,108,97,99,101,33],"value":"Please be careful, this is a dangerous place!"}, {"hash":160877251,"name":"tformrecover.panelsnapshots.caption","sourcebytes":[65,118,97,105,108,97,98,108,101,32,83,110,97,112,115,104,111,116,115],"value":"Available Snapshots"} ]} tomboy-ng_0.34-1/source/jsontools.pas0000644000175000017500000010376314145033507017466 0ustar dbannondbannon(********************************************************) (* *) (* Json Tools Pascal Unit *) (* A small json parser with no dependencies *) (* *) (* http://www.getlazarus.org/json *) (* Dual licence GPLv3 LGPLv3 released August 2019 *) (* *) (********************************************************) unit JsonTools; {$mode delphi} interface uses Classes, SysUtils; { EJsonException is the exception type used by TJsonNode. It is thrown during parse if the string is invalid json or if an attempt is made to access a non collection by name or index. } type EJsonException = class(Exception); { TJsonNodeKind is 1 of 6 possible values described below } TJsonNodeKind = ( { Object such as { } nkObject, { Array such as [ ] } nkArray, { The literal values true or false } nkBool, { The literal value null } nkNull, { A number value such as 123, 1.23e2, or -1.5 } nkNumber, { A string such as "hello\nworld!" } nkString); TJsonNode = class; { TJsonNodeEnumerator is used to enumerate 'for ... in' statements } TJsonNodeEnumerator = record private FNode: TJsonNode; FIndex: Integer; public procedure Init(Node: TJsonNode); function GetCurrent: TJsonNode; function MoveNext: Boolean; property Current: TJsonNode read GetCurrent; end; { TJsonNode is the class used to parse, build, and navigate a json document. You should only create and free the root node of your document. The root node will manage the lifetime of all children through methods such as Add, Delete, and Clear. When you create a TJsonNode node it will have no parent and is considered to be the root node. The root node must be either an array or an object. Attempts to convert a root to anything other than array or object will raise an exception. Note: The parser supports unicode by converting unicode characters escaped as values such as \u20AC. If your json string has an escaped unicode character it will be unescaped when converted to a pascal string. See also: JsonStringDecode to convert a JSON string to a normal string JsonStringEncode to convert a normal string to a JSON string } TJsonNode = class private FStack: Integer; FParent: TJsonNode; FName: string; FKind: TJsonNodeKind; FValue: string; FList: TList; procedure ParseObject(Node: TJsonNode; var C: PChar); procedure ParseArray(Node: TJsonNode; var C: PChar); procedure Error(const Msg: string = ''); function Format(const Indent: string): string; function FormatCompact: string; function Add(Kind: TJsonNodeKind; const Name, Value: string): TJsonNode; overload; function GetRoot: TJsonNode; procedure SetKind(Value: TJsonNodeKind); function GetName: string; procedure SetName(const Value: string); function GetValue: string; function GetCount: Integer; function GetAsJson: string; function GetAsArray: TJsonNode; function GetAsObject: TJsonNode; function GetAsNull: TJsonNode; function GetAsBoolean: Boolean; procedure SetAsBoolean(Value: Boolean); function GetAsString: string; procedure SetAsString(const Value: string); function GetAsNumber: Double; procedure SetAsNumber(Value: Double); public { A parent node owns all children. Only destroy a node if it has no parent. To destroy a child node use Delete or Clear methods instead. } destructor Destroy; override; { GetEnumerator adds 'for ... in' statement support } function GetEnumerator: TJsonNodeEnumerator; { Loading and saving methods } procedure LoadFromStream(Stream: TStream); procedure SaveToStream(Stream: TStream); procedure LoadFromFile(const FileName: string); procedure SaveToFile(const FileName: string); { Convert a json string into a value or a collection of nodes. If the current node is root then the json must be an array or object. } procedure Parse(const Json: string); { The same as Parse, but returns true if no exception is caught } function TryParse(const Json: string): Boolean; { Add a child node by node kind. If the current node is an array then the name parameter will be discarded. If the current node is not an array or object the Add methods will convert the node to an object and discard its current value. Note: If the current node is an object then adding an existing name will overwrite the matching child node instead of adding. } function Add(const Name: string; K: TJsonNodeKind = nkObject): TJsonNode; overload; function Add(const Name: string; B: Boolean): TJsonNode; overload; function Add(const Name: string; const N: Double): TJsonNode; overload; function Add(const Name: string; const S: string): TJsonNode; overload; { Convert to an array and add an item } function Add: TJsonNode; overload; { Delete a child node by index or name } procedure Delete(Index: Integer); overload; procedure Delete(const Name: string); overload; { Remove all child nodes } procedure Clear; { Get a child node by index. EJsonException is raised if node is not an array or object or if the index is out of bounds. See also: Count } function Child(Index: Integer): TJsonNode; overload; { Get a child node by name. If no node is found nil will be returned. } function Child(const Name: string): TJsonNode; overload; { Search for a node using a path string and return true if exists } function Exists(const Path: string): Boolean; { Search for a node using a path string } function Find(const Path: string): TJsonNode; overload; { Search for a node using a path string and return true if exists } function Find(const Path: string; out Node: TJsonNode): Boolean; overload; { Force a series of nodes to exist and return the end node } function Force(const Path: string): TJsonNode; { Format the node and all its children as json } function ToString: string; override; { Root node is read only. A node the root when it has no parent. } property Root: TJsonNode read GetRoot; { Parent node is read only } property Parent: TJsonNode read FParent; { Kind can also be changed using the As methods. Note: Changes to Kind cause Value to be reset to a default value. } property Kind: TJsonNodeKind read FKind write SetKind; { Name is unique within the scope } property Name: string read GetName write SetName; { Value of the node in json e.g. '[]', '"hello\nworld!"', 'true', or '1.23e2' } property Value: string read GetValue write Parse; { The number of child nodes. If node is not an object or array this property will return 0. } property Count: Integer read GetCount; { AsJson is the more efficient version of Value. Text returned from AsJson is the most compact representation of the node in json form. Note: If you are writing a services to transmit or receive json data then use AsJson. If you want friendly human readable text use Value. } property AsJson: string read GetAsJson write Parse; { Convert the node to an array } property AsArray: TJsonNode read GetAsArray; { Convert the node to an object } property AsObject: TJsonNode read GetAsObject; { Convert the node to null } property AsNull: TJsonNode read GetAsNull; { Convert the node to a bool } property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean; { Convert the node to a string } property AsString: string read GetAsString write SetAsString; { Convert the node to a number } property AsNumber: Double read GetAsNumber write SetAsNumber; end; { JsonValidate tests if a string contains a valid json format } function JsonValidate(const Json: string): Boolean; { JsonNumberValidate tests if a string contains a valid json formatted number } function JsonNumberValidate(const N: string): Boolean; { JsonStringValidate tests if a string contains a valid json formatted string } function JsonStringValidate(const S: string): Boolean; { JsonStringEncode converts a pascal string to a json string } function JsonStringEncode(const S: string): string; { JsonStringEncode converts a json string to a pascal string } function JsonStringDecode(const S: string): string; { JsonStringEncode converts a json string to xml } function JsonToXml(const S: string): string; implementation resourcestring SNodeNotCollection = 'Node is not a container'; SRootNodeKind = 'Root node must be an array or object'; SIndexOutOfBounds = 'Index out of bounds'; SParsingError = 'Error while parsing text'; type TJsonTokenKind = (tkEnd, tkError, tkObjectOpen, tkObjectClose, tkArrayOpen, tkArrayClose, tkColon, tkComma, tkNull, tkFalse, tkTrue, tkString, tkNumber); TJsonToken = record Head: PChar; Tail: PChar; Kind: TJsonTokenKind; function Value: string; end; const Hex = ['0'..'9', 'A'..'F', 'a'..'f']; function TJsonToken.Value: string; begin case Kind of tkEnd: Result := #0; tkError: Result := #0; tkObjectOpen: Result := '{'; tkObjectClose: Result := '}'; tkArrayOpen: Result := '['; tkArrayClose: Result := ']'; tkColon: Result := ':'; tkComma: Result := ','; tkNull: Result := 'null'; tkFalse: Result := 'false'; tkTrue: Result := 'true'; else SetString(Result, Head, Tail - Head); end; end; function NextToken(var C: PChar; out T: TJsonToken): Boolean; begin if C^ > #0 then if C^ <= ' ' then repeat Inc(C); if C^ = #0 then Break; until C^ > ' '; T.Head := C; T.Tail := C; T.Kind := tkEnd; if C^ = #0 then Exit(False); if C^ = '{' then begin Inc(C); T.Tail := C; T.Kind := tkObjectOpen; Exit(True); end; if C^ = '}' then begin Inc(C); T.Tail := C; T.Kind := tkObjectClose; Exit(True); end; if C^ = '[' then begin Inc(C); T.Tail := C; T.Kind := tkArrayOpen; Exit(True); end; if C^ = ']' then begin Inc(C); T.Tail := C; T.Kind := tkArrayClose; Exit(True); end; if C^ = ':' then begin Inc(C); T.Tail := C; T.Kind := tkColon; Exit(True); end; if C^ = ',' then begin Inc(C); T.Tail := C; T.Kind := tkComma; Exit(True); end; if (C[0] = 'n') and (C[1] = 'u') and (C[2] = 'l') and (C[3] = 'l') then begin Inc(C, 4); T.Tail := C; T.Kind := tkNull; Exit(True); end; if (C[0] = 'f') and (C[1] = 'a') and (C[2] = 'l') and (C[3] = 's') and (C[4] = 'e') then begin Inc(C, 5); T.Tail := C; T.Kind := tkFalse; Exit(True); end; if (C[0] = 't') and (C[1] = 'r') and (C[2] = 'u') and (C[3] = 'e') then begin Inc(C, 4); T.Tail := C; T.Kind := tkTrue; Exit(True); end; if C^ = '"' then begin repeat Inc(C); if C^ = '\' then begin Inc(C); if C^ < ' ' then begin T.Tail := C; T.Kind := tkError; Exit(False); end; if C^ = 'u' then if not ((C[1] in Hex) and (C[2] in Hex) and (C[3] in Hex) and (C[4] in Hex)) then begin T.Tail := C; T.Kind := tkError; Exit(False); end; end else if C^ = '"' then begin Inc(C); T.Tail := C; T.Kind := tkString; Exit(True); end; until C^ in [#0, #10, #13]; T.Tail := C; T.Kind := tkError; Exit(False); end; if C^ in ['-', '0'..'9'] then begin if C^ = '-' then Inc(C); if C^ in ['0'..'9'] then begin while C^ in ['0'..'9'] do Inc(C); if C^ = '.' then begin Inc(C); if C^ in ['0'..'9'] then begin while C^ in ['0'..'9'] do Inc(C); end else begin T.Tail := C; T.Kind := tkError; Exit(False); end; end; if C^ in ['E', 'e'] then begin Inc(C); if C^ = '+' then Inc(C) else if C^ = '-' then Inc(C); if C^ in ['0'..'9'] then begin while C^ in ['0'..'9'] do Inc(C); end else begin T.Tail := C; T.Kind := tkError; Exit(False); end; end; T.Tail := C; T.Kind := tkNumber; Exit(True); end; end; T.Kind := tkError; Result := False; end; { TJsonNodeEnumerator } procedure TJsonNodeEnumerator.Init(Node: TJsonNode); begin FNode := Node; FIndex := -1; end; function TJsonNodeEnumerator.GetCurrent: TJsonNode; begin if FNode.FList = nil then Result := nil else if FIndex < 0 then Result := nil else if FIndex < FNode.FList.Count then Result := TJsonNode(FNode.FList[FIndex]) else Result := nil; end; function TJsonNodeEnumerator.MoveNext: Boolean; begin Inc(FIndex); if FNode.FList = nil then Result := False else Result := FIndex < FNode.FList.Count; end; { TJsonNode } destructor TJsonNode.Destroy; begin Clear; inherited Destroy; end; function TJsonNode.GetEnumerator: TJsonNodeEnumerator; begin Result.Init(Self); end; procedure TJsonNode.LoadFromStream(Stream: TStream); var S: string; I: Int64; begin I := Stream.Size - Stream.Position; S := ''; SetLength(S, I); Stream.Read(PChar(S)^, I); Parse(S); end; procedure TJsonNode.SaveToStream(Stream: TStream); var S: string; I: Int64; begin S := Value; I := Length(S); Stream.Write(PChar(S)^, I); end; procedure TJsonNode.LoadFromFile(const FileName: string); var F: TFileStream; begin F := TFileStream.Create(FileName, fmOpenRead); try LoadFromStream(F); finally F.Free; end; end; procedure TJsonNode.SaveToFile(const FileName: string); var F: TFileStream; begin F := TFileStream.Create(FileName, fmCreate); try SaveToStream(F); finally F.Free; end; end; const MaxStack = 1000; procedure TJsonNode.ParseObject(Node: TJsonNode; var C: PChar); var T: TJsonToken; N: string; begin Inc(FStack); if FStack > MaxStack then Error; while NextToken(C, T) do begin case T.Kind of tkString: N := JsonStringDecode(T.Value); tkObjectClose: begin Dec(FStack); Exit; end else Error; end; NextToken(C, T); if T.Kind <> tkColon then Error; NextToken(C, T); case T.Kind of tkObjectOpen: ParseObject(Node.Add(nkObject, N, ''), C); tkArrayOpen: ParseArray(Node.Add(nkArray, N, ''), C); tkNull: Node.Add(nkNull, N, 'null'); tkFalse: Node.Add(nkBool, N, 'false'); tkTrue: Node.Add(nkBool, N, 'true'); tkString: Node.Add(nkString, N, T.Value); tkNumber: Node.Add(nkNumber, N, T.Value); else Error; end; NextToken(C, T); if T.Kind = tkComma then Continue; if T.Kind = tkObjectClose then begin Dec(FStack); Exit; end; Error; end; Error; end; procedure TJsonNode.ParseArray(Node: TJsonNode; var C: PChar); var T: TJsonToken; begin Inc(FStack); if FStack > MaxStack then Error; while NextToken(C, T) do begin case T.Kind of tkObjectOpen: ParseObject(Node.Add(nkObject, '', ''), C); tkArrayOpen: ParseArray(Node.Add(nkArray, '', ''), C); tkNull: Node.Add(nkNull, '', 'null'); tkFalse: Node.Add(nkBool, '', 'false'); tkTrue: Node.Add(nkBool, '', 'true'); tkString: Node.Add(nkString, '', T.Value); tkNumber: Node.Add(nkNumber, '', T.Value); tkArrayClose: begin Dec(FStack); Exit; end else Error; end; NextToken(C, T); if T.Kind = tkComma then Continue; if T.Kind = tkArrayClose then begin Dec(FStack); Exit; end; Error; end; Error; end; procedure TJsonNode.Parse(const Json: string); var C: PChar; T: TJsonToken; begin Clear; C := PChar(Json); if FParent = nil then begin if NextToken(C, T) and (T.Kind in [tkObjectOpen, tkArrayOpen]) then begin try if T.Kind = tkObjectOpen then begin FKind := nkObject; ParseObject(Self, C); end else begin FKind := nkArray; ParseArray(Self, C); end; NextToken(C, T); if T.Kind <> tkEnd then Error; except Clear; raise; end; end else Error(SRootNodeKind); end else begin NextToken(C, T); case T.Kind of tkObjectOpen: begin FKind := nkObject; ParseObject(Self, C); end; tkArrayOpen: begin FKind := nkArray; ParseArray(Self, C); end; tkNull: begin FKind := nkNull; FValue := 'null'; end; tkFalse: begin FKind := nkBool; FValue := 'false'; end; tkTrue: begin FKind := nkBool; FValue := 'true'; end; tkString: begin FKind := nkString; FValue := T.Value; end; tkNumber: begin FKind := nkNumber; FValue := T.Value; end; else Error; end; NextToken(C, T); if T.Kind <> tkEnd then begin Clear; Error; end; end; end; function TJsonNode.TryParse(const Json: string): Boolean; begin try Parse(Json); Result := True; except Result := False; end; end; procedure TJsonNode.Error(const Msg: string = ''); begin FStack := 0; if Msg = '' then raise EJsonException.Create(SParsingError) else raise EJsonException.Create(Msg); end; function TJsonNode.GetRoot: TJsonNode; begin Result := Self; while Result.FParent <> nil do Result := Result.FParent; end; procedure TJsonNode.SetKind(Value: TJsonNodeKind); begin if Value = FKind then Exit; case Value of nkObject: AsObject; nkArray: AsArray; nkBool: AsBoolean; nkNull: AsNull; nkNumber: AsNumber; nkString: AsString; end; end; function TJsonNode.GetName: string; begin if FParent = nil then Exit('0'); if FParent.FKind = nkArray then Result := IntToStr(FParent.FList.IndexOf(Self)) else Result := FName; end; procedure TJsonNode.SetName(const Value: string); var N: TJsonNode; begin if FParent = nil then Exit; if FParent.FKind = nkArray then Exit; N := FParent.Child(Value); if N = Self then Exit; FParent.FList.Remove(N); FName := Value; end; function TJsonNode.GetValue: string; begin if FKind in [nkObject, nkArray] then Result := Format('') else Result := FValue; end; function TJsonNode.GetAsJson: string; begin if FKind in [nkObject, nkArray] then Result := FormatCompact else Result := FValue; end; function TJsonNode.GetAsArray: TJsonNode; begin if FKind <> nkArray then begin Clear; FKind := nkArray; FValue := ''; end; Result := Self; end; function TJsonNode.GetAsObject: TJsonNode; begin if FKind <> nkObject then begin Clear; FKind := nkObject; FValue := ''; end; Result := Self; end; function TJsonNode.GetAsNull: TJsonNode; begin if FParent = nil then Error(SRootNodeKind); if FKind <> nkNull then begin Clear; FKind := nkNull; FValue := 'null'; end; Result := Self; end; function TJsonNode.GetAsBoolean: Boolean; begin if FParent = nil then Error(SRootNodeKind); if FKind <> nkBool then begin Clear; FKind := nkBool; FValue := 'false'; Exit(False); end; Result := FValue = 'true'; end; procedure TJsonNode.SetAsBoolean(Value: Boolean); begin if FParent = nil then Error(SRootNodeKind); if FKind <> nkBool then begin Clear; FKind := nkBool; end; if Value then FValue := 'true' else FValue := 'false'; end; function TJsonNode.GetAsString: string; begin if FParent = nil then Error(SRootNodeKind); if FKind <> nkString then begin Clear; FKind := nkString; FValue := '""'; Exit(''); end; Result := JsonStringDecode(FValue); end; procedure TJsonNode.SetAsString(const Value: string); begin if FParent = nil then Error(SRootNodeKind); if FKind <> nkString then begin Clear; FKind := nkString; end; FValue := JsonStringEncode(Value); end; function TJsonNode.GetAsNumber: Double; begin if FParent = nil then Error(SRootNodeKind); if FKind <> nkNumber then begin Clear; FKind := nkNumber; FValue := '0'; Exit(0); end; Result := StrToFloatDef(FValue, 0); end; procedure TJsonNode.SetAsNumber(Value: Double); begin if FParent = nil then Error(SRootNodeKind); if FKind <> nkNumber then begin Clear; FKind := nkNumber; end; FValue := FloatToStr(Value); end; function TJsonNode.Add: TJsonNode; begin Result := AsArray.Add(''); end; function TJsonNode.Add(Kind: TJsonNodeKind; const Name, Value: string): TJsonNode; var S: string; begin if not (FKind in [nkArray, nkObject]) then if Name = '' then AsArray else AsObject; if FKind in [nkArray, nkObject] then begin if FList = nil then FList := TList.Create; if FKind = nkArray then S := IntToStr(FList.Count) else S := Name; Result := Child(S); if Result = nil then begin Result := TJsonNode.Create; Result.FName := S; FList.Add(Result); end; if Kind = nkNull then Result.FValue := 'null' else if Kind in [nkBool, nkString, nkNumber] then Result.FValue := Value else begin Result.FValue := ''; Result.Clear; end; Result.FParent := Self; Result.FKind := Kind; end else Error(SNodeNotCollection); end; function TJsonNode.Add(const Name: string; K: TJsonNodeKind = nkObject): TJsonNode; overload; begin case K of nkObject, nkArray: Result := Add(K, Name, ''); nkNull: Result := Add(K, Name, 'null'); nkBool: Result := Add(K, Name, 'false'); nkNumber: Result := Add(K, Name, '0'); nkString: Result := Add(K, Name, '""'); end; end; function TJsonNode.Add(const Name: string; B: Boolean): TJsonNode; overload; const Bools: array[Boolean] of string = ('false', 'true'); begin Result := Add(nkBool, Name, Bools[B]); end; function TJsonNode.Add(const Name: string; const N: Double): TJsonNode; overload; begin Result := Add(nkNumber, Name, FloatToStr(N)); end; function TJsonNode.Add(const Name: string; const S: string): TJsonNode; overload; begin Result := Add(nkString, Name, JsonStringEncode(S)); end; procedure TJsonNode.Delete(Index: Integer); var N: TJsonNode; begin N := Child(Index); if N <> nil then begin FList.Delete(Index); if FList.Count = 0 then begin FList.Free; FList := nil; end; end; end; procedure TJsonNode.Delete(const Name: string); var N: TJsonNode; begin N := Child(Name); if N <> nil then begin FList.Remove(N); if FList.Count = 0 then begin FList.Free; FList := nil; end; end; end; procedure TJsonNode.Clear; var I: Integer; begin if FList <> nil then begin for I := 0 to FList.Count - 1 do TObject(FList[I]).Free; FList.Free; FList := nil; end; end; function TJsonNode.Child(Index: Integer): TJsonNode; begin if FKind in [nkArray, nkObject] then begin if FList = nil then Error(SIndexOutOfBounds); if (Index < 0) or (Index > FList.Count - 1) then Error(SIndexOutOfBounds); Result := TJsonNode(FList[Index]); end else Error(SNodeNotCollection); end; function TJsonNode.Child(const Name: string): TJsonNode; var N: TJsonNode; I: Integer; begin Result := nil; if (FList <> nil) and (FKind in [nkArray, nkObject]) then if FKind = nkArray then begin I := StrToIntDef(Name, -1); if (I > -1) and (I < FList.Count) then Exit(TJsonNode(FList[I])); end else for I := 0 to FList.Count - 1 do begin N := TJsonNode(FList[I]); if N.FName = Name then Exit(N); end; end; function TJsonNode.Exists(const Path: string): Boolean; begin Result := Find(Path) <> nil; end; function TJsonNode.Find(const Path: string): TJsonNode; var N: TJsonNode; A, B: PChar; S: string; begin Result := nil; if Path = '' then Exit(Child('')); if Path[1] = '/' then begin N := Self; while N.Parent <> nil do N := N.Parent; end else N := Self; A := PChar(Path); if A^ = '/' then begin Inc(A); if A^ = #0 then Exit(N); end; if A^ = #0 then Exit(N.Child('')); B := A; while B^ > #0 do begin if B^ = '/' then begin SetString(S, A, B - A); N := N.Child(S); if N = nil then Exit(nil); A := B + 1; B := A; end else begin Inc(B); if B^ = #0 then begin SetString(S, A, B - A); N := N.Child(S); end; end; end; Result := N; end; function TJsonNode.Find(const Path: string; out Node: TJsonNode): Boolean; begin Node := Find(Path); Result := Node <> nil; end; function TJsonNode.Force(const Path: string): TJsonNode; var N: TJsonNode; A, B: PChar; S: string; begin Result := nil; // AsObject; if Path = '' then begin N := Child(''); if N = nil then N := Add(''); Exit(N); end; if Path[1] = '/' then begin N := Self; while N.Parent <> nil do N := N.Parent; end else N := Self; A := PChar(Path); if A^ = '/' then begin Inc(A); if A^ = #0 then Exit(N); end; if A^ = #0 then begin N := Child(''); if N = nil then N := Add(''); Exit(N); end; B := A; while B^ > #0 do begin if B^ = '/' then begin SetString(S, A, B - A); if N.Child(S) = nil then N := N.Add(S) else N := N.Child(S); A := B + 1; B := A; end else begin Inc(B); if B^ = #0 then begin SetString(S, A, B - A); if N.Child(S) = nil then N := N.Add(S) else N := N.Child(S); end; end; end; Result := N; end; function TJsonNode.Format(const Indent: string): string; function EnumNodes: string; var I, J: Integer; S: string; begin if (FList = nil) or (FList.Count = 0) then Exit(' '); Result := #10; J := FList.Count - 1; S := Indent + #9; for I := 0 to J do begin Result := Result + TJsonNode(FList[I]).Format(S); if I < J then Result := Result + ','#10 else Result := Result + #10 + Indent; end; end; var Prefix: string; begin Result := ''; if (FParent <> nil) and (FParent.FKind = nkObject) then Prefix := JsonStringEncode(FName) + ': ' else Prefix := ''; case FKind of nkObject: Result := Indent + Prefix +'{' + EnumNodes + '}'; nkArray: Result := Indent + Prefix + '[' + EnumNodes + ']'; else Result := Indent + Prefix + FValue; end; end; function TJsonNode.FormatCompact: string; function EnumNodes: string; var I, J: Integer; begin Result := ''; if (FList = nil) or (FList.Count = 0) then Exit; J := FList.Count - 1; for I := 0 to J do begin Result := Result + TJsonNode(FList[I]).FormatCompact; if I < J then Result := Result + ','; end; end; var Prefix: string; begin Result := ''; if (FParent <> nil) and (FParent.FKind = nkObject) then Prefix := JsonStringEncode(FName) + ':' else Prefix := ''; case FKind of nkObject: Result := Prefix + '{' + EnumNodes + '}'; nkArray: Result := Prefix + '[' + EnumNodes + ']'; else Result := Prefix + FValue; end; end; function TJsonNode.ToString: string; begin Result := Format(''); end; function TJsonNode.GetCount: Integer; begin if FList <> nil then Result := FList.Count else Result := 0; end; { Json helper routines } function JsonValidate(const Json: string): Boolean; var N: TJsonNode; begin N := TJsonNode.Create; try Result := N.TryParse(Json); finally N.Free; end; end; function JsonNumberValidate(const N: string): Boolean; var C: PChar; T: TJsonToken; begin C := PChar(N); Result := NextToken(C, T) and (T.Kind = tkNumber) and (T.Value = N); end; function JsonStringValidate(const S: string): Boolean; var C: PChar; T: TJsonToken; begin C := PChar(S); Result := NextToken(C, T) and (T.Kind = tkString) and (T.Value = S); end; { Convert a pascal string to a json string } function JsonStringEncode(const S: string): string; function Len(C: PChar): Integer; var I: Integer; begin I := 0; while C^ > #0 do begin if C^ < ' ' then if C^ in [#8..#13] then Inc(I, 2) else Inc(I, 6) else if C^ in ['"', '\'] then Inc(I, 2) else Inc(I); Inc(C); end; Result := I + 2; end; const EscapeChars: PChar = '01234567btnvfr'; HexChars: PChar = '0123456789ABCDEF'; var C: PChar; R: string; I: Integer; begin if S = '' then Exit('""'); C := PChar(S); R := ''; SetLength(R, Len(C)); R[1] := '"'; I := 2; while C^ > #0 do begin if C^ < ' ' then begin R[I] := '\'; Inc(I); if C^ in [#8..#13] then R[I] := EscapeChars[Ord(C^)] else begin R[I] := 'u'; R[I + 1] := '0'; R[I + 2] := '0'; R[I + 3] := HexChars[Ord(C^) div $10]; R[I + 4] := HexChars[Ord(C^) mod $10]; Inc(I, 4); end; end else if C^ in ['"', '\'] then begin R[I] := '\'; Inc(I); R[I] := C^; end else R[I] := C^; Inc(I); Inc(C); end; R[Length(R)] := '"'; Result := R; end; { Convert a json string to a pascal string } function UnicodeToString(C: LongWord): string; inline; begin if C = 0 then Result := #0 else if C < $80 then Result := Chr(C) else if C < $800 then Result := Chr((C shr $6) + $C0) + Chr((C and $3F) + $80) else if C < $10000 then Result := Chr((C shr $C) + $E0) + Chr(((C shr $6) and $3F) + $80) + Chr((C and $3F) + $80) else if C < $200000 then Result := Chr((C shr $12) + $F0) + Chr(((C shr $C) and $3F) + $80) + Chr(((C shr $6) and $3F) + $80) + Chr((C and $3F) + $80) else Result := ''; end; function UnicodeToSize(C: LongWord): Integer; inline; begin if C = 0 then Result := 1 else if C < $80 then Result := 1 else if C < $800 then Result := 2 else if C < $10000 then Result := 3 else if C < $200000 then Result := 4 else Result := 0; end; function HexToByte(C: Char): Byte; inline; const Zero = Ord('0'); UpA = Ord('A'); LoA = Ord('a'); begin if C < 'A' then Result := Ord(C) - Zero else if C < 'a' then Result := Ord(C) - UpA + 10 else Result := Ord(C) - LoA + 10; end; function HexToInt(A, B, C, D: Char): Integer; inline; begin Result := HexToByte(A) shl 12 or HexToByte(B) shl 8 or HexToByte(C) shl 4 or HexToByte(D); end; function JsonStringDecode(const S: string): string; function Len(C: PChar): Integer; var I, J: Integer; begin if C^ <> '"' then Exit(0); Inc(C); I := 0; while C^ <> '"' do begin if C^ = #0 then Exit(0); if C^ = '\' then begin Inc(C); if C^ = 'u' then begin if (C[1] in Hex) and (C[2] in Hex) and (C[3] in Hex) and (C[4] in Hex) then begin J := UnicodeToSize(HexToInt(C[1], C[2], C[3], C[4])); if J = 0 then Exit(0); Inc(I, J - 1); Inc(C, 4); end else Exit(0); end else if C^ = #0 then Exit(0) end; Inc(C); Inc(I); end; Result := I; end; const Escape = ['b', 't', 'n', 'v', 'f', 'r']; var C: PChar; R: string; I, J: Integer; H: string; begin C := PChar(S); I := Len(C); if I < 1 then Exit(''); R := ''; SetLength(R, I); I := 1; Inc(C); while C^ <> '"' do begin if C^ = '\' then begin Inc(C); if C^ in Escape then case C^ of 'b': R[I] := #8; 't': R[I] := #9; 'n': R[I] := #10; 'v': R[I] := #11; 'f': R[I] := #12; 'r': R[I] := #13; end else if C^ = 'u' then begin H := UnicodeToString(HexToInt(C[1], C[2], C[3], C[4])); for J := 1 to Length(H) - 1 do begin R[I] := H[J]; Inc(I); end; R[I] := H[Length(H)]; Inc(C, 4); end else R[I] := C^; end else R[I] := C^; Inc(C); Inc(I); end; Result := R; end; function JsonToXml(const S: string): string; const Kinds: array[TJsonNodeKind] of string = (' kind="object"', ' kind="array"', ' kind="bool"', ' kind="null"', ' kind="number"', ''); Space = ' '; function Escape(N: TJsonNode): string; begin Result := N.Value; if N.Kind = nkString then begin Result := JsonStringDecode(Result); Result := StringReplace(Result, '<', '<', [rfReplaceAll]); Result := StringReplace(Result, '>', '>', [rfReplaceAll]); end; end; function EnumNodes(P: TJsonNode; const Indent: string): string; var N: TJsonNode; S: string; begin Result := ''; if P.Kind = nkArray then S := 'item' else S := ''; for N in P do begin Result := Result + Indent + '<' + S + N.Name + Kinds[N.Kind]; case N.Kind of nkObject, nkArray: if N.Count > 0 then Result := Result + '>'#10 + EnumNodes(N, Indent + Space) + Indent + ''#10 else Result := Result + '/>'#10; nkNull: Result := Result + '/>'#10; else Result := Result + '>' + Escape(N) + ''#10; end; end; end; var N: TJsonNode; begin Result := ''; N := TJsonNode.Create; try if N.TryParse(S) then begin Result := ''#10 + ' 0 then Result := Result + '>'#10 + EnumNodes(N, Space) + '' else Result := Result + '/>'; end; finally N.Free; end; end; end. tomboy-ng_0.34-1/source/notebook.lrj0000644000175000017500000000520314145033507017246 0ustar dbannondbannon{"version":1,"strings":[ {"hash":18269707,"name":"tnotebookpick.caption","sourcebytes":[78,111,116,101,66,111,111,107,80,105,99,107],"value":"NoteBookPick"}, {"hash":86477809,"name":"tnotebookpick.label1.caption","sourcebytes":[76,97,98,101,108,49],"value":"Label1"}, {"hash":86477811,"name":"tnotebookpick.label3.caption","sourcebytes":[76,97,98,101,108,51],"value":"Label3"}, {"hash":1339,"name":"tnotebookpick.buttonok.caption","sourcebytes":[79,75],"value":"OK"}, {"hash":77089212,"name":"tnotebookpick.button1.caption","sourcebytes":[67,97,110,99,101,108],"value":"Cancel"}, {"hash":86477810,"name":"tnotebookpick.label2.caption","sourcebytes":[76,97,98,101,108,50],"value":"Label2"}, {"hash":254720579,"name":"tnotebookpick.tabexisting.caption","sourcebytes":[69,120,105,115,116,105,110,103,32,78,111,116,101,32,66,111,111,107,115],"value":"Existing Note Books"}, {"hash":247325035,"name":"tnotebookpick.tabnewnotebook.caption","sourcebytes":[78,101,119,32,78,111,116,101,32,66,111,111,107],"value":"New Note Book"}, {"hash":52993035,"name":"tnotebookpick.label4.caption","sourcebytes":[78,97,109,101,32,111,102,32,116,104,101,32,78,101,119,32,78,111,116,101,98,111,111,107],"value":"Name of the New Notebook"}, {"hash":259178878,"name":"tnotebookpick.label5.caption","sourcebytes":[80,114,101,115,115,32,79,75,32,97,110,100,32,119,101,32,119,105,108,108,32,109,97,107,101,32,116,104,101,32,78,111,116,101,32,66,111,111,107,32,65,78,68,32,97,100,100,32,116,104,105,115,32,110,111,116,101,32,116,111,32,105,116,46],"value":"Press OK and we will make the Note Book AND add this note to it."}, {"hash":238759157,"name":"tnotebookpick.tabchangename.caption","sourcebytes":[67,104,97,110,103,101,32,78,111,116,101,98,111,111,107,32,78,97,109,101],"value":"Change Notebook Name"}, {"hash":140898037,"name":"tnotebookpick.label6.caption","sourcebytes":[69,120,105,115,116,105,110,103,32,78,97,109,101],"value":"Existing Name"}, {"hash":86477815,"name":"tnotebookpick.label7.caption","sourcebytes":[76,97,98,101,108,55],"value":"Label7"}, {"hash":211108725,"name":"tnotebookpick.label8.caption","sourcebytes":[78,101,119,32,78,97,109,101],"value":"New Name"}, {"hash":120289105,"name":"tnotebookpick.label9.caption","sourcebytes":[73,102,32,121,111,117,32,115,121,110,99,32,97,110,100,32,97,114,101,32,110,111,116,32,97,98,115,111,108,117,116,101,108,121,32,115,117,114,101,32,105,116,115,32,117,112,32,116,111,32,100,97,116,101,44,32,67,97,110,99,101,108,32,110,111,119,32,33],"value":"If you sync and are not absolutely sure its up to date, Cancel now !"}, {"hash":106246915,"name":"tnotebookpick.tabsetnotes.caption","sourcebytes":[83,101,116,32,78,111,116,101,115],"value":"Set Notes"} ]} tomboy-ng_0.34-1/source/note_lister.pas0000644000175000017500000021054114145033507017754 0ustar dbannondbannonunit Note_Lister; { Copyright (C) 2017-2021 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ A class that knows how to read a directory full of notes. It keeps those list internally, sorted by date. Note details ( Title, LastChange) can be updated (eg when a note is saved). Templates are not added to the list. The newest notes are at the end, highest index so, when searching for things should start at the end and work backwards, lots of little changes needed to do that ... It keeps a second list if user has done a search. -------- Multithreaded Indexing ---------- 1. Only used for indexing all notes, when a single note is indexed, main thread. 2. The IndexNotes() method will call ThreadIndex.Start (and therfore TIndexThread.Execute) four times, passing a set of the first chars [0..9, a..f, A..F] of file names to index. TIndexThread.Execute will call GetNoteDetails for each note that Execute finds GetNoteDetails reads note, builds a data structure and, subject to critical section, adds it to the main data structure. 3. Datastructure is then sorted, NoteBooks cleaned up etc in the IndexNotes method. 4. Four theads on a multicore cpu gives some 2 - 3 times spead up. Little slower on single core. 5. We use RTL CriticalSection code, LCL version is similar performance. 6. Using FindFirst/Next is substantually faster than FindAllFiles. History 2017/11/23 - added functions to save and retreive the Form when a note is open. Also added a function to turn a fullfilename, a filename or an ID into a filename of the form GID.note 2017/11/29 Added FileName to "Note has no Title" error message. 2017/11/29 check to see if NoteList is still valid before passing on updates to a Note's status. If we are quiting, it may not be. 2017/11/29 Fixed a memory leak that occurred when Delete-ing a entry in the list Turns out you must dispose() that allocation before calling Delete. 2017/12/28 Commented out unnecessary DebugLn 2017/12/29 Added a debug line to ThisNoteIsOpen() to try and see if there is a problem there. Really don't think there is but ... 2018/01/25 Changes to support Notebooks 2018/02/14 Changed code that does Search All Notes stuff cos old code stopped on a tag 2018/02/15 Can now search case sensitive or not and any combination or exact match 2018/04/28 Set FixedRows to zero after Clean-ing strgrid, seems necessary in Trunk 2018/06/26 Used E.Message in exception generated by bad XML - dah .... 2018/07/04 Added a flag, XMLError, set if we found a note unable to index. Why ? 2018/08/24 Debugmode now set by calling process. 2018/11/04 Added support for updating NoteList after a sync. 2018/12/29 Small improvements in time to save a file. 2019/04/13 Tweaks to overload to read help nodes 2019/05/06 Support saving pos and open on startup in note. 2020/01/03 When searching without AnyCombo ticked, string can be sub-grouped by double inverted commas " 2020/01/29 Fix multiple notebook tags for same notebook in note file. Sort main list, added functions to populate MMenu Recent list. Tweek func that populates the main stringGrid avoiding initial sort 2020/01/31 LoadStringGrid*() now uses the Lazarus column mode. 2020/02/03 Make contents of strgrid look like it claims to be after new data Removed LoadSearchGrid, no use LoadStGrid in both modes. 2020/02/19 XML Escape the notebook list sent back. 2020/03/27 Better reporting on short lastchangedate string. But need an autofix. 2020/04/01 Bug fix for code that auto fixes short last-change-date. 2020/04/19 Missing $H+ caused 255 char default string, messed with RewriteBadChangeDate() 2020/05/10 Multithreaded search 2020/05/25 Don't read sett.checkcasesensitive in thread. 2020/08/01 Disable code to rewrite short lcd. 2021/01/03 LoadListView now uses TB_datetime, more tolerant of differing DT formats. 2021/02/14 Notebook list now sorted, A->z 2021/07/05 Changed a lot of "for X to 0" to "for 0 downto X" so searches start at end of list where current data is 2021/08/30 Removed dependencies on Sett and SearchUnit. Added Dump methods. Added function GetNotebooks(const ID: ANSIString): string; for GitHub 2021/08/31 Added TheNoteLister to hold a ref to the NoteLister for any unit that 'uses' this unit. 2021/09/06 GetNotebooks result now wrapped in square brackets, JSON style } {$mode objfpc} {$H+} INTERFACE uses Classes, SysUtils, Grids, ComCtrls, Forms, FileUtil; type PNotebook=^TNotebook; TNotebook = record Name : ANSIString; // Name of the notebook Template : ANSIString; // The FName of the Template for this Notebook, inc .note Notes : TStringList; // A list of the Fnames of notes that are members of this Notebook, inc .note. end; type { TNoteBookList } TNoteBookList = class(TList) private function Get(Index : integer) : PNoteBook; procedure RemoveNoteBook(const NBName: AnsiString); public destructor Destroy; Override; { ID of Note to be added; Name of NoteBook it should be added to. Notebook rec is created if necessary. But if IsTemplate ID is ID of a newly created Template } procedure Add(const ID, ANoteBook : ANSIString; IsTemplate : boolean); { Returns True if the passed note ID is in the passed Notebook } function IDinNotebook(const ID, Notebook : ANSIstring) : boolean; // Returns a PNoteBook that has a name matching passed NoteBook. function FindNoteBook(const NoteBook : ANSIString) : PNoteBook; { Removes any list entries that do not have a Template } procedure CleanList(); property Items[Index : integer] : PNoteBook read Get; default; end; type PNote=^TNote; TNote = record { will have 36 char GUI plus '.note' } ID : ANSIString; Title : ANSIString; { a 33 char date time string } CreateDate : ANSIString; { a 33 char date time string, updateable } LastChange : ANSIString; IsTemplate : boolean; OpenOnStart : boolean; OpenNote : TForm; end; type { ---------- TNoteInfoList ---------} //TNoteList = class(TList) // ToDo : TFPList is faster TNoteList = class(TFPList) private function Get(Index: integer): PNote; public destructor Destroy; override; function Add(ANote : PNote) : integer; function FindID(const ID : ANSIString) : PNote; property Items[Index: integer]: PNote read Get; default; end; type { TNoteLister } TNoteLister = class private //DebugMode : boolean; OpenNoteIndex : integer; // Used for Find*OpenNote(), points to last found one, -1 meaning none found { NoteList is a list of pointers. Each one points to a record that contains data about a particular note. Only Notebook info it has is whether or not its a template. The ID is stored as a 36 char GUI plus '.note'. Dates must be 33 char.} NoteList : TNoteList; SearchNoteList : TNoteList; { NoteBookList is a list of pointers. Each one points to a record containing Name, Template ID and a List (called Notes) of IDs of notes that are members of this Notebook. } NoteBookList : TNoteBookList; { Takes a created list and search term string. Returns with the list containing individual search terms, 1 to many } procedure BuildSearchList(SL: TStringList; const Term: AnsiString); { Returns a simple note file name, accepts simple filename or ID } function CleanFileName(const FileOrID: AnsiString): ANSIString; procedure DumpNoteNoteList(WhereFrom: string); //procedure GetNoteDetails(const Dir, FileName: ANSIString; {const TermList: TStringList;} DontTestName: boolean=false); // Indexes one note. Always multithread mode but sometimes its only one thread. // Does require CriticalSection to be setup before calling. // If note turns out to be a template, don't add it to main note list // but still call Notebook.add to ensure its mentioned in notebook list. procedure GetNoteDetails(const Dir, FileName: ANSIString; DontTestName: boolean; TheLister : TNoteLister); // Inserts a new item into the ViewList, always Title, DateSt, FileName function NewLVItem(const LView: TListView; const Title, DateSt, FileName: string): TListItem; { Returns True if indicated note contains term in its content } //function NoteContains(const TermList: TStringList; FileName: ANSIString ): boolean; { Removes any complete xml tags from passed string, only matches '<' to '>' } //function RemoveXml(const St: AnsiString): AnsiString; { A Early ver of -ng wrote a bad date stamp, here we try to fix any we find. First just try to add missing bits, if that does not work, we replace the LCD with current, and known good date.} procedure RewriteBadChangeDate(const Dir, FileName, LCD: ANSIString); public DebugMode : boolean; XMLError : Boolean; // Indicates a note was found with an XML (or other) error, checked by calling process. ErrorNotes : TStringList; { The directory, with trailing seperator, that the notes are in } WorkingDir : ANSIString; SearchIndex : integer; procedure DumpNoteBookList(WhereFrom: String); { Returns true if there is a notebook of the passed title } function IsANotebookTitle(NBTitle : string) : boolean; { Returns the Notebook Name for a given filename or ID (of the template itself)} function GetNotebookName(FileorID: AnsiString): string; { returns a indexed pointer to a Notebookrecord } function GetNoteBook(Index: integer): PNoteBook; { returns the number items in the notebook list } function NotebookCount(): integer; {Returns the number of records in the Notelist } function GetNoteCount() : integer; { Returns a pointer to PNote record, zero based index } function GetNote(Index: integer): PNote; { Loads a TListView with note title, LCD and ID} procedure LoadListView(const LView: TListView; const SearchMode: boolean); { Changes the name associated with a Notebook in the internal data structure } function AlterNoteBook(const OldName, NewName: string): boolean; { Returns a multiline string to use in writing a notes notebook membership, knows how to do a template too. String has special XML chars 'escaped' This function expects to be passed an ID + '.note'. } function NoteBookTags(const NoteID: string): ANSIString; { Returns true if it has returned with a pointer to a list with one or more Note Fnames that are members of NBName, it returns a pointer to the internal StList, do not create or free. FNames mean ID.note ! } function GetNotesInNoteBook(out NBIDList: TStringList; const NBName: string ): boolean; { Retuns the title of note at (zero based) index. } function GetTitle(Index: integer): string; { Returns the title for a given ID or Filename } function GetTitle(const ID: String): string; { Returns the number of items in the list } function Count(): integer; { Returns the LastChangeDate string for ID in the Notes list, empty string if not found (empty string is its a notebook) } function GetLastChangeDate(const ID: String): string; { Adds details of note of passed to NoteList } procedure IndexThisNote(const ID : String); { Returns T is ID in current list, takes 36 char GUID or simple file name } function IsIDPresent(ID : string) : boolean; { Removes the Notebook entry with ID=Template from Notebook datastructure } procedure DeleteNoteBookwithID(FileorID : AnsiString); { Returns True if passed string is the ID or short Filename of a Template } function IsATemplate(FileOrID : AnsiString) : boolean; { ID of Note to be added; Name of NoteBook it should be added to. Notebook rec is created if necessary. But if IsTemplate ID is ID of a newly created Template } procedure AddNoteBook(const ID, ANoteBook: ANSIString; IsTemplate: Boolean); { Sets the passed Notebooks as 'parents' of the passed note. Any pre existing membership will be cancelled. The list can contain zero to many notebooks. } procedure SetNotebookMembership(const ID: ansistring; const MemberList: TStringList); { If ID is empty, always returns false, puts all Notebook names in strlist. If ID is not empty, list is filtered for only notebooks that have that ID and returns True iff the passed ID is that of a Template. A Notebook Template will have only one Notebook name in its Tags and that will be added to strlist. The StartHere template won't have a Notebook Name and therefore wont get mixed up here ???? } function GetNotebooks(const NBList: TStringList; const ID: ANSIString): boolean; { Rets a (JSON array like, escaped) string of Notebook names that this note is a member of. It returns an empty array if the note has no notebooks or cannot be found. If ID is a template, will send a two element array ["template', "notebook-name"]. Expects an ID.note . Result is like this ["Notebook One", "Notebook2", "Notebook"] } function NotebookJArray(const ID: ANSIString): string; { Loads the Notebook ListBox up with the Notebook names we know about. Add a bool to indicate we should only show Notebooks that have one or more notes mentioned in SearchNoteList. Call after GetNotes(Term) } procedure LoadListNotebooks(const NotebookItems: TStrings; SearchListOnly: boolean); { Adds a note to main list, ie when user creates a new note } procedure AddNote(const FileName, Title, LastChange : ANSIString); { Read the metadata from all the notes into internal data structure, this is the main "go and do it" function. } function IndexNotes(DontTestName: boolean=false): longint; { Overload of GetNotes(), we'll just search for notes with term and store date in a different structure, then call LoadSearchGrid() } function SearchNotes(const Term: ANSIstring): longint; { Copy the internal Note data to the passed TStringGrid, empting it first. NoCols can be 2, 3 or 4 being Name, LastChange, CreateDate, ID. Special case only main List SearchMode True will get from the search list. Only used by Recover unit now. } procedure LoadStGrid(const Grid: TStringGrid; NoCols: integer; SearchMode: boolean=false); { Copy the internal Note Data to passed TStrings } procedure LoadStrings(const TheStrings : TStrings); // Returns True if its updated the internal record as indicated, // will accept either an ID or a filename. Do NOT pass a Notebook ID !} function AlterNote(ID, Change : ANSIString; Title : ANSIString = '') : boolean; function IsThisATitle(const Title : ANSIString) : boolean; { Returns the Form this note is open on, Nil if its not open. Take ID or FileName } function IsThisNoteOpen(const ID : ANSIString; out TheForm : TForm) : boolean; { Tells the list that this note is open, pass NIL to indicate its now closed } function ThisNoteIsOpen(const ID: ANSIString; const TheForm: TForm): boolean; { Returns true if it can find a FileName to Match this Title } function FileNameForTitle(const Title: ANSIString; out FileName : ANSIstring): boolean; procedure StartSearch(); function NextNoteTitle(out SearchTerm : ANSIString) : boolean; { removes note from int data, accepting either an ID or Filename } function DeleteNote(const ID : ANSIString) : boolean; { Copy the internal data about notes in passed Notebook to passed TListView for display. So, shown would be all the notes in the nominated notebook.} procedure LoadNotebookViewList(const VL: TListView; const NotebookName: AnsiString); { Copy the internal data about notes in passed Notebook to passed TStringGrid for display. So, shown would be all the notes in the nominated notebook.} procedure LoadNotebookGrid(const Grid : TStringGrid; const NotebookName : AnsiString); { Returns the ID (inc .note) of the notebook Template, if an empty string we did not find a) the Entry in NotebookList or b) the entry had a blank template. } function NotebookTemplateID(const NotebookName : ANSIString) : AnsiString; { Returns the Form of first open note and sets internal pointer to it, Nil if none found } function FindFirstOpenNote(): TForm; { Call after FindFirstOpenNote(), it will return the next one or Nil if no more found } function FindNextOpenNote() : TForm; { Returns the ID of first note that should be opened on startup internal pointer (which is same interger as FindFirstOpenNate) to it, '' if none found } function FindFirstOOSNote(out NTitle, NID: ANSIstring): boolean; { Call after FindFirstOOSNote(), it will return the next one or '' if no more found } function FindNextOOSNote(var NTitle, NID: ANSIstring): boolean; constructor Create; destructor Destroy; override; end; Type { ======================= SEARCH THREAD ========================== } TSearchThread = class(TThread) private protected procedure Execute; override; public CaseSensitive : boolean; NoteLister : TNoteLister; // Thats the note lister that called us TIndex : integer; // Zero based count of threads ThreadBlockSize : integer; // how many files each thread processes ResultsList : TNoteList; // List to contain details of what we found File_List : TStringList; // Incoming list if files Term_List : TStringList; // Incoming list of terms to search for Constructor Create(CreateSuspended : boolean); end; { ======================= INDEX THREAD ========================== } type CharSet = set of char; type TGetNoteDetailsProc = procedure(const Dir, FileName: ANSIString; DontTestName: boolean; TheLister : TNoteLister) of Object; Type TIndexThread = class(TThread) private protected procedure Execute; override; public GetNoteDetailsProc : TGetNoteDetailsProc; TIndex : integer; // Zero based count of threads StartsWith : CharSet; WorkingDir : string; OneThread : boolean; // indicates its not regular UUID based notes, do single thread index TheLister : TNoteLister; Constructor Create(CreateSuspended : boolean); end; function NoteContains(const TermList : TStringList; FullFileName: ANSIString; const CaseSensitive : boolean): boolean; var TheNoteLister : TNoteLister = nil; // This is a pointer to the notelister, its really, really global ! { ------------------------------------------------------------------- } { -------------------------- IMPLEMENTATION ------------------------- } { ------------------------------------------------------------------- } implementation uses laz2_DOM, laz2_XMLRead, LazFileUtils, LazUTF8, LazLogger, tb_utils, syncutils {$ifdef TOMBOY_NG}, SearchUnit, settings{$endif}; // project options -> Custom Options { Laz* are LCL packages, Projectinspector, double click Required Packages and add LCL } var FinishedThreads : integer; // There are here to allow the search threads to find them. ThreadLock : integer; // -1 if unlocked, has value of thread when locked CriticalSection: TRTLCriticalSection; // we use RTL CriticalSection code, the LCL version is about the same { ================ I N D E X T H R E A D ======================= } // ToDo : much of the work here is done in GetNoteDetails, maybe it belongs in this Type ? constructor TIndexThread.Create(CreateSuspended : boolean); begin inherited Create(CreateSuspended); FreeOnTerminate := True; end; procedure TIndexThread.Execute; var Ch : char; procedure FindNoteFile(Mask : string); var Info : TSearchRec; Cnt : integer = 0; begin if FindFirst(WorkingDir + Mask, faAnyFile, Info)=0 then repeat inc(cnt); GetNoteDetailsProc(WorkingDir, Info.Name, OneThread, TheLister); //SearchForm.NoteLister.GetNoteDetails(WorkingDir, Info.Name, OneThread, TheLister); until FindNext(Info) <> 0; FindClose(Info); end; begin if OneThread then FindNoteFile('*.note') else for ch in StartsWith do FindNoteFile(Ch + '*.note'); InterLockedIncrement(FinishedThreads); end; { ========================== SEARCH THREAD =========================== } constructor TSearchThread.Create(CreateSuspended : boolean); begin inherited Create(CreateSuspended); FreeOnTerminate := True; end; procedure TSearchThread.Execute; var EndBlock, I : integer; NoteP : PNote; begin EndBlock := (TIndex+1)*ThreadBlockSize; if EndBlock > File_List.Count then EndBlock := File_List.Count; if (File_List.Count - EndBlock) < ThreadBlockSize then EndBlock := File_List.Count; I := TIndex * ThreadBlockSize; {if EndBlock := FileList.Count then debugln('Last Thread Endblock=' + dbgs(EndBlock)); } while (not Terminated) and (I < EndBlock) do begin if Notecontains(Term_List, File_List.Strings[i], CaseSensitive) then begin if not Notelister.IsATemplate(ExtractFileNameOnly(File_List.Strings[i])) then begin new(NoteP); NoteP^.ID:= ExtractFileNameOnly(File_List.Strings[i]) + '.note'; NoteP^.IsTemplate := False; NoteP^.Title := Notelister.GetTitle(NoteP^.ID); NoteP^.LastChange:= Notelister.GetLastChangeDate(NoteP^.ID); NoteP^.CreateDate := ''; //debugln('ID = ' + NoteP^.ID); while InterlockedCompareExchange(ThreadLock, TIndex, -1) <> -1 do if Terminated then begin dispose(NoteP); break; end; ResultsList.Add(NoteP); //assert((InterlockedExchange(ThreadLock, -1) = TIndex), 'FAILED threadlock'); // it appears code is unstable if I use assert and don't tick include assertion code -Sa under debugging InterlockedExchange(ThreadLock, -1); end; end; inc(I); end; InterLockedIncrement(FinishedThreads); end; { ========================= N O T E B O O K L I S T ======================== } function TNoteBookList.Get(Index: integer): PNoteBook; begin Result := PNoteBook(inherited get(Index)); end; destructor TNoteBookList.Destroy; var I : Integer; begin for I := 0 to Count-1 do begin Items[I]^.Notes.free; dispose(Items[I]); end; inherited Destroy; end; procedure TNoteBookList.Add(const ID, ANoteBook: ANSIString; IsTemplate: boolean ); var NB : PNoteBook; NewRecord : boolean = False; I : integer; begin NB := FindNoteBook(ANoteBook); if NB = Nil then begin NewRecord := True; new(NB); NB^.Name:= ANoteBook; NB^.Template := ''; NB^.Notes := TStringList.Create; end; if IsTemplate then begin NB^.Template:= ID // should only happen if its a new template. end else begin // Check its not there already .... I := NB^.Notes.Count; while I > 0 do begin dec(I); if ID = NB^.Notes[i] then exit; // cannot be there if its a new entry so no leak here end; NB^.Notes.Add(ID); end; if NewRecord then inherited Add(NB); end; function TNoteBookList.IDinNotebook(const ID, Notebook: ANSIstring): boolean; var Index : longint; TheNoteBook : PNoteBook; begin Result := False; TheNoteBook := FindNoteBook(NoteBook); if TheNoteBook = Nil then exit(); for Index := 0 to TheNoteBook^.Notes.Count-1 do if ID = TheNoteBook^.Notes[Index] then begin Result := True; exit(); end; end; function TNoteBookList.FindNoteBook(const NoteBook: ANSIString): PNoteBook; var Index : longint; begin Result := Nil; for Index := 0 to Count-1 do begin if Items[Index]^.Name = NoteBook then begin Result := Items[Index]; exit() end; end; end; function TNoteLister.IsANotebookTitle(NBTitle: string): boolean; var P : PNoteBook; begin P := NoteBookList.FindNoteBook(NBTitle); result := P <> nil; end; procedure TNoteBookList.CleanList; var Index : integer = 0; begin while Index < Count do begin if Items[Index]^.Template = '' then begin Items[Index]^.Notes.free; dispose(Items[Index]); Delete(Index); end else inc(Index); end; end; // Don't think we use this method ? procedure TNoteBookList.RemoveNoteBook(const NBName: AnsiString); var Index : integer; begin for Index := 0 to Count-1 do if Items[Index]^.Name = NBName then begin Items[Index]^.Notes.free; dispose(Items[Index]); Delete(Index); break; end; debugln('ERROR, asked to remove a note book that I cannot find.'); end; // =================== DEBUG PROC ====================================== procedure TNoteLister.DumpNoteBookList(WhereFrom : String); var P : PNotebook; I : integer; begin debugln('------------ ' + WhereFrom + ' -----------'); for P in NoteBookList do begin debugln('Name=' + P^.Name); for I := 0 to P^.Notes.Count -1 do debugln(' ' + P^.Notes[I]); end; debugln('-----------------------'); end; procedure TNoteLister.DumpNoteNoteList(WhereFrom : string); var P : PNote; Pnb : PNotebook // I : integer; ;begin debugln('-----------' + WhereFrom + '------------'); for P in NoteList do begin debugln('ID=' + P^.ID + ' ' + P^.Title); debugln('CDate=' + P^.CreateDate + ' template=' + booltostr(P^.IsTemplate, true)); end; debugln('-----------------------------------------------'); for Pnb in NoteBookList do debugln('Template ID=' + Pnb^.Template + ' NB Name='+Pnb^.Name + ' and Notes are ' + Pnb^.Notes.Text); debugln('-----------------------------------------------'); end; function TNoteLister.GetNoteCount(): integer; begin result := NoteList.Count; end; { ============================== NoteLister ================================ } { ------------- Things relating to NoteBooks ------------------ } function TNoteLister.NotebookCount(): integer; begin Result := NoteBookList.Count; end; function TNoteLister.GetNoteBook(Index : integer) : PNoteBook; begin Result := NoteBookList[Index]; end; function TNoteLister.NoteBookTags(const NoteID : string): ANSIString; var SL : TStringList; Index : Integer; begin Result := ''; SL := TStringList.Create; try if GetNotebooks(SL, NoteID) then begin // its a template Result := ' '#10' system:template'#10; if SL.Count > 0 then Result := Result + ' system:notebook:' + RemoveBadXMLCharacters(SL[0], True) + ''#10' '#10; end else if SL.Count > 0 then begin // its a Notebook Member Result := ' '#10; for Index := 0 to SL.Count -1 do // here, we auto support multiple notebooks. Result := Result + ' system:notebook:' + RemoveBadXMLCharacters(SL[Index], True) + ''#10; Result := Result + ' '#10; end; finally SL.Free; end; end; function TNoteLister.NotebookJArray(const ID: ANSIString): string; var STL : TStringList; Index : Integer; begin Result := ''; STL := TStringList.Create; try if GetNotebooks(STL, ID) then // its a template Result := '"template", "' + EscapeJSON(STL[0]) + '"' else begin // maybe its a Notebook Member for Index := 0 to STL.Count -1 do // here, we auto support multiple notebooks. Result := Result + '"' + EscapeJSON(StL[Index]) + '", '; if Result <> '' then // will be empty if note is not member of a notebook delete(Result, length(Result)-1, 2); // remove trailing comma and space end; finally STL.Free; end; Result := '[' + Result + ']'; // Always return the brackets, even if empty //debugln('TNoteLister.NotebookJArray returning Notebooks jArray = ' + Result); end; (* //=========================== if IsATemplate(ID) then begin Result := '"template"'; //xxx end else for P in Notebooklist do if NotebookList.IDinNotebook(ID, P^.Name) then Result := Result + '"' + P^.Name + '",'; end; *) function TNoteLister.GetNotesInNoteBook(out NBIDList : TStringList; const NBName : string) : boolean; var NB : PNoteBook; begin Result := True; NB := NoteBookList.FindNoteBook(NBName); if NB <> Nil then NBIDList := NB^.Notes else Result := False; end; function TNoteLister.AlterNoteBook(const OldName, NewName : string) : boolean; var NB : PNoteBook; begin Result := True; NB := NoteBookList.FindNoteBook(OldName); if NB <> nil then NB^.Name:= NewName else Result := False; end; procedure TNoteLister.AddNoteBook(const ID, ANoteBook: ANSIString; IsTemplate : Boolean); begin NoteBookList.Add(ID, ANoteBook, IsTemplate); //DumpNoteBookList('After TNoteLister.AddNoteBook'); end; procedure TNoteLister.LoadNotebookViewList(const VL : TListView; const NotebookName: AnsiString); var Index : integer; LCDst : string; begin VL.Clear; Index := NoteList.Count; while Index > 0 do begin dec(Index); if NotebookList.IDinNotebook(NoteList.Items[Index]^.ID, NoteBookName) then begin LCDst := NoteList.Items[Index]^.LastChange; if length(LCDst) > 11 then // looks prettier, dates are stored in ISO std LCDst[11] := ' '; // with a 'T' between date and time NewLVItem(VL, NoteList.Items[Index]^.Title, LCDst, NoteList.Items[Index]^.ID); end; end; end; procedure TNoteLister.LoadNotebookGrid(const Grid: TStringGrid; const NotebookName: AnsiString); var Index : integer; begin while Grid.RowCount > 1 do Grid.DeleteRow(Grid.RowCount-1); Index := NoteList.Count; while Index > 0 do begin dec(Index); if NotebookList.IDinNotebook(NoteList.Items[Index]^.ID, NoteBookName) then begin Grid.InsertRowWithValues(Grid.RowCount, [NoteList.Items[Index]^.Title, NoteList.Items[Index]^.LastChange]); end; end; end; function TNoteLister.NotebookTemplateID(const NotebookName: ANSIString): AnsiString; var Index : integer; //St : string; begin for Index := 0 to NotebookList.Count - 1 do begin //St := NotebookList.Items[Index]^.Name; if NotebookName = NotebookList.Items[Index]^.Name then begin Result := NotebookList.Items[Index]^.Template; exit(); end; end; debugln('ERROR - asked for the template for a non existing Notebook'); debugln('NotebookName = ' + Notebookname); for Index := 0 to NotebookList.Count - 1 do begin if NotebookName = NotebookList.Items[Index]^.Name then debugln('Match [' + NotebookList.Items[Index]^.Name + ']') else debugln('NO - Match [' + NotebookList.Items[Index]^.Name + ']') end; Result := ''; end; function TNoteLister.GetNotebookName(FileorID: AnsiString) : string; var Index : integer; begin for Index := 0 to NotebookList.Count - 1 do if CleanFileName(FileorID) = NotebookList.Items[Index]^.Template then exit(NotebookList.Items[Index]^.Name); //debugln('TNoteLister.GetNotebookName ALERT - asked to find a notebook name but cannot find it : ' + FileorID); // thats not an error, sometimes sync systems asks, just in case ..... result := ''; end; procedure TNoteLister.DeleteNoteBookwithID(FileorID: AnsiString); var Index : integer; begin for Index := 0 to NotebookList.Count - 1 do begin if CleanFileName(FileorID) = NotebookList.Items[Index]^.Template then begin NotebookList.Items[Index]^.Notes.free; dispose(NotebookList.Items[Index]); NotebookList.Delete(Index); exit(); end; end; debugln('TNoteLister.DeleteNoteBookwithID ERROR - asked to delete a notebook by ID but cannot find it : ' + FileorID); end; function TNoteLister.IsATemplate(FileOrID: AnsiString): boolean; var SL : TStringList; begin SL := TStringList.Create; Result := GetNotebooks(SL, CleanFileName(FileOrID)); SL.Free; end; procedure TNoteLister.SetNotebookMembership(const ID : ansistring; const MemberList : TStringList); var Index, BookIndex : integer; begin // First, remove any mention of this ID from data structure for Index := 0 to NotebookList.Count - 1 do begin BookIndex := 0; while BookIndex < NotebookList.Items[Index]^.Notes.Count do begin if ID = NotebookList.Items[Index]^.Notes[BookIndex] then NotebookList.Items[Index]^.Notes.Delete(BookIndex); inc(BookIndex); end; end; // Now, put back the ones we want there. for BookIndex := 0 to MemberList.Count -1 do for Index := 0 to NotebookList.Count - 1 do if MemberList[BookIndex] = NotebookList.Items[Index]^.Name then begin NotebookList.Items[Index]^.Notes.Add(ID); break; end; end; { procedure TNoteLister.LoadListNotebooks(const NotebookGrid : TStringGrid; SearchListOnly : boolean); var Index : integer; function FindInSearchList(NB : PNoteBook) : boolean; var X : integer = 0; begin result := true; if Nil = SearchNoteList then exit; while X < NB^.Notes.Count do begin if Nil <> SearchNoteList.FindID(NB^.Notes[X]) then exit; inc(X); end; result := false; end; begin while NotebookGrid.RowCount > 1 do NotebookGrid.DeleteRow(NotebookGrid.RowCount-1); for Index := 0 to NotebookList.Count - 1 do begin if (not SearchListOnly) or FindInSearchList(NotebookList.Items[Index]) then begin NotebookGrid.InsertRowWithValues(NotebookGrid.RowCount, [NotebookList.Items[Index]^.Name]); end; end; end; } procedure TNoteLister.LoadListNotebooks(const NotebookItems : TStrings; SearchListOnly : boolean); var Index : integer; function FindInSearchList(NB : PNoteBook) : boolean; var X : integer = 0; begin result := true; if Nil = SearchNoteList then exit; while X < NB^.Notes.Count do begin if Nil <> SearchNoteList.FindID(NB^.Notes[X]) then exit; inc(X); end; result := false; end; begin NoteBookItems.Clear; for Index := 0 to NotebookList.Count - 1 do begin if (not SearchListOnly) or FindInSearchList(NotebookList.Items[Index]) then begin NotebookItems.Add(NotebookList.Items[Index]^.Name); //NotebookGrid.InsertRowWithValues(NotebookGrid.RowCount, [NotebookList.Items[Index]^.Name]); end; end; end; function TNoteLister.GetNotebooks(const NBList: TStringList; const ID: ANSIString): boolean; var Index, I : Integer; begin Result := false; for Index := 0 to NoteBookList.Count -1 do begin if ID = '' then NBList.Add(NotebookList.Items[Index]^.Name) else begin if ID = NotebookList.Items[Index]^.Template then begin // The passed ID is the ID of a Template itself, not a note. // debugln('Looks like we asking about a template ' + ID); NBList.Add(NotebookList.Items[Index]^.Name); if NBList.Count > 1 then debugln('Error, seem to have more than one Notebook Name for template ' + ID); Result := True; exit(); end; // OK, if its not a Template, its a note, what notebooks is it a member of ? // Each NotebookList item has a list of the notes that are members of that item. // if the ID is mentioned in the items note list, copy name to list. // Iterate over the Notes list associated with this particular Notebook entry. for I := 0 to NotebookList.Items[Index]^.Notes.Count -1 do if ID = NotebookList.Items[Index]^.Notes[I] then NBList.Add(NotebookList.Items[Index]^.Name); {if assigned(NBList) then debugln('ERROR, assigned SL passed to GetNotebooks') else NBList := NotebookList.Items[Index]^.Notes; } end; end; end; { -------------- Things relating to Notes -------------------- } // Address of this function is passed to note list sort. Newest notes at end of list. function LastChangeSorter( Item1: Pointer; Item2: Pointer) : Integer; begin // Also ANSICompareStr but we are just looking at date numbers here result := CompareStr(PNote(Item1)^.LastChange, PNote(Item2)^.LastChange); end; function NotebookSorter( Item1 : pointer; Item2 : pointer) : integer; begin result := CompareStr(PNoteBook(Item1)^.Name, PNoteBook(Item2)^.Name); end; procedure TNoteLister.RewriteBadChangeDate(const Dir, FileName, LCD : ANSIString); var InFile, OutFile: TextFile; InString, NewLCD : String; {$ifdef WINDOWS} ErrorMsg : ANSIString; {$endif} begin // Bad format looks like this 2020-03-06 21:25:18 // But it Should be like this 2020-02-15T12:07:41.0000000+00:00 AssignFile(InFile, Dir + FileName); AssignFile(OutFile, Dir + Filename + '-Dated'); try try Reset(InFile); Rewrite(OutFile); while not eof(InFile) do begin readln(InFile, InString); if (Pos('', InString) > 0) then if length(LCD) = 19 then begin NewLCD := LCD + copy(TB_GetLocalTime(), 20, 14); NewLCD[11] := 'T'; writeln(OutFile, ' ' + NewLCD + ''); end else begin writeln(OutFile, ' ' + TB_GetLocalTime() + ''); end else writeln(OutFile, InString); end; finally CloseFile(OutFile); CloseFile(InFile); end; except on E: EInOutError do begin debugln('File handling error occurred updating clean note location. Details: ' + E.Message); exit; end; end; {$ifdef WINDOWS} if FileExists(Dir + FileName) then // will not be there if its a new note. if not SafeWindowsDelete(Dir + FileName, ErrorMsg) then // In syncutils, maybe over kill but ...... exit; {$endif} RenameFileUTF8(Dir + Filename + '-Dated', Dir + FileName); // Unix ok to over write, windows is not ! end; procedure TNoteLister.GetNoteDetails(const Dir, FileName: ANSIString; DontTestName : boolean; TheLister : TNoteLister); // This is how we search for XML elements, attributes are different. // Note : we used to do seaching here as well as indexing, now just indexing // Note that this method is not Multithread aware, calling method must setup // CriticalSection even if it is single threaded. var NoteP : PNote; Doc : TXMLDocument; Node : TDOMNode; J : integer; //TryCount : integer =0; // only try rewriting bad last-change-date once. //LCD_OK : boolean = false; begin // debugln('Checking note ', FileName); if not DontTestName then if not IDLooksOK(copy(FileName, 1, 36)) then begin // In syncutils !!!! EnterCriticalSection(CriticalSection); try ErrorNotes.Append(FileName + ', ' + 'Invalid ID in note filename'); XMLError := True; finally LeaveCriticalSection(CriticalSection); end; exit; end; if FileExistsUTF8(Dir + FileName) then begin new(NoteP); NoteP^.IsTemplate := False; try try NoteP^.ID:=FileName; // repeat ReadXMLFile(Doc, Dir + FileName); Node := Doc.DocumentElement.FindNode('title'); NoteP^.Title := Node.FirstChild.NodeValue; // This restores & etc. //if DebugMode then Debugln('Title is [' + Node.FirstChild.NodeValue + '] ID is ' + FileName); Node := Doc.DocumentElement.FindNode('last-change-date'); NoteP^.LastChange := Node.FirstChild.NodeValue; {if (length(NoteP^.LastChange) <> 33) or (length(NoteP^.LastChange) <> 27) then begin RewriteBadChangeDate(Dir, FileName, NoteP^.LastChange); inc(TryCount); if TryCount > 2 then begin debugln('Failed to fix bad last-change-date in ' + NoteP^.Title); break; // sad but life must go on. end; Doc.free; end else break; until false; } NoteP^.OpenNote := nil; Node := Doc.DocumentElement.FindNode('create-date'); NoteP^.CreateDate := Node.FirstChild.NodeValue; try // this because GNote leaves out 'open-on-startup' ! Node := Doc.DocumentElement.FindNode('open-on-startup'); if Node = nil then NoteP^.OpenOnStart:= False else NoteP^.OpenOnStart:= (Node.FirstChild.NodeValue = 'True'); except on E: EObjectCheck do NoteP^.OpenOnStart:= False; end; Node := Doc.DocumentElement.FindNode('tags'); if Assigned(Node) then begin for J := 0 to Node.ChildNodes.Count-1 do if UTF8pos('system:template', Node.ChildNodes.Item[J].TextContent) > 0 then NoteP^.IsTemplate := True; for J := 0 to Node.ChildNodes.Count-1 do if UTF8pos('system:notebook', Node.ChildNodes.Item[J].TextContent) > 0 then begin EnterCriticalSection(CriticalSection); try TheLister.NoteBookList.Add(Filename, UTF8Copy(Node.ChildNodes.Item[J].TextContent, 17, 1000), NoteP^.IsTemplate); finally LeaveCriticalSection(CriticalSection); end; // debugln('Notelister #691 ' + UTF8Copy(Node.ChildNodes.Item[J].TextContent, 17,1000)); end; // Node.ChildNodes.Item[J].TextContent) may be something like - // * system:notebook:DavosNotebook - this note belongs to DavosNotebook // * system:template - this note is a template, if does not also have a // Notebook tag its the StartHere note, otherwise its the Template for // for the mentioned Notebook. end; except on E: EXMLReadError do begin EnterCriticalSection(CriticalSection); try DebugLn('XML ERROR' + E.Message); XMLError := True; dispose(NoteP); TheLister.ErrorNotes.Append(FileName + ', ' + E.Message); //exit(); // generates a wierd unresolable symbol on windows ?? Move down a couple of lines finally LeaveCriticalSection(CriticalSection); end; exit(); end; on EAccessViolation do DebugLn('Access Violation ' + FileName); end; if NoteP^.IsTemplate then begin // Don't show templates in normal note list dispose(NoteP); exit(); end; EnterCriticalSection(CriticalSection); try TheLister.NoteList.Add(NoteP); finally LeaveCriticalSection(CriticalSection); end; finally Doc.free; end; end else DebugLn('Error, found a note and lost it ! ' + Dir + FileName); end; procedure TNoteLister.IndexThisNote(const ID: String); // While not using threads, this method must init critical section because GetNoteDetails expects it. // This is used to index newly download synced notes and newly recovered (from backup) notes. begin //DebugMode := True; //debugln('TNoteLister.IndexThisNote'); InitCriticalSection(CriticalSection); GetNoteDetails(WorkingDir, CleanFileName(ID), false, self); DoneCriticalSection(CriticalSection); //DebugMode := False; end; function TNoteLister.GetLastChangeDate(const ID: String) : string; var index : integer; FileName : string; eStr : string = ''; begin Result := ''; if not assigned(NoteList) then exit(''); FileName := CleanFileName(ID); //for Index := 0 to NoteList.Count -1 do for Index := NoteList.Count -1 downto 0 do if NoteList.Items[Index]^.ID = FileName then begin exit(NoteList.Items[Index]^.LastChange); // debugln('NoteLister #759 from list ' + NoteList.Items[Index]^.LastChange); end; // if to here, did not find that ID in Notes List. I wonder if its a Notebook ? if FileExists(WorkingDir + ID + '.note') then begin Result := GetNoteLastChangeSt(WorkingDir + ID + '.note', EStr); if EStr <> '' then DebugLn('TGithubSync.LocalLastChangeDate - detected error in ' + ID); end; end; function TNoteLister.GetTitle(const ID: String) : string; var index : integer; FileName : string; begin Result := ''; if not assigned(NoteList) then exit(''); FileName := CleanFileName(ID); for Index := NoteList.Count -1 downto 0 do //for Index := 0 to NoteList.Count -1 do if NoteList.Items[Index]^.ID = FileName then exit(NoteList.Items[Index]^.Title); end; function TNoteLister.IsIDPresent(ID: string): boolean; var FileName : string; index : integer; begin Result := False; FileName := CleanFileName(ID); for Index := NoteList.Count -1 downto 0 do //for Index := 0 to NoteList.Count -1 do if NoteList.Items[Index]^.ID = FileName then exit(True); end; function TNoteLister.FindFirstOpenNote(): TForm; begin OpenNoteIndex:=0; while OpenNoteIndex < NoteList.Count do if NoteList.Items[OpenNoteIndex]^.OpenNote <> nil then exit(NoteList.Items[OpenNoteIndex]^.OpenNote) else inc(OpenNoteIndex); result := nil; OpenNoteIndex := -1; end; function TNoteLister.FindNextOpenNote(): TForm; begin if OpenNoteIndex < 0 then exit(Nil); inc(OpenNoteIndex); while OpenNoteIndex < NoteList.Count do if NoteList.Items[OpenNoteIndex]^.OpenNote <> nil then exit(NoteList.Items[OpenNoteIndex]^.OpenNote) else inc(OpenNoteIndex); result := nil; OpenNoteIndex := -1; end; function TNoteLister.FindFirstOOSNote(out NTitle, NID : ANSIstring): boolean; begin OpenNoteIndex:=0; while OpenNoteIndex < NoteList.Count do if NoteList.Items[OpenNoteIndex]^.OpenOnStart then begin NTitle := NoteList.Items[OpenNoteIndex]^.Title; NID := NoteList.Items[OpenNoteIndex]^.ID; exit(True) end else inc(OpenNoteIndex); result := False; OpenNoteIndex := -1; end; function TNoteLister.FindNextOOSNote(var NTitle, NID : ANSIstring): boolean; begin if OpenNoteIndex < 0 then exit(False); inc(OpenNoteIndex); while OpenNoteIndex < NoteList.Count do if NoteList.Items[OpenNoteIndex]^.OpenOnStart then begin NTitle := NoteList.Items[OpenNoteIndex]^.Title; NID := NoteList.Items[OpenNoteIndex]^.ID; exit(True) end else inc(OpenNoteIndex); result := False; OpenNoteIndex := -1; end; procedure TNoteLister.BuildSearchList(SL : TStringList; const Term : AnsiString); var I : integer = 1; AWord : string = ''; InCommas : boolean = false; begin // sections in inverted commas to be treated as one word, becomes on line in list // its very wastefull to use a List here, lots of overhead we are not useing but easy. // look at a managed record ? while I <= length(trim(Term)) do begin if Term[i] = '"' then begin if InCommas then begin SL.add(AWord); AWord := ''; InCommas := False; end else begin InCommas := true; end; inc(I); continue; end; if Term[i] = ' ' then begin if InCommas then AWord := AWord + Term[i] else begin if AWord <> '' then begin SL.Add(AWord); AWord := ''; end; end; inc(I); continue; end; AWord := AWord + Term[i]; inc(i); continue; end; if AWord <> '' then SL.Add(AWord); end; // Pass this function a TStringList each line of which must be matched for a 'hit' // Moved out of class so that the threaded search can find and use it. function NoteContains(const TermList : TStringList; FullFileName: ANSIString; const CaseSensitive : boolean): boolean; var SLNote : TStringList; I, Index : integer; begin Result := False; SLNote := TStringList.Create; SlNote.LoadFromFile(FullFileName); for Index := 0 to SLNote.Count - 1 do SLNote.Strings[Index] := RemoveXML(SLNote.Strings[Index]); for I := 0 to TermList.Count -1 do begin // Iterate over search terms Result := False; for Index := 0 to SLNote.Count - 1 do begin // Check each line of note for a match against current word. if CaseSensitive then begin if (UTF8Pos(TermList.Strings[I], SLNote.Strings[Index]) > 0) then begin Result := True; break; end; end else if (UTF8Pos(UTF8LowerString(TermList.Strings[I]), UTF8LowerString(SLNote.Strings[Index])) > 0) then begin Result := True; break; end; end; if not Result then break; // if failed to turn Result on for first word, no point in continuing end; // when we get here, if Result is true, run finished without a fail. FreeandNil(SLNote); end; procedure TNoteLister.AddNote(const FileName, Title, LastChange : ANSIString); var NoteP : PNote; begin new(NoteP); NoteP^.ID := CleanFilename(FileName); NoteP^.LastChange := LastChange; {copy(LastChange, 1, 19); } //NoteP^.LastChange[11] := ' '; NoteP^.CreateDate := LastChange; {copy(LastChange, 1, 19); } //NoteP^.CreateDate[11] := ' '; NoteP^.Title:= Title; NoteP^.OpenNote := nil; NoteList.Add(NoteP); // We don't need to re-sort here, the new note is added at the end, and our // list is sorted, newest towards the end. All good. end; function TNoteLister.Count(): integer; begin Result := NoteList.Count; end; function TNoteLister.GetTitle(Index : integer) : string; begin Result := PNote(NoteList.get(Index))^.Title; end; function TNoteLister.GetNote(Index : integer) : PNote; begin Result := NoteList[Index]; end; { With 2000 notes, on my Dell, linux, search for 'and'. Before multithreading - 250mS - 280mS With Multithreading, cthreads and cmem - 6 : 90ms to 110ms; 4 : 100mS - 134ms; 3 : 110ms - 130mS; 2 : 155ms - 180ms; 1 : 255ms - 280mS However, noted on Windows Vista (!), significent slow down ! Windows10, similar to Linux } const ThreadCount = 3; // The number of extra threads set searching. 3 seems reasonable... function TNoteLister.SearchNotes(const Term: ANSIstring) : longint; var TermList, FileList : TStringList; ThreadIndex : integer = 0; SearchThread : TSearchThread; begin TermList := TStringList.Create; FileList := Nil; try BuildSearchList(TermList, Term); if DebugMode then debugln('Empty Search Lists created'); SearchNoteList.Free; SearchNoteList := TNoteList.Create; FinishedThreads := 0; ThreadLock := -1; FileList := FindAllFiles(WorkingDir, '*.note', false); // list contains full file names ! while ThreadIndex < ThreadCount do begin SearchThread := TSearchThread.Create(True); // Threads clean themselves up. SearchThread.NoteLister := self; SearchThread.ThreadBlockSize := FileList.Count div ThreadCount; SearchThread.Term_List := TermList; SearchThread.File_List := FileList; SearchThread.ResultsList := SearchNoteList; SearchThread.TIndex := ThreadIndex; {$ifdef TOMBOY_NG} SearchThread.CaseSensitive := Sett.SearchCaseSensitive; {$endif} SearchThread.start(); inc(ThreadIndex); end; while FinishedThreads < ThreadCount do sleep(1); // ToDo : some sort of 'its taken too long ..." SearchNoteList.Sort(@LastChangeSorter); result := SearchNoteList.Count; finally if FileList <> nil then FileList.free; TermList.Free; end; end; function TNoteLister.IndexNotes(DontTestName : boolean = false): longint; var //Info : TSearchRec; cnt : integer = 4; IndexThread : TIndexThread; begin //DebugMode := true; XMLError := False; if DontTestName then begin cnt := 1; // Just one thread. FinishedThreads := 3; end else FinishedThreads := 0; NoteList.Free; NoteList := TNoteList.Create; NoteBookList.Free; NoteBookList := TNoteBookList.Create; if DebugMode then debugln('Empty Note and Book Lists created'); FreeandNil(ErrorNotes); ErrorNotes := TStringList.Create; if DebugMode then debugln('Looking for notes in [' + WorkingDir + ']'); InitCriticalSection(CriticalSection); // +++++++++++ while Cnt > 0 do begin //debugln('Making thread ' + inttostr(Cnt)); IndexThread := TIndexThread.Create(True); // Threads clean themselves up. IndexThread.GetNoteDetailsProc := @GetNoteDetails; // pass the address of the proc to the Thread class. IndexThread.WorkingDir := WorkingDir; IndexThread.OneThread := DontTestName; IndexThread.TheLister := self; case Cnt of // This is ignored in OneThread mode {$ifdef WINDOWS} 1 : IndexThread.StartsWith:= ['0', '1', '2', '3']; 2 : IndexThread.StartsWith:= ['4', '5', '6', '7']; 3 : IndexThread.StartsWith:= ['8', '9', 'A', 'B']; 4 : IndexThread.StartsWith:= ['C', 'D', 'E', 'F']; {$else} 1 : IndexThread.StartsWith:= ['0', '1', '2', '3', '4']; 2 : IndexThread.StartsWith:= ['5', '6', '7', '8', '9']; 3 : IndexThread.StartsWith:= ['a', 'B', 'c', 'D', 'e', 'F']; 4 : IndexThread.StartsWith:= ['A', 'b', 'C', 'd', 'E', 'f']; {$endif} end; IndexThread.start(); //debugln('Finished Making thread ' + inttostr(Cnt)); dec(Cnt); end; while FinishedThreads < 4 do sleep(1); // ToDo : some sort of 'its taken too long ..." DoneCriticalSection(CriticalSection); // ++++++++++++ if DebugMode then begin debugLn('Finished indexing notes'); DumpNoteNoteList('TNoteLister.IndexNotes'); end; NotebookList.CleanList(); Result := NoteList.Count; NoteList.Sort(@LastChangeSorter); // 0mS on Dell NoteBookList.Sort(@NotebookSorter); end; procedure TNoteLister.LoadStGrid(const Grid : TStringGrid; NoCols : integer; SearchMode : boolean = false); var Index : integer; TheList : TNoteList; LCDst : string; CDst : string; //T1, T2, T3 : qword; begin //T1 := gettickcount64(); if SearchMode then TheList := SearchNoteList else TheList := NoteList; while Grid.RowCount > 1 do Grid.DeleteRow(Grid.RowCount-1); //T2 := gettickcount64(); Index := TheList.Count; while Index > 0 do begin dec(Index); LCDst := TheList.Items[Index]^.LastChange; if length(LCDst) > 11 then // looks prettier, dates are stored in ISO std LCDst[11] := ' '; // with a 'T' between date and time if length(LCDst) > 16 then LCDst := copy(LCDst, 1, 16); // we only want hours and minutes CDst := TheList.Items[Index]^.CreateDate; if length(CDst) > 11 then CDst[11] := ' '; if length(CDst) > 16 then CDst := copy(CDst, 1, 16); case NoCols of 2 : Grid.InsertRowWithValues(Grid.RowCount, [TheList.Items[Index]^.Title, LCDst]); 3 : Grid.InsertRowWithValues(Grid.RowCount, [TheList.Items[Index]^.Title, LCDst, CDst]); 4 : Grid.InsertRowWithValues(Grid.RowCount, [TheList.Items[Index]^.Title, LCDst, CDst, TheList.Items[Index]^.ID]); end; end; if Grid.SortColumn > -1 then Grid.SortColRow(True, Grid.SortColumn); // T3 := gettickcount64(); // debugln('Note_Lister - LoadStGrid ' + inttostr(T2 - T1) + ' ' + inttostr(T3 - T2)); end; function TNoteLister.NewLVItem(const LView : TListView; const Title, DateSt, FileName: string): TListItem; var TheItem : TListItem; DT : TDateTime; begin TheItem := LView.Items.Add; TheItem.Caption := Title; if MyTryISO8601ToDate(DateSt, DT) then TheItem.SubItems.Add(MyFormatDateTime(DT, True) + ' ') else TheItem.SubItems.Add('ERROR bad date string '); TheItem.SubItems.Add(FileName); Result := TheItem; end; procedure TNoteLister.LoadListView(const LView : TListView; const SearchMode : boolean); var Index : integer; TheList : TNoteList; //LCDst : string; //T1, T2, T3 : qword; // Full list mode, 2000 notes, Dell 7mS to clear, 20-40mS to load. begin //T1 := gettickcount64(); LView.Clear; if SearchMode then TheList := SearchNoteList else TheList := NoteList; //T2 := gettickcount64(); Index := TheList.Count; while Index > 0 do begin dec(Index); // LCDst := TheList.Items[Index]^.LastChange; // if length(LCDst) > 11 then // looks prettier, dates are stored in ISO std // LCDst[11] := ' '; // with a 'T' between date and time // NewLVItem(LView, TheList.Items[Index]^.Title, LCDst, TheList.Items[Index]^.ID); NewLVItem(LView, TheList.Items[Index]^.Title, TheList.Items[Index]^.LastChange, TheList.Items[Index]^.ID); end; //T3 := gettickcount64(); // debugln('LoadListView Clear=' + dbgs(T2 - T1) + ' Fill=' + dbgs(T3 - T2)); end; procedure TNoteLister.LoadStrings(const TheStrings: TStrings); var Index : integer; begin Index := NoteList.Count; while Index > 0 do begin dec(Index); TheStrings.AddObject(NoteList.Items[Index]^.Title, tObject(NoteList.Items[Index]^.ID)); end; end; function TNoteLister.AlterNote(ID, Change: ANSIString; Title: ANSIString): boolean; var Index : integer; begin result := False; for Index := NoteList.Count -1 downto 0 do begin //for Index := 0 to NoteList.Count -1 do begin if CleanFilename(ID) = NoteList.Items[Index]^.ID then begin if Title <> '' then NoteList.Items[Index]^.Title := Title; if Change <> '' then begin NoteList.Items[Index]^.LastChange := Change; {copy(Change, 1, 19);} // NoteList.Items[Index]^.LastChange[11] := ' '; // keep list in ISO format, make pretty when displaying // check if note is already at the bottom of the list, don't need to re-sort. if (Index < (NoteList.Count -1)) then NoteList.Sort(@LastChangeSorter); end; exit(True); end; end; end; function TNoteLister.IsThisATitle(const Title: ANSIString): boolean; var Index : integer; begin Result := False; for Index := NoteList.Count -1 downto 0 do begin //for Index := 0 to NoteList.Count -1 do begin if Title = NoteList.Items[Index]^.Title then begin Result := True; break; end; end; end; function TNoteLister.CleanFileName(const FileOrID : AnsiString) : ANSIString; begin if length(ExtractFileNameOnly(FileOrID)) = 36 then Result := ExtractFileNameOnly(FileOrID) + '.note' else Result := ExtractFileNameOnly(FileOrID); end; function TNoteLister.IsThisNoteOpen(const ID: ANSIString; out TheForm : TForm): boolean; var Index : integer; begin Result := False; TheForm := Nil; for Index := NoteList.Count -1 downto 0 do begin //for Index := 0 to NoteList.Count -1 do begin if CleanFileName(ID) = NoteList.Items[Index]^.ID then begin TheForm := NoteList.Items[Index]^.OpenNote; Result := not (NoteList.Items[Index]^.OpenNote = Nil); break; end; end; end; function TNoteLister.ThisNoteIsOpen(const ID : ANSIString; const TheForm: TForm) : boolean; var Index : integer; //cnt : integer; JustID : string; begin result := false; if NoteList = NIl then exit; JustID := CleanFileName(ID); if NoteList.Count < 1 then begin //DebugLn('Called ThisNoteIsOpen() with empty but not NIL list. Count is ' // + inttostr(NoteList.Count) + ' ' + ID); // Occasionally I think we see a non reproducable error here. // I believe is legal to start the for loop below with an empty list but .... // When we are creating the very first note in a dir, this happens. Count should be exactly zero. end; //cnt := NoteList.Count; for Index := NoteList.Count -1 downto 0 do begin // for Index := 0 to NoteList.Count -1 do begin //writeln('ID = ', ID, ' ListID = ', NoteList.Items[Index]^.ID); if JustID = NoteList.Items[Index]^.ID then begin NoteList.Items[Index]^.OpenNote := TheForm; exit(true); end; end; // if Index = (NoteList.Count -1) then DebugLn('Failed to find ID in List ', ID); end; function TNoteLister.FileNameForTitle(const Title: ANSIString; out FileName : ANSIstring): boolean; var Index : integer; begin FileName := ''; Result := False; for Index := NoteList.Count -1 downto 0 do begin //for Index := 0 to NoteList.Count -1 do begin if lowercase(Title) = lowercase(NoteList.Items[Index]^.Title) then begin FileName := NoteList.Items[Index]^.ID; Result := True; break; end; end; end; procedure TNoteLister.StartSearch(); begin SearchIndex := 0; end; function TNoteLister.NextNoteTitle(out SearchTerm: ANSIString): boolean; begin Result := False; if SearchIndex < NoteList.Count then begin SearchTerm := NoteList.Items[SearchIndex]^.Title; inc(SearchIndex); Result := True; end; end; function TNoteLister.DeleteNote(const ID: ANSIString): boolean; var Index : integer; JustID : string; begin result := False; JustID := CleanFileName(ID); //DebugLn('TNoteLister.DeleteNote - asked to delete ', ID); for Index := NoteList.Count -1 downto 0 do begin //for Index := 0 to NoteList.Count -1 do begin if JustID = NoteList.Items[Index]^.ID then begin dispose(NoteList.Items[Index]); NoteList.Delete(Index); Result := True; break; end; end; if Result = false then DebugLn('Failed to remove ref to note in NoteLister ', ID); end; constructor TNoteLister.Create; begin SearchNoteList := nil; NoteList := nil; NoteBookList := Nil; ErrorNotes := Nil; end; destructor TNoteLister.Destroy; begin NoteBookList.Free; NoteBookList := Nil; SearchNoteList.Free; SearchNoteList := Nil; NoteList.Free; NoteList := Nil; ErrorNotes.Free; ErrorNotes := Nil; inherited Destroy; end; { ========================= TNoteList ====================== } destructor TNoteList.Destroy; var I : integer; begin for I := 0 to Count-1 do begin dispose(Items[I]); end; inherited Destroy; end; function TNoteList.Add(ANote: PNote): integer; {var ExtNote : PNote; } begin { ExtNote := FindID(ANote^.ID); if ExtNote <> Nil then begin ExtNote^.CreateDate := ANote^.CreateDate; ExtNote^.IsTemplate:= ANote^.IsTemplate; ExtNote^.LastChange := ANote^.LastChange ; ExtNote^.OpenNote := ANote^.OpenNote ; ExtNote^.OpenOnStart := ANote^.OpenOnStart ; ExtNote^.Title := ANote^.Title ; dispose(ANote); Result := 0; end else } result := inherited Add(ANote); end; function TNoteList.FindID(const ID: ANSIString): PNote; var Index : longint; begin Result := Nil; for Index := Count-1 downto 0 do begin //for Index := 0 to Count-1 do begin if Items[Index]^.ID = ID then begin Result := Items[Index]; exit() end; end; end; function TNoteList.Get(Index: integer): PNote; begin Result := PNote(inherited get(Index)); end; end. tomboy-ng_0.34-1/source/tb_sdiff.pas0000644000175000017500000003103514145033507017204 0ustar dbannondbannonunit TB_SDiff; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ A unit that can display differences between two similar notes. User can choose to use First (Remote) or Second (Local) // Use Remote, Yellow is mrYes, File1 // Use Local, Aqua is mrNo, File2 // Always Use Local is mrNoToAll // Always Use Remote is mrYesToAll // Always use newest mrAll // Always use oldest mrClose // Anything else is DoNothing - no, do not permit donothing } { History 2018/08/14 Added to project 2018/09/17 Changes to work with new sync model. We now just use the two file names in TClashRec and we get the last-change-dates our selves. Should be compatible with old sync model .... 2018/10/16 Options to apply choice to all notes. 2019/10/17 Trap exception if, for some reason, we cannot load one of the note files. } {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, ComCtrls, Buttons, kmemo, menus; type { TFormSDiff } TFormSDiff = class(TForm) BitBtnUseRemote: TBitBtn; BitBtnUseLocal: TBitBtn; ButtAllOldest: TButton; ButtAllNewest: TButton; ButtAllLocal: TButton; ButtAllRemote: TButton; KMemo1: TKMemo; Label1: TLabel; LabelRemote: TLabel; LabelLocal: TLabel; Label3: TLabel; Label4: TLabel; Panel1: TPanel; RadioLong: TRadioButton; RadioShort: TRadioButton; procedure FormShow(Sender: TObject); procedure KMemo1Change(Sender: TObject); procedure RadioLongChange(Sender: TObject); private procedure AddDiffText(DiffText : string; NoteNo : integer = 0); procedure AddHeader(Title: string); {Returns 0 if no further sync works, 1 or 2 depending on which does sync eg 1 means you should go incrementing 1 until it looks like 2 in other words, '1' means 1 can be matched. 2 must have been an insert. } function CanResync(const SL1, SL2: TStringList; const Spot1, Spot2, End1, End2: integer ): integer; procedure CheckFiles(); //function GetDateFromStr(const DateStr: ANSIString): TDateTime; //function GetNoteChangeGMT(const FullFileName: ANSIString; out LastChange: ANSIString): TDateTime; procedure GotoEnd(const NoteNo : integer; const SL: TStringList; const Spot, TheEnd: integer); function RemoveXml(const St: AnsiString): AnsiString; // Returns a new (synced) Pos, showing intermediate lines. function Resync(const Target : string; NoteNo : integer; const SL : TStringList; var Spot : integer) : integer; public RemoteFileName : string; // #1 LocalFileName : string; // #2 NoteTitle : string; end; //var // FormSDiff: TFormSDiff; implementation {$R *.lfm} uses LazLogger, laz2_DOM, laz2_XMLRead, LazFileUtils, DateUtils, syncutils, tb_utils; { TFormSDiff } function TFormSDiff.RemoveXml(const St : AnsiString) : AnsiString; var X, Y : integer; FoundOne : boolean = false; begin Result := St; repeat FoundOne := False; X := Pos('<', Result); // don't use UTF8Pos for byte operations if X > 0 then begin Y := Pos('>', Result); if Y > 0 then begin Delete(Result, X, Y-X+1); FoundOne := True; end; end; until not FoundOne; Result := trim(Result); end; procedure TFormSDiff.AddDiffText(DiffText : string; NoteNo : integer = 0); var TB, TBPre: TKMemoTextBlock; begin // TB.TextStyle.Font.Size := 16; if NoteNo > 0 then begin TBpre := KMemo1.Blocks.AddTextBlock(inttostr(NoteNo) + '> '); //TBpre.TextStyle.Font.Style := TBpre.TextStyle.Font.Style + [fsBold]; TBpre.TextStyle.Font.Style := [fsBold]; end; if RadioShort.Checked then TB := KMemo1.Blocks.AddTextBlock(Copy(DiffText, 1, 50)) else TB := KMemo1.Blocks.AddTextBlock(DiffText); if NoteNo = 1 then TB.TextStyle.Brush.Color := BitBtnUseRemote.Color; if NoteNo = 2 then TB.TextStyle.Brush.Color := BitBtnUseLocal.Color; KMemo1.blocks.AddParagraph(); end; procedure TFormSDiff.AddHeader(Title : string); var TB: TKMemoTextBlock; begin KMemo1.Clear(False); TB := KMemo1.Blocks.AddTextBlock(Title); TB.TextStyle.Font.Size := 16; TB.TextStyle.Font.Style := [fsBold]; KMemo1.blocks.AddParagraph(); end; function TFormSDiff.CanResync(const SL1, SL2 : TStringList; const Spot1, Spot2, End1, End2 : integer) : integer; var Offset : integer; begin Result := 0; for Offset := Spot1 to End1 do if RemoveXML(SL1[Offset]) = RemoveXML(SL2[Spot2]) then exit(1); for Offset := Spot2 to End2 do if RemoveXML(SL2[Offset]) = RemoveXML(SL1[Spot1]) then exit(2); end; // Returns a new (synced) Pos, showing intermediate lines. function TFormSDiff.Resync(const Target : string; NoteNo : integer; const SL : TStringList; var Spot : integer) : integer; begin Result := Spot; while RemoveXML(Target) <> RemoveXML(SL[Result]) do begin AddDiffText(RemoveXML(SL[Result]), NoteNo); inc(Result); end; end; procedure TFormSDiff.GotoEnd(const NoteNo : integer; const SL : TStringList; const Spot, TheEnd : integer); var I : integer; begin for I := Spot to TheEnd - 1 do AddDiffText(RemoveXML(SL[I]), NoteNo); end; procedure TFormSDiff.FormShow(Sender: TObject); var TestDate: TDateTime; //LastChange : string; ErrorSt : string; begin LabelLocal.Caption := GetNoteLastChangeSt(LocalFileName, ErrorSt); if ErrorSt <> '' then ShowMessage(ErrorSt); if not MyTryISO8601ToDate(LabelLocal.Caption, TestDate, False) then Showmessage('Invalid last sync date in local version of note'); LabelRemote.Caption := GetNoteLastChangeSt(RemoteFileName, ErrorSt); if ErrorSt <> '' then ShowMessage(ErrorSt); if not MyTryISO8601ToDate(LabelLocal.Caption, TestDate, False) then Showmessage('Invalid last sync date in remote version of note'); // Go and get Title and last-change-date from both versions of note (* TestDate := GetNoteChangeGMT(LocalFileName, LastChange); if (TestDate > now()) or (TestDate < (Now() - 36500)) then // TDateTime has integer part no. of days, fraction part is fraction of day. // we have here in the future or more than 100years ago - Fail ! // +++++++++++++++++++++++++++++++++++++++++++++++++ // ToDo : this is wrong, see how to do it in sync // +++++++++++++++++++++++++++++++++++++++++++++++++ Showmessage('Invalid last sync date in local version of note') else LabelLocal.Caption := LastChange; GetNoteChangeGMT(RemoteFileName, LastChange); if (TestDate > now()) or (TestDate < (Now() - 36500)) then Showmessage('Invalid last sync date in remote version of note') else LabelRemote.Caption := LastChange; *) CheckFiles(); end; procedure TFormSDiff.KMemo1Change(Sender: TObject); begin end; (* function TFormSDiff.GetNoteChangeGMT(const FullFileName : ANSIString; out LastChange : ANSIString) : TDateTime; var Doc : TXMLDocument; Node : TDOMNode; begin if not FileExistsUTF8(FullFileName) then begin DebugLn('ERROR - File not found, cant read note change date for ', FullFileName); Result := 0.0; exit(); end; try ReadXMLFile(Doc, FullFileName); Node := Doc.DocumentElement.FindNode('last-change-date'); LastChange := Node.FirstChild.NodeValue; finally Doc.free; // xml errors are caught in calling process end; Result := GetDateFromStr(LastChange); end; function TFormSDiff.GetDateFromStr(const DateStr: ANSIString): TDateTime; var TimeZone : TDateTime; begin try if not TryEncodeTimeInterval(strtoint(copy(DateStr, 29, 2)), // Hour strtoint(copy(DateStr, 32, 2)), // Minutes 0, // Seconds 0, // mSeconds TimeZone) then DebugLn('Fail on interval encode '); except on EConvertError do begin DebugLn('FAIL on converting time interval ' + DateStr); DebugLn('Hour ', copy(DateStr, 29, 2), ' minutes ', copy(DateStr, 32, 2)); end; end; try if not TryEncodeDateTime(strtoint(copy(DateStr, 1, 4)), // Year strtoint(copy(DateStr, 6, 2)), // Month strtoint(copy(DateStr, 9, 2)), // Day strtoint(copy(DateStr, 12, 2)), // Hour strtoint(copy(DateStr, 15, 2)), // Minutes strtoint(copy(DateStr, 18, 2)), // Seconds strtoint(copy(DateStr, 21, 3)), // mSeconds Result) then DebugLn('Fail on date time encode '); except on EConvertError do begin DebugLn('FAIL on converting date time ' + DateStr); end; end; try if DateStr[28] = '+' then Result := Result - TimeZone else if DateStr[28] = '-' then Result := Result + TimeZone else debugLn('******* Bugger, we are not parsing DATE String - Please Report ********'); except on EConvertError do begin DebugLn('FAIL on calculating GMT ' + DateStr); end; end; { debugln('Date is ', DatetoStr(Result), ' ', TimetoStr(Result)); } end; *) procedure TFormSDiff.RadioLongChange(Sender: TObject); begin CheckFiles(); end; const LinesXML = 16; // bit arbitary, seems notes have about 16 lines of XML header and footer procedure TFormSDiff.CheckFiles(); var SL1, SL2 : TStringList; Pos1, Pos2, Offset1, Offset2, End1, End2 : integer; Sync : Integer; begin Pos1 := 0; Pos2 := 0; Offset2 := 0; Offset1 := 0; SL1 := TStringList.create; // This may generate a EFOpenError !! SL2 := TStringList.create; // This may generate a EFOpenError !! try // open the two files and find their beginnings and ends of content try SL1.LoadFromFile(RemoteFileName); except on E: EFOpenError do debugln('Unable to find remote file in repo ' + RemoteFileName); end; try SL2.LoadFromFile(LocalFileName); except on E: EFOpenError do debugln('Unable to find local file ' + LocalFileName); end; AddHeader(NoteTitle); AddDiffText('Remote File ' + inttostr(SL1.Count-LinesXML) + ' lines ', 1); AddDiffText('Local File ' + inttostr(SL2.Count-LinesXML) + ' lines ', 2); while (Pos1 < SL1.Count) and (0 = pos(' Nil then FreeAndNil(SnapNoteLister); end; procedure TFormRecover.ButtonDeleteBadNotesClick(Sender: TObject); var I : integer = 1; Cnt : integer = 0; begin for I := 1 to StringGridNotes.RowCount-1 do begin // includes header showmessage('Delete ' + StringGridNotes.Cells[0, I]); DeleteFile(NoteDir + StringGridNotes.Cells[0, I] + '.note'); inc(Cnt); end; //showmessage(rsDeletedDamaged_1 + ' ' + inttostr(CNT) + ' ' + rsDeletedDamaged_2 ); showmessage(format(rsDeletedDamaged, [CNT])); end; procedure TFormRecover.ButtonRecoverSnapClick(Sender: TObject); {var ZName : string; } begin if (ListBoxSnapshots.ItemIndex >= 0) and (ListBoxSnapshots.ItemIndex < ListBoxSnapshots.Count) then begin RestoreSnapshot(ListBoxSnapshots.Items[ListBoxSnapshots.ItemIndex]); //showmessage('I''d use [' + ZName + '] and put it all in [' + NoteDir); end; end; procedure TFormRecover.ButtonSnapHelpClick(Sender: TObject); begin // MainUnit.MainForm.ShowHelpNote('recover.note'); SearchForm.ShowHelpNote('recover.note'); end; procedure TFormRecover.ButtonMakeSafetySnapClick(Sender: TObject); begin CreateSnapshot(True); //CreateSnapShot(NoteDir, FullSnapDir + 'Safety.zip'); // abandonded idea of safety snapshot, too complicated //Label1.Caption := rsWeHaveSnapShots_1 + ' ' + inttostr(FindSnapFiles()) + ' ' + rsWeHaveSnapShots_2; Label1.Caption := format(rsWeHaveSnapShots, [FindSnapFiles()]); end; procedure TFormRecover.RestoreSnapshot(const Snapshot : string); begin {if mrYes <> QuestionDlg(rsDeleteAndReplace_1, rsDeleteAndReplace_2 + ' ' + NoteDir + ' ' + rsDeleteAndReplace_3 + ' ' + FormatDateTime( 'yyyy-mm-dd hh:mm', FileDateToDateTime(FileAge(FullSnapDir + Snapshot))) + ' ?' // + Snapshot + ' ' + DateTimeToStr(FileDateToDateTime(FileAge(FullSnapDir + Snapshot))) + ' ?' , mtConfirmation, [mrYes, mrNo], 0) then exit; } if mrYes <> QuestionDlg(rsDeleteAndReplace_1, format(rsDeleteAndReplace_2 , [NoteDir, FormatDateTime( 'yyyy-mm-dd hh:mm', FileDateToDateTime(FileAge(FullSnapDir + Snapshot)))]) , mtConfirmation, [mrYes, mrNo], 0) then exit; CleanAndUnzip(NoteDir, FullSnapDir + Snapshot); if FileExists(NoteDir + 'config' + PathDelim + 'tomboy-ng.cfg') then begin CopyFile(NoteDir + 'config' + PathDelim + 'tomboy-ng.cfg', ConfigDir + 'tomboy-ng.cfg'); DeleteFile(NoteDir + 'config' + PathDelim + 'tomboy-ng.cfg'); if FileExists(NoteDir + 'config' + PathDelim + 'manifest.xml') then begin CopyFile(NoteDir + 'config' + PathDelim + 'manifest.xml', ConfigDir + 'manifest.xml'); DeleteFile(NoteDir + 'config' + PathDelim + 'manifest.xml'); end; DeleteDirectory(NoteDir + 'config', False); end; showmessage(rsAllRestored); RequiresIndex := true; end; //RESOURCESTRING // rsNoSafetySnapshot = 'A Safety snapshot not found. Try setting Snapshot Dir to where you may have one.'; {procedure TFormRecover.Button4Click(Sender: TObject); begin if fileexists(FullSnapDir + 'Safety.zip') then RestoreSnapshot('Safety.zip') else showmessage(rsNoSafetySnapshot); end;} procedure TFormRecover.StringGridNotesDblClick(Sender: TObject); var NName : string; begin case PageControl1.ActivePageIndex of {0,} 1 : begin try NName := StringGridNotes.Cells[0, StringGridNotes.Row]; except on EGridException do exit; end; if length(NName) < 9 then exit; // empty returns ID.note from col(0) title // showmessage('We will open [' + NName + ']'); MainUnit.MainForm.SingleNoteMode(NoteDir + NName, False, False); end; 2, 3, 4 : begin try NName := StringGridNotes.Cells[3, StringGridNotes.Row]; except on EGridException do exit; // clicked outside valid area end; if length(NName) < 9 then exit; // showmessage('We will open ' + FullSnapDir + 'temp' + PathDelim + NName); MainUnit.MainForm.SingleNoteMode(FullSnapDir + 'temp' + PathDelim + NName, False, True); end; end; end; procedure TFormRecover.CleanAndUnzip(const FullDestDir, FullZipName : string); var ZipFile: TUnZipper; Info : TSearchRec; begin ForceDirectory(FullDestDir); if FindFirst(FullDestDir + '*.note', faAnyFile, Info)=0 then begin repeat if debugmode then Debugln('Deleting [' + FullDestDir + Info.Name + ']'); DeleteFileUTF8(FullDestDir + Info.Name); // should we test return value ? until FindNext(Info) <> 0; end; FindClose(Info); if FileExists(FullDestDir + 'config' + PathDelim + 'manifest.xml') then DeleteFile(FullDestDir + 'config' + PathDelim + 'manifest.xml'); if FileExists(FullDestDir + 'config' + PathDelim + 'tomboy-ng.cfg') then DeleteFile(FullDestDir + 'config' + PathDelim + 'tomboy-ng.cfg'); ZipFile := TUnZipper.Create; try ZipFile.FileName := FullZipName; ZipFile.OutputPath := FullDestDir; ZipFile.Examine; ZipFile.UnZipAllFiles; finally ZipFile.Free; end; {$ifdef Darwin} // paszlib, on mac, leaves files with no permissions ! if FindFirst(FullDestDir + '*.note', faAnyFile, Info)=0 then begin repeat fpChmod(FullDestDir + Info.Name, &644); // uses baseunix, should we test return value ? until FindNext(Info) <> 0; end; FindClose(Info); if FileExists(FullDestDir + 'config' + PathDelim + 'manifest.xml') then fpchmod(FullDestDir + 'config' + PathDelim + 'manifest.xml', &644); if FileExists(FullDestDir + 'config' + PathDelim + 'tomboy-ng.cfg') then fpchmod(FullDestDir + 'config' + PathDelim + 'tomboy-ng.cfg', &644); {$endif} end; function TFormRecover.ExpandZipName(AFileName : string) : string; var FName : string; begin // gets eg /somepath/20180826_2135_Sun.zip, 20180826_2135_Sun_Man.zip, 20180826_2135_Sun_Month.zip // 20200714_2004_Auto.zip FName := ExtractFileName(AFileName); if FName = 'Safety.zip' then Result := 'from Intro Tab' else begin Result := copy(FName, 1, 4) + '-' + copy(FName, 5, 2) + '-' + copy(FName, 7, 2); // year Month day Result := Result + ' ' + copy(FName, 10, 2) + ':' + copy(FName, 12, 2); // hour minutes Result := Result + ' ' + copy(FName, 15, 4); // end; end; // Unzips indicated snapshot, indexes its files and lists them in the StringGridNotes procedure TFormRecover.ShowNotes(const FullSnapName : string); begin PanelNoteList.Caption:=rsNotesInSnap +' ' + ExpandZipName(FullSnapName); ForceDirectory(FullSnapDir + 'temp'); CleanAndUnZip(FullSnapDir + 'temp' + PathDelim, FullSnapName); if SnapNoteLister <> Nil then FreeAndNil(SnapNoteLister); SnapNoteLister := TNoteLister.Create; SnapNoteLister.Debugmode := DebugMode; SnapNoteLister.WorkingDir:= FullSnapDir + 'temp' + PathDelim; {Result := }SnapNoteLister.IndexNotes(); SnapNoteLister.LoadStGrid(StringGridNotes, 4); // this must be a TStringGrid 'cos it can show very long lines such as xml errors StringGridNotes.Cells[0, 0] := 'Title'; StringGridNotes.Cells[1, 0] := 'Date'; StringGridNotes.Cells[2, 0] := 'Create'; StringGridNotes.Cells[3, 0] := 'Filename'; //StringGridNotes.Row[0] := ['Title', 'Date', 'Create', 'File']; // StringGridNotes.InsertRowWithValues(0, ['Title', 'Date', 'Create', 'File']); //StringGridNotes.SortOrder := soDescending; // Sort with most recent at top //StringGridNotes.SortColRow(True, 1); stringGridNotes.AutoSizeColumns; ButtonRecoverSnap.Enabled := True; end; function TFormRecover.ZipDate({WithDay : Boolean}) : string; var ThisMoment : TDateTime; begin ThisMoment:=Now; Result := FormatDateTime('YYYYMMDD',ThisMoment) + '_' + FormatDateTime('hhmm',ThisMoment); //if WithDay then Result := Result + '_' + FormatDateTime('ddd', ThisMoment); end; function TFormRecover.CreateSnapshot(const Manual : boolean) : string; var ZipName : string; begin if Manual then ZipName := ZipDate() + '_Man' else ZipName := ZipDate() + '_Auto'; if not DirectoryExists(FullSnapDir) then begin createDir(FullSnapDir); if not DirectoryExists(FullSnapDir) then begin Showmessage('Cannot create ' + FullSnapDir); exit(''); end; end; CreateSnapshot(NoteDir, FullSnapDir + ZipName + '.zip'); result := FullSnapDir + ZipName + '.zip'; end; procedure TFormRecover.CreateSnapshot(const FullSourceDir, FullZipName: string); var Zip : TZipper; Info : TSearchRec; // Tick, Tock : QWord; begin //debugln('--------- Config = ' + ConfigDir); Zip := TZipper.Create; try Zip.FileName := FullZipName; // Tick := GetTickCount64(); if FindFirst(FullSourceDir + '*.note', faAnyFile, Info)=0 then begin repeat // debugln('Zipping note [' + FullSourceDir + Info.Name + ']'); Zip.Entries.AddFileEntry(FullSourceDir + Info.Name, Info.Name); until FindNext(Info) <> 0; if FileExists(ConfigDir + 'tomboy-ng.cfg') then Zip.Entries.AddFileEntry(ConfigDir + 'tomboy-ng.cfg', 'config' + PathDelim + 'tomboy-ng.cfg') else Debugln('ERROR - cannot locate ' + ConfigDir + 'tomboy-ng.cfg'); if FileExists(ConfigDir + 'manifest.xml') then Zip.Entries.AddFileEntry(ConfigDir + 'manifest.xml', 'config' + PathDelim + 'manifest.xml') else if DebugMode then debugln('NOTE : Local Manifest not found ' + ConfigDir + 'manifest.xml'); Zip.ZipAllFiles; end; //Tock := GetTickCount64(); // 150mS, 120 notes on lowend laptop finally FindClose(Info); Zip.Free; end; // debugln('All notes in ' + FullSourceDir + ' to ' + FullZipName + ' took ' + inttostr(Tock - Tick) + 'ms'); end; { Removes any more than MaxSnaps Auto generated from the snaps dir. Does not play with Manually generated ones. } procedure TFormRecover.CleanUpSnapshots(const MaxSnaps: integer); var Snaps : TStringList; ToRemoveFromList : integer; St : string; begin Snaps := FindAllFiles(FullSnapDir, '*_Auto.zip', false); // list contains full file names ! try // debugln('RECOVER - CleanUpSnapshots() we have numb snapshots = ' + dbgs(Snaps.Count)); Snaps.Sort; ToRemoveFromList := MaxSnaps; while (ToRemoveFromList > 0) and (Snaps.Count <> 0) do begin Snaps.Delete(Snaps.Count-1); dec(ToRemoveFromList); end; for St in Snaps do begin // debugln('Deleting snap item ' + St); DeleteFile(St); end; finally freeandnil(Snaps); end; end; procedure TFormRecover.ListBoxSnapshotsDblClick(Sender: TObject); begin if (ListBoxSnapshots.ItemIndex >= 0) and (ListBoxSnapshots.ItemIndex < ListBoxSnapshots.Count) then begin ShowNotes(FullSnapDir + ListBoxSnapshots.Items[ListBoxSnapshots.ItemIndex]); end; end; procedure TFormRecover.ListBoxSnapshotsClick(Sender: TObject); begin if (ListBoxSnapshots.ItemIndex >= 0) and (ListBoxSnapshots.ItemIndex < ListBoxSnapshots.Count) then begin ShowNotes(FullSnapDir + ListBoxSnapshots.Items[ListBoxSnapshots.ItemIndex]); end; end; procedure TFormRecover.TabSheetBadNotesShow(Sender: TObject); var I, Comma : integer; Msg : string; begin //showmessage('Existing Show'); StringGridNotes.Visible := True; StringGridNotes.Enabled := True; with StringGridNotes do while RowCount > 1 do DeleteRow(RowCount-1); ButtonDeleteBadNotes.Enabled := False; ListBoxSnapshots.ItemIndex:= -1; ListBoxSnapShots.Enabled:=False; PanelNoteList.Caption:=rsClickBadNote; // LabelNoteErrors.Caption := rsBadNotes_1 + ' ' + inttostr(SearchForm.NoteLister.ErrorNotes.Count) + ' ' + rsBadNotes_2; LabelNoteErrors.Caption := format(rsBadNotes, [SearchForm.NoteLister.ErrorNotes.Count]); LabelExistingAdvice2.Caption := ''; LabelExistingAdvice.Caption := ''; if SearchForm.NoteLister.ErrorNotes.Count <> 0 then begin LabelExistingAdvice.Caption := rsTryRecover_1; LabelExistingAdvice2.Caption := rsTryrecover_2; end; StringGridNotes.Clear; StringGridNotes.FixedRows := 0; StringGridNotes.InsertRowWithValues(0, ['ID', 'ErrorMessage']); StringGridNotes.FixedRows := 1; for I := 0 to SearchForm.NoteLister.ErrorNotes.Count -1 do begin Msg := SearchForm.NoteLister.ErrorNotes.Strings[I]; Comma := pos(',', Msg); StringGridNotes.InsertRowWithValues(I + 1, [copy(Msg, 1, Comma-1), copy(Msg, Comma+1, 200)]); // copy(Msg, 1, Comma-1) = simple file name // copy(Msg, Comma+1, 200) = error messages, may be quite long. end; StringGridNotes.AutoSizeColumns; if {I} SearchForm.NoteLister.ErrorNotes.Count > 0 then ButtonDeleteBadNotes.Enabled:= True; end; procedure TFormRecover.TabSheetIntroShow(Sender: TObject); begin ListBoxSnapShots.Enabled := False; StringGridNotes.Visible := false; ListBoxSnapshots.ItemIndex:= -1; end; procedure TFormRecover.TabSheetMergeSnapshotShow(Sender: TObject); begin ListBoxSnapShots.Enabled:=True; // this tab is not used, probably will not ever be. But it has a count so be careful removing it end; procedure TFormRecover.TabSheetRecoverSnapshotShow(Sender: TObject); begin ListBoxSnapShots.Enabled:=True; ListBoxSnapshots.ItemIndex:= -1; with StringGridNotes do while RowCount > 1 do DeleteRow(RowCount-1); PanelNoteList.Caption:= rsClickSnapShot; StringGridNotes.Visible := True; StringGridNotes.Enabled := True; ButtonRecoverSnap.Enabled := (ListBoxSnapshots.ItemIndex >= 0) and (ListBoxSnapshots.ItemIndex < ListBoxSnapshots.Count); end; procedure TFormRecover.TabSheetRecoverNotesShow(Sender: TObject); begin with StringGridNotes do while RowCount > 1 do DeleteRow(RowCount-1); StringGridNotes.Visible := True; StringGridNotes.Enabled := True; PanelNoteList.Caption:=rsClickSnapShot; ListBoxSnapShots.Enabled:=True; ListBoxSnapshots.ItemIndex:= -1; end; function TFormRecover.FindSnapFiles() : integer; var Info : TSearchRec; begin ListBoxSnapshots.Clear; Result := 0; if FindFirst(FullSnapDir + '*.zip', faAnyFile and faDirectory, Info)=0 then begin repeat ListBoxSnapshots.AddItem(Info.Name, nil); inc(Result); until FindNext(Info) <> 0; end; FindClose(Info); end; end. tomboy-ng_0.34-1/source/syncgui.pas0000644000175000017500000004505414145033507017113 0ustar dbannondbannonunit SyncGUI; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ } { History 2017/12/06 Marked FileSync debug mode off to quieten console output a little 2017/12/30 Changed above DebugMode to VerboseMode 2017/12/30 We now call IndexNotes() after a sync. Potentially slow. 2017/12/30 Added a seperate procedure to do manual Sync, its called by a timer to ensure we can see dialog before it starts. 2018/01/01 Added ID in sync report to make it easier to track errors. 2018/01/01 Set goThumbTracking true so contents of scroll box glide past as you move the "Thumb Slide". 2018/01/01 Changed ModalResult for cancel button to mrCancel 2018/01/08 Tidied up message box text displayed when a sync conflict happens. 2018/01/25 Changes to support Notebooks 2018/01/04 Forced a screen update before manual sync so user knows whats happening. 2018/04/12 Added ability to call MarkNoteReadOnly() to cover case where user has unchanged note open while sync process downloads or deletes that note from disk. 2018/04/13 Taught MarkNoteReadOnly() to also delete ref in NoteLister to a sync deleted note 2018/05/12 Extensive changes - MainUnit is now just that. Only change here relates to naming of MainUnit and SearchUnit. 2018/05/21 Show any sync errors as hints in the StringGrid. 2018/06/02 Honor a cli --debug-sync 2018/06/14 Update labels when transitioning from Testing Sync to Manual Sync 2018/08/14 Added SDiff to replace clumbsy dialog when sync clash happens. 2018/08/18 Improved test/reporting of file access during sync 2018/10/25 New sync model. Much testing, support for Tomdroid. 2018/10/28 Much tweaking and bug fixing. 2018/10/29 Tell TB_Sdiff about note title before showing it. 2018/10/30 Don't show SyNothing in sync report 2018/11/04 Added support to update in memory NoteList after a sync. 2019/05/19 Display strings all (?) moved to resourcestrings 2020/02/20 Added capability to sync without showing GUI. 2020/06/18 Only show good sync notification for 3 seconds 2020/08/07 Changed the stringGrid to a ListView 'cos it handles dark themes better. 2020/08/10 ListView becomes type=vsReport 2020/04/26 Set Save button to disabled immediatly when pressed. 2021/09/08 Added progress indicator } {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, {Grids,} ComCtrls, Syncutils; type { TFormSync } TFormSync = class(TForm) ButtonSave: TButton; ButtonCancel: TButton; ButtonClose: TButton; Label1: TLabel; Label2: TLabel; LabelProgress: TLabel; ListViewReport: TListView; // Viewstyle=vsReport, make columns in Object Inspector Memo1: TMemo; Panel1: TPanel; Panel2: TPanel; Panel3: TPanel; Splitter3: TSplitter; { Runs a sync without showing form. Ret False if error or its not setup. Caller must ensure that Sync is config and that the Sync dir is available. If clash, user will see dialog. } procedure FormCreate(Sender: TObject); function RunSyncHidden() : boolean; procedure ButtonCancelClick(Sender: TObject); procedure ButtonCloseClick(Sender: TObject); procedure ButtonSaveClick(Sender: TObject); procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormHide(Sender: TObject); { At Show, depending on SetUpSync, we'll either go ahead and do it, any error is fatal or, if True, walk user through process. } procedure FormShow(Sender: TObject); private FormShown : boolean; LocalTimer : TTimer; procedure AddLVItem(Act, Title, ID: string); procedure AdjustNoteList(); procedure AfterShown(Sender : TObject); // Display a summary of sync actions to user. function DisplaySync(): string; { Called when user wants to join a (possibly uninitialised) Repo, will handle some problems with user's help. } procedure JoinSync; { Called to do a sync assuming its all setup. Any problem is fatal } function ManualSync: boolean; { Populates the string grid with details of notes to be actioned } procedure ShowReport; { We will pass address of this method to lower level units so they can report on progress. Short one to three words ? } procedure SyncProgress(const St: string); public Busy : boolean; // indicates that there is some sort of sync in process now. Transport : TSyncTransPort; UserName, Password : string; // For those thatnsports that need such things. LocalConfig, NoteDirectory : ANSIString; { Indicates we are doing a setup User has already agreed to abandon any existing Repo but we don't know if indicated spot already contains a repo or, maybe we want to make one. } SetupSync : boolean; { we will pass address of this function to Sync } function Proceed(const ClashRec : TClashRecord) : TSyncAction; end; var FormSync: TFormSync; implementation { In SetupFileSync mode, does a superficial, non writing, test OnShow() user can then click 'OK' and we'd do a real sync, exit and settings saved in calling process. } uses LazLogger, SearchUnit, TB_SDiff, Sync, LCLType, {SyncError,} ResourceStr, {notifier,} Settings{$ifndef Linux}, MainUnit{$else}, tb_utils{$endif}; {$R *.lfm} var ASync : TSync; { TFormSync } function TFormSync.Proceed(const ClashRec : TClashRecord) : TSyncAction; var SDiff : TFormSDiff; begin SDiff := TFormSDiff.Create(self); SDiff.RemoteFilename := ClashRec.ServerFileName; SDiff.LocalFilename := ClashRec.LocalFileName; SDiff.NoteTitle := ClashRec.Title; case SDiff.ShowModal of mrYes : Result := SyDownLoad; mrNo : Result := SyUpLoadEdit; mrNoToAll : Result := SyAllLocal; mrYesToAll : Result := SyAllRemote; mrAll : Result := SyAllNewest; mrClose : Result := SyAllOldest; otherwise Result := SyUnSet; // Thats an ERROR ! What are you doing about it ? end; SDiff.Free; Application.ProcessMessages; // so dialog goes away while remainder are being processed. // Use Remote, Yellow is mrYes, File1 // Use Local, Aqua is mrNo, File2 end; procedure TFormSync.FormClose(Sender: TObject; var CloseAction: TCloseAction); begin FreeandNil(ASync); Busy := False; end; procedure TFormSync.FormHide(Sender: TObject); begin if LocalTimer = Nil then exit(); LocalTimer.Free; LocalTimer := nil; end; procedure TFormSync.SyncProgress(const St: string); begin LabelProgress.Caption := St; Application.ProcessMessages; end; // Following resourcestrings defined in syncUtils.pas function TFormSync.DisplaySync(): string; var UpNew, UpEdit, Down, DelLoc, DelRem, Clash, DoNothing, Errors : integer; begin ASync.ReportMetaData(UpNew, UpEdit, Down, DelLoc, DelRem, Clash, DoNothing, Errors); Memo1.Append(rsNewUploads + inttostr(UpNew)); Memo1.Append(rsEditUploads + inttostr(UpEdit)); Memo1.Append(rsDownloads + inttostr(Down)); Memo1.Append(rsLocalDeletes + inttostr(DelLoc)); Memo1.Append(rsRemoteDeletes + inttostr(DelRem)); Memo1.Append(rsClashes + inttostr(Clash)); Memo1.Append(rsDoNothing + inttostr(DoNothing)); Memo1.Append(rsSyncERRORS + inttostr(Errors)); result := 'Uploads=' + inttostr(UpNew+UpEdit) + ' downloads=' + inttostr(Down) + ' deletes=' + inttostr(DelLoc + DelRem); // debugln('Display Sync called, DoNothings is ' + inttostr(DoNothing)); end; // User is only allowed to press Cancel or Save when this is finished. procedure TFormSync.JoinSync; var SyncAvail : TSyncAvailable; begin freeandnil(ASync); ASync := TSync.Create; Label1.Caption := SyncTransportName(Transport) + ' ' + rsTestingRepo; Application.ProcessMessages; ASync.ProceedFunction:= @Proceed; ASync.DebugMode := Application.HasOption('s', 'debug-sync'); ASync.NotesDir:= NoteDirectory; ASync.ConfigDir := LocalConfig; ASync.ProgressProcedure := @SyncProgress; ASync.Password := Sett.LabelToken.Caption; // better find a better way to do this Davo Async.UserName := Sett.EditUserName.text; ASync.RepoAction:=RepoJoin; Async.SetTransport(TransPort); SyncAvail := ASync.TestConnection(); if SyncAvail = SyncNoRemoteRepo then if mrYes = QuestionDlg('Advice', rsCreateNewRepo, mtConfirmation, [mrYes, mrNo], 0) then begin ASync.RepoAction:=RepoNew; SyncAvail := ASync.TestConnection(); end; if SyncAvail <> SyncReady then begin showmessage(rsUnableToProceed + ' ' + ASync.ErrorString); ModalResult := mrCancel; end; Label1.Caption := SyncTransportName(Transport) + ' ' + rsLookingatNotes; Application.ProcessMessages; ASync.TestRun := True; if ASync.StartSync() then begin DisplaySync(); ShowReport(); Label1.Caption := SyncTransportName(Transport) + ' ' + rsLookingatNotes; Label2.Caption := rsSaveAndSync; ButtonSave.Enabled := True; end else Showmessage(rsSyncError + ' ' + ASync.ErrorString); ButtonCancel.Enabled := True; end; procedure TFormSync.AfterShown(Sender : TObject); begin LocalTimer.Enabled := False; // Don't want to hear from you again if SetUpSync then begin JoinSync(); end else ManualSync(); end; //RESOURCESTRING // rsPleaseWait = 'Please wait a minute or two ...'; procedure TFormSync.FormShow(Sender: TObject); begin if Application.HasOption('debug-sync') then debugln('TFormSync.FormShow '); Busy := True; LabelProgress.Caption := ''; Left := 55 + random(55); Top := 55 + random(55); FormShown := False; Label2.Caption := rsNextBitSlow; Memo1.Clear; ListViewReport.Clear; ButtonSave.Enabled := False; ButtonClose.Enabled := False; ButtonCancel.Enabled := False; {$ifdef windows} // linux apps know how to do this themselves if Sett.DarkTheme then begin // Sett.BackGndColour; Sett.TextColour; ListViewReport.Color := clnavy; ListViewReport.Font.Color := Sett.HiColour; splitter3.Color:= clnavy; Panel1.color := Sett.BackGndColour; Panel2.color := Sett.BackGndColour; Panel3.color := Sett.BackGndColour; Label1.Font.Color:= Sett.TextColour; Label2.Font.Color := Sett.TextColour; Memo1.Color:= Sett.BackGndColour; Memo1.Font.Color := Sett.TextColour; ButtonCancel.Color := Sett.HiColour; ButtonClose.Color := Sett.HiColour; ButtonSave.Color := Sett.HiColour; end; {$endif} // We call a timer to get out of OnShow so ProcessMessages works as expected LocalTimer := TTimer.Create(Nil); LocalTimer.OnTimer:= @AfterShown; LocalTimer.Interval:=500; LocalTimer.Enabled := True; end; function TFormSync.RunSyncHidden(): boolean; begin //debugln('In RunSyncHidden'); if SetUpSync then exit(False); // should never call this in setup mode but to be sure ... busy := true; ListViewReport.Clear; Result := ManualSync; end; procedure TFormSync.FormCreate(Sender: TObject); begin UserName := ''; Password := ''; end; // User is only allowed to press Close when this is finished. function TFormSync.ManualSync : boolean; var //SyncState : TSyncAvailable = SyncNotYet; //Notifier : TNotifier; SyncSummary : string; begin Label1.Caption := SyncTransportName(Transport) + ' ' + rsTestingSync; Application.ProcessMessages; ASync := TSync.Create; try ASync.ProceedFunction := @Proceed; ASync.ProgressProcedure := @SyncProgress; ASync.DebugMode := Application.HasOption('s', 'debug-sync'); ASync.NotesDir:= NoteDirectory; ASync.ConfigDir := LocalConfig; ASync.RepoAction:= RepoUse; ASync.Password := Sett.LabelToken.Caption; // better find a better way to do this Davo Async.UserName := Sett.EditUserName.text; Async.SetTransport(TransPort); if ASync.TestConnection() <> SyncReady then begin if ASync.DebugMode then debugln('Failed testConnection'); // in autosync mode, form is not visible, we just send a notify that cannot sync right now. if not Visible then begin SearchForm.UpdateStatusBar(rsAutoSyncNotPossible); if Sett.CheckNotifications.checked then begin {$ifdef linux} ShowNotification('tomboy-ng', rsAutoSyncNotPossible, 6000); (*Notifier := TNotifier.Create; // does not require a 'free'. Notifier.ShowTheMessage('tomboy-ng', rsAutoSyncNotPossible, 6000); *) // 12 seconds {$else} MainForm.TrayIcon.BalloonTitle := 'tomboy-ng'; Mainform.TrayIcon.BalloonHint := rsAutoSyncNotPossible; Mainform.TrayIcon.ShowBalloonHint; {$endif} end; exit; end else begin showmessage('Unable to sync because ' + ASync.ErrorString); FormSync.ModalResult := mrAbort; exit(false); end; exit(false); //redundant ? end; Label1.Caption := SyncTransportName(Transport) + ' ' + rsRunningSync; Application.ProcessMessages; ASync.TestRun := False; ASync.StartSync(); SyncSummary := DisplaySync(); SearchForm.UpdateStatusBar(rsLastSync + ' ' + FormatDateTime('YYYY-MM-DD hh:mm', now) + ' ' + SyncSummary); if (not Visible) and Sett.CheckNotifications.Checked then begin {$ifdef LINUX} ShowNotification('tomboy-ng', rsLastSync + ' ' + SyncSummary); (* Notifier := TNotifier.Create; // does not require a 'free'. Notifier.ShowTheMessage('tomboy-ng', rsLastSync + ' ' + SyncSummary, 3000); *) {$else} MainForm.TrayIcon.BalloonTitle := 'tomboy-ng'; Mainform.TrayIcon.BalloonHint := rsLastSync + ' ' + SyncSummary; Mainform.TrayIcon.ShowBalloonHint; {$endif} end; ShowReport(); AdjustNoteList(); // ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Label1.Caption := SyncTransportName(Transport) + ' ' + rsAllDone; Label2.Caption := rsPressClose; ButtonClose.Enabled := True; Result := True; finally FreeandNil(ASync); Busy := False; end; end; procedure TFormSync.AdjustNoteList(); var DeletedList, DownList : TStringList; Index : integer; begin DeletedList := TStringList.Create; DownList := TStringList.Create; with ASync.RemoteMetaData do begin for Index := 0 to Count -1 do begin if Items[Index]^.Action = SyDeleteLocal then DeletedList.Add(Items[Index]^.ID); if Items[Index]^.Action = SyDownload then DownList.Add(Items[Index]^.ID); end; end; if (DeletedList.Count > 0) or (DownList.Count > 0) then SearchForm.ProcessSyncUpdates(DeletedList, DownList); FreeandNil(DeletedList); FreeandNil(DownList); end; procedure TFormSync.AddLVItem(Act, Title, ID : string); var TheItem : TListItem; begin TheItem := ListViewReport.Items.Add; TheItem.Caption := Act; TheItem.SubItems.Add(copy(Title, 1, 25)+' '); TheItem.SubItems.Add(ID); end; procedure TFormSync.ShowReport; var Index : integer; Rows : integer = 0; begin with ASync.RemoteMetaData do begin for Index := 0 to Count -1 do begin if Items[Index]^.Action <> SyNothing then begin AddLVItem( ASync.RemoteMetaData.ActionName(Items[Index]^.Action) , Items[Index]^.Title , Items[Index]^.ID); inc(Rows); end; end end; if Rows = 0 then Memo1.Append(rsNoNotesNeededSync) else Memo1.Append(inttostr(ASync.RemoteMetaData.Count) + rsNotesWereDealt); if ASync.TransMode = SyncGitHub then begin Memo1.Append('Token expires : ' + ASync.TokenExpire); Sett.LabelToken.Hint := 'Expires ' + ASync.TokenExpire; end; {$IFDEF DARWIN} // Apparently ListView.columns[n].autosize does not work in Mac, this is rough but better then nothing. ListViewReport.Columns[0].Width := listviewReport.Canvas.Font.GetTextWidth('upload edit '); ListViewReport.Columns[1].Width := ListViewReport.Columns[0].Width *2; {$ENDIF} end; procedure TFormSync.ButtonCancelClick(Sender: TObject); begin ModalResult := mrCancel; end; procedure TFormSync.ButtonCloseClick(Sender: TObject); begin ModalResult := mrOK; end; // This only ever happens during a Join, RepoAction will still be 'join'. procedure TFormSync.ButtonSaveClick(Sender: TObject); begin Label2.Caption:=rsNextBitSlow; Label1.Caption := SyncTransportName(Transport) + ' ' + 'First Time Sync'; Memo1.Clear; ButtonCancel.Enabled := False; ButtonSave.Enabled := False; Application.ProcessMessages; ASync.TestRun := False; if ASync.StartSync() then begin SearchForm.UpdateStatusBar(rsLastSync + ' ' + FormatDateTime('YYYY-MM-DD hh:mm', now) + ' ' + DisplaySync()); ShowReport(); AdjustNoteList(); Label1.Caption := SyncTransportName(Transport) + ' ' + rsAllDone; Label2.Caption := rsPressClose; if ASync.TransMode = SyncGithub then begin Sett.LabelSyncRepo.Caption := ASync.GetTransRemoteAddress; // this relies on Sett being in Github mode, during a Join, should be .... Sett.LabelToken.Hint := 'Expires ' + ASync.TokenExpire; end; end else Showmessage(rsSyncError + ASync.ErrorString); ButtonClose.Enabled := True; end; end. tomboy-ng_0.34-1/source/resourcestr.pas0000644000175000017500000001676214145033507020016 0ustar dbannondbannonunit ResourceStr; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ An attempt to move all resource strings into one unit to facilate reuse where possible. Note that while arranged in blocks labeled with the unit that uses them, no reason to limit use to that. } {$mode objfpc}{$H+} interface uses Classes, SysUtils; RESOURCESTRING { to use replacable parameters, pass an array of parameters to format() rsString := 'you have %d pimples'; label1.caption := format(rsString, [Count]) } // notebook.pas rsMultipleNoteBooks = 'Settings allow multiple Notebooks'; rsOneNoteBook = 'Settings allow only one Notebook'; rsSetTheNotebooks = 'Set the notebooks this note is a member of'; rsChangeNameofNotebook = 'Change the name of this Notebook'; rsNumbNotesAffected = 'This will affect %d notes'; // %d replaced by integer, 0 to big number rsEnterNewNotebook = 'Enter a new notebook name please'; rsNotebookOptionRight = 'Right click for Notebook Options'; // Windows, Linux rsNotebookOptionCtrl = 'Ctrl click for Notebook Options'; // Mac rsAddNotesToNotebook = 'Add notes to this Notebook'; // SearchForm // these are main menu items and string grid headings - rsMenuNewNote = 'New Note'; rsMenuSearch = 'Search'; rsMenuAbout = 'About'; rsMenuSync = 'Synchronise'; rsMenuSettings = 'Settings'; rsMenuHelp = 'Help'; rsMenuQuit = 'Quit'; rsNotebooks = 'Notebooks'; rsName = 'Name'; rsLastChange = 'Last Change'; rsSetupNotesDirFirst = 'Please setup a notes directory first'; rsSetupSyncFirst = 'Please config sync system first'; rsCannotFindNote = 'ERROR, cannot find '; // is followed by a filename rsSearchHint = 'Exact matches for terms between " "'; // SyncGUI rsTestingSync = 'Testing Sync'; rsUnableToSync = 'Unable to sync because '; //rsUnableToSyncAuto = 'tomboy-ng is unable to do Auto Sync at the moment.' // mention tomboy-ng 'cos user may not be activly using tb when this pops up rsRunningSync = 'Running Sync'; rsAllDone = 'All Done'; rsPressClose = 'Press Close'; rsTestingRepo = 'Testing Repo ....'; rsCreateNewRepo = 'Create a new Repo ?'; rsUnableToProceed = 'Unable to proceed because'; rsLookingatNotes = 'Looking at notes ....'; rsSaveAndSync = 'Press Save and Sync if this looks OK'; rsSyncError = 'A Sync Error occurred'; rsLastSync = 'Last Sync'; // Followed by a date and simplified sync report rsFileSyncInfo1 = 'tomboy-ng uses File Sync to sync to eg DropBox, Google Drive, a USB drive'; rsFileSyncInfo2 = 'or uses a remote server over the internet with sshfs'; rsGithubSyncInfo1 = 'tomboy-ng can use Github to both sync and display or edit notes'; rsGithubSyncInfo2 = 'you should read the tomboy-ng wiki page for instructions.'; // Settings but only part ... //rsChangeNetSync = 'Change Net Sync Repo'; // These are labels on the button used to set sync repo rsChangeSync = 'Change Sync Repo'; rsSyncNotConfig = 'not configured'; // means that the file of net sync is not configured yet. rsSetUp = 'Setup'; // means configure something, eg, one of the Sync modules. rsAutosnapshotRun='Completed autosnapshot run.'; // Message on status bar after an AutoSnapshot run. rsSnapshotCreated = 'created, do you want to copy it elsewhere ?'; // refers to a just taken snapshot rsErrorCopyFile = 'Failed to copy file, does destination dir exist ?'; rsAutoSyncNotPossible = 'Auto sync not possible right now'; // Auto sync is configured but cannot proceed, probably because drive is not available // BackUpView rsNewerVersionExits = 'A newer version exists in main repo'; rsNotPresent = 'Not present in main repo'; rsCannotDelete = 'Cannot delete '; rsOverwriteNote = 'Overwrite newer version of that note'; rsNoteAlreadyInRepo = 'Note already in Repo'; rsNoteOpen = 'You have that note open, please close and try again'; rsCopyFailed = 'Copying orig to Backup directory failed'; rsRenameFailed = 'ERROR, could not rename Backup File '; rsRecoverOK = 'OK, File recovered.'; rsNotesDeleted = 'Note or notes deleted'; // CLI {$ifdef DARWIN} rsMacHelp1 = 'eg open tomboy-ng.app'; rsMacHelp2 = 'eg open tomboy-ng.app --args -o Note.txt|.note'; {$endif} rsHelpDelay = 'Delay startup 2 sec to allow OS to settle'; rsHelpLang = 'Force Language, supported en, es, fr, nl'; rsHelpDebug = 'Direct debug output to SOME.LOG.'; rsHelpHelp = 'Show this help message and exit.'; rsHelpVersion = 'Print version and exit'; //rsHelpRedHat = 'Deprecated'; // No longer important, rsHelpNoSplash = 'Do not show small status/splash window'; rsHelpDebugSync = 'Show debug messages during Sync'; rsHelpDebugIndex = 'Show debug msgs while indexing notes'; rsHelpDebugSpell = 'Show debug messages while spell setup'; rsHelpConfig = 'Create or use an alternative config'; rsHelpSingleNote = 'Open indicated note, switch is optional'; rsHelpSaveExit = 'After import single note, save & exit'; //rsHelpShiftAltF = 'Use Shift-Alt-F instead of Ctrl-Alt-F for Find Previous'; // Mainunit rsBadNotesFound1 = 'Please go to Settings -> Recover -> Recover Notes'; rsBadNotesFound2 = 'You should do so to ensure your notes are safe.'; rsFound = 'Found'; rsNotes = 'notes'; rsWARNNOSSYSTRAY = 'WARNING, your Desktop might not display SysTray'; // R E C O V E R unit rsClickSnapShot = 'Click an Available Snapshot'; rsWeHaveSnapShots = 'We have %d snapshots'; rsDeletedDamaged = 'OK, deleted %d damaged notes'; rsBadNotes = 'You have %d bad notes in Notes Directory'; rsClickBadNote = 'Double click on any Bad Notes'; // rsNoBadNotes = 'No errors, perhaps you should proceed to Snapshots'; rsTryRecover_1 = 'Try to recover a bad note by double clicking below,'; rsTryrecover_2 = 'if that fails, you may be able to recover it from a Snapshot.'; rsDeleteAndReplace_1 = 'Notes at risk !'; rsAllRestored = 'Notes and config files Restored, restart suggested.'; rsDeleteAndReplace_2 = 'Delete all notes in %s and replace with snapshot dated %s ?'; rsNotesInSnap = 'Notes in Snapshot'; // followed by the name of a snapshot // RollBack rsContentDated = 'Content Dated'; rsNotAvailable = 'Not Available'; rsRollBackIntro = 'You can roll back to previous version of this note'; // The soon to be merged NextCloud Notes Sync // EditBox - lots more to do .. rsFindNavRightHint = 'Find : F3 or Ctrl-G'; rsFindNavLeftHint = 'Backward Find : Shift-F3 or Shift-Ctrl-G'; rsFindNavRightHintMac = 'Find : Command-G'; rsFindNavLeftHintMac = 'Backward Find : Shift-Command-G'; // github sync - I would like to use some of these in other syncs too. rsGithubTokenExpired = 'Github Token may have expired'; rsTestingCredentials = 'Testing Credentials'; rsLookingServerID = 'Looking for ServerID'; rsScanRemote = 'Scanning remote files'; rsDownloadNotes = 'Downloading notes'; rsDownLoaded = 'Downloaded'; // followed by a number rsUpLoading = 'Uploading'; // followed by a number rsUpLoaded = 'Uploaded'; // followed by a number rsMetaDirWarning = 'Please remember that to ensure a reliable sync, you must not change files in the Meta directory.'; implementation end. tomboy-ng_0.34-1/source/editbox.pas0000644000175000017500000041503414145033507017067 0ustar dbannondbannonunit EditBox; { Copyright (C) 2017-2021 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } { This form represents one note being read or edited. It keeps its note in a KMemo component, its there using the native (ie GTK or Windows) display system. This form uses two other units, SaveNote and LoadNote that know about the Tomboy's XML format. As an important design target, we must be fully compatible with Tomboys format. And why not ? } { HISTORY 2017/9/26 - Added Locks around call to load a file into KMemo. Speed up from 14 sec to 82mS when loading greybox note. 20170928 - Made CheckforLinks maintain one copy of the Text to search instead of a new copy for each search term when MakeAllLinks() was doing it. CheckforLinks() now takes up 200 mS instead of 600mS for 20K Greybox note file. 20170928 A whole lot of changes around OnChange event to speed up the response time around links. 20171003 - Started Testing under Windows. Added a bit of code to MakeAllLink() to allow for the fact that windows has two characters as a line ending, CR/LF, #13#10. KMemo SelectionIndex code allows one char for a Paragraph. Linux/OSX being Unix are fine, one char newline. A bit of a tidy up. 20171005 - Fixed a bug where a new note did not get its file path from Settings. 20171005 - Fixed a bug where new note is not getting its title set properly, we now read the title of the note when saving, also pop it into the Caption at the same time. 20171005 - Complete rewrite of the AlterFont() procedure, this one works all the time ! 20171007 - Bullets, good on Windows, less than so on Unix 20171008 - Added right click popup menu and Cut, Copy, Paste, Select All but cannot cut o copy to work o Linux. Will try other platforms. Hmm, flaky on all three platforms. But seens to work OK in small test !!! 20171008 - Added a line in FormShow to set the default font, KMemo1.Font.Size:= Lets see if that works..... 20171010 - on upgrade to the e4ec.. late september ver of kC, Bullet issue gone ! This code here now has simplified and better working bullets 2017/10/15 - now call MainUnit.IndexNotes after saving. This behaviour needs to be moved to a seperate thread..... 2017/11/03 restructure CheckForLinks() and MakeAllLinks() because of UTF8 issues. Abandon completely the model of copy note text to a PChar and scanning that, will now rely on UTF8Pos() searching Kmemo1.Blocks.Text. Big change, watch .... 2017/11/05 Converted GetAFileName() to use GUID, sorry about that ! I think the old method produced usable names but was not in Tomboy style. Should be OK.... 2017/11/07 Fixes to CheckForLinks() and friends so it can again, handle the same link mentioned several times in a note. And remember, UTF8Pos() does not like being told to start at zero. Oh, yes, I remember, now! 2017/11/29 Issue #4, fixed AlterFont() and AlterBlockFont() so that when doing Bold, Italics, Coloured we toggle on the basis of first character, not the first character of each block. 2017/11/30 Issue #12. An new note created by user clicking Link in another note is now auto saved. And the selected text from the first note now becomes, immediatly a link. 2017/12/02 Little fix to AlterFont to ensure a selected bit of text remains selected after a font change. 2017/12/28 Added and then removed a ToDo, does not need to get pushed. 2017/01/08 Extensive changes to the way we handle backspace around Bullets. I like what it does now but need to test on Win/Mac .... 2017/01/08 This Unit now has a public variable, Verbose that will tell tales.... 2017/01/08 Added a test so we don't mess with backspace if there is some selected text. Mac users, bless them, don't have a delete key. They use a key labeled 'delete' thats really a backspace. 2017/01/09 Hmm, fixed a bug in new code that let BS code mess around in header. 2018/01/25 Changes to support Notebooks 2018/01/27 if playing in a bullet and there is not a trailing nonbullet para marker, thats bad, so I now auto add one. Thats case y - however its still not perfect, really should add a test to see if we overran text looking for an unfound para. 2018/01/29 Noted a crazy note that ended up with an empty hyperlink in title and that messed MarkTitle() so altered its test to now find first para marker rather than first non text block 2018/02/01 Lock KMemo1 before saving. Noted a very occasional crash when first saving a new note. 2018/02/04 Added some ifdef to suppress needless warnings 2018/02/09 Export as RTF and TXT, untested on mac + windows 2018/02/17 Moved housekeeping stuff in a method and now call that method from a timer, reset by user activity. Same with Save time too. Should speed things up. 2018/02/18 Minor correction to Ctrl-Shift-F shortcut 2018/03/03 Changes housekeeping timer from 4sec to 2sec - change in object inspector 2018/03/17 Lockupdate was applied to KMemo, not KMemo.Blocks, in ImportNote(), 800ms hit ! Related to Mac's need for for a paragraph 'kick' after loading. Changed CheckForLinks() so it keeps a single copy of KMemo.Blocks.Text for its complete run, passing it to MakeAllLinks() rather than creating a new copy each iteration. Appears to deliver a usefull speedup ! Test !! But must, apparently unlock before calling some other functions. 2018/03/18 Removed the add a para on opening at last ! 2018/04/07 A UTF8 correction in MakeAllLinks() to how we count the #13 in Windows. 2018/04/11 Replaced a loom and delchar() with setting selection and calling ClearSelection im MakeLink Added a function to deal with Delete menu selection. Restored selection properly after housekeeping. 2018/04/12 Added a function to set the KMemo to readonly (for when the Sync Process has replaced or deleted the on disk copy of this note). SetReadOnly(); 2018/04/13 Added calls to start Housekeeping and Save times when editing inside bullets ! 2018/04/13 Now call NotebookPick Form dynamically and ShowModal to ensure two notes don't share. 2018/05/02 Enabled untested code to print. 2018/05/03 Now put a * ahead of note name to indicate its unsaved. 2018/05/04 Use CleanCaption() when using Caption elsewhere. 2018/05/07 Bug in MarkDirty(), now always enable SaveTimer 2018/05/07 Added a paste command into FormShow() that appears to fix strange bug where the first copy (as in Copy and paste) fails. This is a nasty fudge, perhapse related to http://bugs.freepascal.org/view.php?id=28679 Linux only ? 2018/05/12 Extensive changes - MainUnit is now just that. 2018/05/16 Disable Print menu option in Cocoa. 2018/06/13 Drop copy on selection and add Ben's Underline, strikethrough and Fixedwidth ! 2018/06/13 Reinstate copy on selection, middle button click, Linux & (in app only) Windows only 2018/06/22 DRB added LoadSingleNote and related to do just that. Needs more testing. 2018/07/05 Changed MonospaceFont to 'Monaco' on the Mac, apparently universal... 2018/07/20 Force copy on selection paste to always paste to left of a newline. 2018/07/23 If a note has no title in content but does have one in xml, caption is left blank and that crashes things that look for * in first char. Fixed 2018/07/23 Fixed a bug that crashed when deleting a note in SingleNoteMode. 2018/08/18 Added ^F4 to quit. Prevented undefined ^keys being passed into Kmemo 2018/08/20 Above edit dropped ^X, ^C, ^V before kmemo sees them, fixed, refactored a bit 2019/08/22 Add a whole lot more keys that KMemo auto supports, see AddKey(...) in keditcommon.pas 2018/10/13 Kmemo1KeyDown now deals with a Tab. 2018/10/20 Added --save-exit, only in single note mode. 2018/10/28 Support Backup management, snapshots and new sync Model. 2018/11/29 Now check if Spell is configured before calling its GUI 2018/12/02 Change to Bullet code, now support ALT+RGHT and ALT+Left, now can toggle bullet mode 2018/12/03 Use command key instead of control on the Mac 2018/12/04 Links to other notes no longer case sensitive, a potential link needs to be surrounded by white-ish space 2018/12/05 Move highlight shortcut key on the Mac to Alt-H because Apple uses Cmd-H 2018/12/06 Drop all Ctrl Char on floor for the Mac. See if we are missing anything ? 2018/12/06 Added Ctrl 1, 2, 3, 4 as small, normal, large and huge fnt. ---- This is not put on menus or doced anywhere, an experiment ------ 2018/12/29 Small improvements in time to save a file. 2019/01/15 Added Calculator, Ctrl-E for evaluate. Need to truncate floats ..... 2019/01/16 Tidy up of float display 2019/01/17 Added tan() to list of functions in Calc, go public with Ctrl1,2,3,4 2019/01/19 Can tolerate, in places, an imageblock 2019/02/01 ButtLinkClick() now provides a template name iff current note is a Notebook Member. However, its the first notebook listed, if user has allowed multiple notebooks per note, maybe not what they want. Maybe a selection list ? 2019/02/12 Fixed UTF8 bug in MakeAllLinks(), a touch faster now too ! 2019/02/23 Bug in column calc - how this that slip through ? 2019/03/13 Better local search capability and go to first term if opening result of Search 2019/04/13 Lockupdate while setting whole note text colour. 2019/04/18 Replaced TBitBtns with Speedbuttons to fix memory leak in Cocoa 2019/04/29 Restore note's previous previous position and size. 2019/05/06 Support saving pos and open on startup in note. 2019/05/14 Display strings all (?) moved to resourcestrings 2019/06/12 Removed panel behind speedbuttons, Cocoa did not like them ! 2019/06/14 Ensure top of new window is never less than 10 pixels down. 2019/07/19 Test that a note is not being deleted before we update on exit. 2019/07/20 Cleaned up MarkTitle() and extended the range its used for. 2019/07/21 MarkTitle now uses Sett.* colours. 2019/07/25 Added menu item under tools to open Settings #93 (part) 2019/09/07 User can now select a note font. 2019/09/21 CleanUTF8 removes some bad UTF8 char when importing some RTF files. 2019/09/21 AdjustFormPosition() now enforces some minium position/size. Issue #103 2019/10/11 Enabling of printing under Cocoa 2019/11/30 Now support web links. 2019/12/11 Heavily restructured Startup, Main Menu everywhere ! 2019/12/17 Links are no longer converted to lower case. 2019/12/18 LinkScanRange moved here from Settings, now 100, was 50 2019/12/22 Extensive changes to ClearNearLink() to ensure links are not smeared. 2020/01/02 Enabled Ctrl-Shift left or right arrow selecting or extending selecton by word. 2020/01/07 Use SaveTheNote() even when existing app with a clean note, UpdateNote() not used now 2020/01/12 More agressive adjustmenst to form position at opening a note Windows and Mac only 2020/01/28 Do not call SearchForm.UpdateList() when we are closing a clean note. 2020/03/11 In FormDestroy, we always save, EXCEPT if in SingleNoteMode, then only if dirty. 2020/03/27 Don't save a new, unwritten to note, also prevent 2 saves on a Ctrl-F4 2020/03/27 Set a cleared highlight to correct background colour. No longer toggle when changing font sizes, set it to what user asks. 2020/04/01 Removed line that exited KMemo1KeyDown in readonly mode, prevented cursor keys working. 2020/04/04 Fix for when SingleNoteMode is pointed to a zero length file. 2020/05/12 Added Shift Click to select to click pos, #129 2020/05/23 Do not poke SingleNoteFileName in during create, get it from Mainunit in OnCreate() 2020/06/08 Disable main menu button in readonly mode. 2020/08/06 Call a paste in ShowForm, even in SNM, assertion is better than no copying. Display external links in single note mode. 2020/08/19 Fixed bug affecting end of weblink in single note mode. 2020/10/22 Small bug where title markup can be smeared down several lines. 2020/11/18 Added StayOnTop to Tools Popup Menu 2021/01/06 Pre-load find dialog with SearchBox SearchTerm, Alt-F for find next 2021/01/22 When activating a note from the search form, jump to first match is Term is not empty 2021/01/25 Replace FindDialog with statusbar like system. Need shortcut keys defined. 2021/01/27 Previous find is now Ctrl-Alt-F, next one is Alt-F 2021/01/29 Use TB_Utils/TB_MakeFileName when exporting 2021/01/31 Fix UTF8 issue in Find, check for hits in FindIt if NumbFindHits = 0 2021/02/03 Enter Key based search model, Ctrl-Enter and Alt-Enter 2021/02/05 Complete rewrite of Find in a way that also works for Windows. 2021/02/15 Use CommonMark when exporting Markdown 2021/02/17 Fix Mac only bug, not Ctrl to ssMeta F for the EditFind 2021/06/25 Replaced TUpDown with 2 speedbuttons 2021/07/06 Save now in separate thread, a few mS for medium note, 10mS for a big one 2021/07/08 Calc now defaults LHS if same numb tokens LHS and RHS 2021/07/11 SimpleCalc can now handle appearing after a text terminating '.' 2021/07/17 Pickup Ctrl-N from EditFind. 2021/07/31 Ensure a New Note appears middle of the screen. 2021/08/07 Fixed a race condition on export MD if dirty. 2021/08/07 Commented out some code in FormShow thats is unreachable ?? Filename and Template 2021/08/27 Consolidated all Text menu events through one method 2021/08/27 Can now edit multilevel bullets 2021/10/26 User selectable date stamp format, inc Bold } {$mode objfpc}{$H+} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Menus, StdCtrls, Buttons, kmemo, LazLogger, clipbrd, lcltype, ComCtrls, // required up here for copy on selection stuff. fpexprpars, // for calc stuff ; SaveNote, // Knows how to save a Note to disk in Tomboy's XML PrintersDlgs, TBUndo; // experimental .... type { TEditBoxForm } TEditBoxForm = class(TForm) ButtMainTBMenu: TSpeedButton; EditFind: TEdit; KMemo1: TKMemo; LabelFindCount: TLabel; LabelFindInfo: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; MenuBold: TMenuItem; MenuFindPrev: TMenuItem; MenuItalic: TMenuItem; MenuHighLight: TMenuItem; MenuHuge: TMenuItem; MenuItem1: TMenuItem; MenuFindNext: TMenuItem; MenuItemBulletRight: TMenuItem; MenuItemBulletLeft: TMenuItem; MenuItemFindPrev: TMenuItem; MenuStayOnTop: TMenuItem; MenuItemSettings: TMenuItem; MenuItemEvaluate: TMenuItem; MenuItemIndex: TMenuItem; MenuItemExportMarkdown: TMenuItem; MenuItemSpell: TMenuItem; MenuItemExportRTF: TMenuItem; MenuItemExportPlainText: TMenuItem; MenuItemPrint: TMenuItem; MenuItemSelectAll: TMenuItem; MenuItemDelete: TMenuItem; MenuItemPaste: TMenuItem; MenuItemCopy: TMenuItem; MenuItemFind: TMenuItem; MenuItem3: TMenuItem; MenuItemCut: TMenuItem; MenuItemSync: TMenuItem; MenuItemExport: TMenuItem; MenuSmall: TMenuItem; MenuItem2: TMenuItem; MenuNormal: TMenuItem; MenuLarge: TMenuItem; MenuFixedWidth: TMenuItem; MenuUnderline: TMenuItem; MenuStrikeout: TMenuItem; Panel1: TPanel; PanelFind: TPanel; PanelReadOnly: TPanel; PopupMainTBMenu: TPopupMenu; PopupMenuRightClick: TPopupMenu; PopupMenuTools: TPopupMenu; PopupMenuText: TPopupMenu; PrintDialog1: TPrintDialog; SpeedLeft: TSpeedButton; SpeedRight: TSpeedButton; SpeedButtonDelete: TSpeedButton; SpeedButtonLink: TSpeedButton; SpeedButtonNotebook: TSpeedButton; SpeedButtonSearch: TSpeedButton; SpeedButtonText: TSpeedButton; SpeedButtonTools: TSpeedButton; SpeedRollBack: TSpeedButton; TaskDialogDelete: TTaskDialog; TimerSave: TTimer; TimerHousekeeping: TTimer; procedure ButtMainTBMenuClick(Sender: TObject); procedure EditFindChange(Sender: TObject); procedure EditFindEnter(Sender: TObject); procedure EditFindExit(Sender: TObject); procedure EditFindKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure EditFindKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormActivate(Sender: TObject); procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormCloseQuery(Sender: TObject; var CanClose: boolean); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); { gets called under a number of conditions, easy one is just a re-show, or for a new note or a new note with a title from Link button or for an existing note where we get note file name or a new note from template where we have a note filename but IsTemplate also set, here we discard file name and make a new one. } procedure FormShow(Sender: TObject); procedure KMemo1Change(Sender: TObject); { Watchs for backspace affecting a bullet point, and whole lot of ctrl, shift, alt combinations. For things we let KMemo handle, just exit, for things we handle must set key to 0 after doing so. } procedure KMemo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure KMemo1KeyPress(Sender: TObject; var Key: char); procedure KMemo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure KMemo1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure KMemo1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); // All the Text menu items go through this event procedure MenuTextGeneralClick(Sender: TObject); procedure MenuFindPrevClick(Sender: TObject); procedure MenuFindNextClick(Sender: TObject); procedure MenuItemEvaluateClick(Sender: TObject); procedure MenuItemExportMarkdownClick(Sender: TObject); procedure MenuItemIndexClick(Sender: TObject); procedure MenuItemSettingsClick(Sender: TObject); procedure MenuStayOnTopClick(Sender: TObject); procedure MenuItemCopyClick(Sender: TObject); procedure MenuItemCutClick(Sender: TObject); procedure MenuItemDeleteClick(Sender: TObject); procedure MenuItemExportPlainTextClick(Sender: TObject); procedure MenuItemExportRTFClick(Sender: TObject); // This is a landing spot for either Find menu click or Ctrl-G procedure MenuItemFindClick(Sender: TObject); procedure MenuItemPasteClick(Sender: TObject); procedure MenuItemPrintClick(Sender: TObject); procedure MenuItemSelectAllClick(Sender: TObject); procedure MenuItemSpellClick(Sender: TObject); procedure MenuItemSyncClick(Sender: TObject); procedure PanelFindEnter(Sender: TObject); procedure SpeedLeftClick(Sender: TObject); procedure SpeedRightClick(Sender: TObject); procedure SpeedRollBackClick(Sender: TObject); procedure SpeedButtonDeleteClick(Sender: TObject); procedure SpeedButtonLinkClick(Sender: TObject); procedure SpeedButtonNotebookClick(Sender: TObject); procedure SpeedButtonSearchClick(Sender: TObject); procedure SpeedButtonTextClick(Sender: TObject); procedure SpeedButtonToolsClick(Sender: TObject); procedure TimerSaveTimer(Sender: TObject); procedure TimerHousekeepingTimer(Sender: TObject); private NumbFindHits : integer; Use_Undoer : boolean; // We allow user to disable Undo system, ONLY set during create. Undoer : TUndo_Redo; TitleHasChanged : boolean; // a record of the cursor position before last click, used by shift click to select MouseDownPos : integer; CreateDate : string; // Will be '' if new note // CtrlKeyDown : boolean; Ready : boolean; // LastFind : longint; // Used in Find functions. // FontName : string; // Set in OnShow, const after that ??? // FontNormal : integer; // as above { To save us checking the title if user is well beyond it } BlocksInTitle : integer; // Set True by the delete button so we don't try and save it. DeletingThisNote : boolean; procedure AdjustFormPosition(); { Alters the Font of Block as indicated } procedure AlterBlockFont(const FirstBlockNo, BlockNo: longint; const Command: integer; const NewFontSize: integer=0); { Alters the font etc of selected area as indicated } procedure AlterFont(const Command : integer; const NewFontSize: integer = 0); { If Toggle is true, sets bullets to what its currently no. Otherwise sets to TurnOn} procedure BulletControl(const Toggle, TurnOn: boolean); { Looks between StartS and EndS, marking any http link. Byte, not char indexes. A weblink has leading and trailing whitespace, starts with http:// or https:// and has a dot and char after the dot. We expect kmemo1 is locked at this stage.} procedure CheckForHTTP(const PText: pchar; const StartS, EndS: longint); procedure CleanUTF8(); function ColumnCalculate(out AStr: string): boolean; function ComplexCalculate(out AStr: string): boolean; procedure ExprTan(var Result: TFPExpressionResult; const Args: TExprParameterArray); { Locates if it can Term and selects it. Ret False if not found. Uses regional var, LastFind to start its search from, set to 0 for new search If not found, returns to last found one if it exists. So, if going forward, we'd go back one. If going back, we'd go one forward, assuming in both cases there was at least one 'Find'. } function FindIt(Term: string; StartAt: integer; GoForward, CaseSensitive: boolean): boolean; function FindNumbersInString(AStr: string; out AtStart, AtEnd: string): boolean; {function GetFindHits(Term: string; CaseSensitive: boolean; HitPos: integer=0; TextString: pchar=nil): integer;} // function GetFindKeyHint(): string; procedure InsertDate(); //function MakeFileName(const Candidate: string): string; function ParagraphTextTrunc(): string; function RelativePos(const Term: ANSIString; const MText: PChar; StartAt: integer): integer; function PreviousParagraphText(const Backby: integer): string; // This method will, at some stage, return after creating and starting // a thread that normalises the xml in the list, adds footer and saves. // The thread keeps going after the method returns doing above and then // free-ing the List. function SaveStringList(const SL: TStringList; Loc: TNoteUpdateRec): boolean; function SimpleCalculate(out AStr: string): boolean; // procedure CancelBullet(const BlockNo: longint; const UnderBullet: boolean); procedure ClearLinks(const StartScan : longint =0; EndScan : longint = 0); { Looks around current block looking for link blocks. If invalid, 'unlinks' them. Http or local links, we need to clear the colour and underline of any text nearby that have been 'smeared' from user editing at the end of a link. When this happens, new text appears within the link block, bad ..... } procedure ClearNearLink(const StartS, EndS: integer); function DoCalculate(CalcStr: string): string; procedure DoHousekeeping(); { Returns a UUID suitable for a file name } function GetAFilename() : ANSIString; procedure CheckForLinks(const StartScan : longint = 1; EndScan : longint = 0); { Returns with the title, that is the first line of note, returns False if title is empty } function GetTitle(out TheTitle: ANSIString): boolean; procedure ImportNote(FileName : string); procedure InitiateCalc(); { Test the note to see if its Tomboy XML, RTF or Text. Ret .T. if its a new note. } function LoadSingleNote() : boolean; { Searches for all occurances of Term in the KMemo text, makes them Links Does not bother with single char terms. Expects KMemo1 to be already locked.} procedure MakeAllLinks(const PText: PChar; const Term: ANSIString; const StartScan: longint=1; EndScan: longint=0); { Makes a link at passed position as long as it does not span beyond a block. And if it does span beyond one block, I let that go through to the keeper. Making a Hyperlink, deleting the origional text is a very slow process so we make heroic efforts to avoid having to do so. Index is char count, not byte. Its a SelectionIndex. Note we no longer need pass this p the Link, remove ? } procedure MakeLink(const Index, Len: longint); { Makes sure the first (and only the first) line is marked as Title Title should be Blue, Underlined and FontTitle big. Note that when a new note is loaded from disk, this function is not called, the Load unit knows how to do it itself. Saves 200ms with a big (20K) note. } procedure MarkTitle(); { Returns true if current cursor is 'near' a bullet item. That could be because we are on a Para Marker thats a Bullet and/or either Leading or Trailing Para is a Bullet. We return with IsFirstChar true if we are on the first visible char of a line (not necessarily a bullet line). If we return FALSE, passed parameters may not be set. } function NearABulletPoint(out Leading, Under, Trailing, IsFirstChar, NoBulletPara: Boolean; out BlockNo, TrailOffset, LeadOffset: longint): boolean; { Responds when user clicks on a hyperlink } procedure OnUserClickLink(sender: TObject); { A method called by this or other apps to get what we might have selected } procedure PrimaryCopy(const RequestedFormatID: TClipboardFormat; Data: TStream); { Pastes into KMemo whatever is returned by the PrimarySelection system. } procedure PrimaryPaste(SelIndex: integer); { Return a string with a title for new note "New Note 2018-01-24 14:46.11" } function NewNoteTitle() : ANSIString; { Saves the note as text or rtf, consulting user about path and file name } procedure SaveNoteAs(TheExt: string); procedure MarkDirty(); function CleanCaption() : ANSIString; procedure SetBullet(PB: TKMemoParagraph; Bullet: boolean); // Advises other apps we can do middle button paste procedure SetPrimarySelection; // Cancels any indication we can do middle button paste 'cos nothing is selected procedure UnsetPrimarySelection; function UpdateNote(NRec: TNoteUpdaterec): boolean; public // Set by the calling process. FFN inc path // Carefull, cli has a real global version SingleNoteFileName : string; SingleNoteMode : Boolean; NoteFileName : string; // Will contain the full note name, path, ID and .note NoteTitle : string; // only used during initial opening stage ? Dirty : boolean; Verbose : boolean; SearchedTerm : string; // If not empty, opening is associated with a search, go straight there. // If a new note is a member of Notebook, this holds notebook name until first save. TemplateIs : AnsiString; { Will mark this note as ReadOnly and not to be saved because the Sync Process has either replaced or deleted this note OR we are using it as an internal viewer. Can still read and copy content. Viewer users don't need big ugly yellow warning} procedure SetReadOnly(ShowWarning : Boolean = True); // Public: Call on a already open note if user has followed up a search with a double click procedure NewFind(Term: string); { Saves the note in KMemo1, must have title but can make up a file name if needed If filename is invalid, bad GUID, asks user if they want to change it (they do !) WeAreClosing indicates that the whole application is closing (not just this note) We always save the note on FormDestroy or application exit, even if not dirty to update the position and OOS data. We used to call UpdateNote in the hope its quicker but it forgets to record notebook membership. Revist some day ....} procedure SaveTheNote(WeAreClosing: boolean=False); end; Type { TSaveThread } TSaveThread = class(TThread) private //fStatusText : string; //procedure ShowStatus; protected procedure Execute; override; public TheSL : TStringList; TheLoc : TNoteUpdateRec; // defined in SaveNote Constructor Create(CreateSuspended : boolean); end; var EditBoxForm: TEditBoxForm; BusySaving : boolean; // Indicates that the thread that saves the note has not, yet exited. implementation {$R *.lfm} { TEditBoxForm } uses LazUTF8, //LCLType, // For the MessageBox keditcommon, // Holds some editing defines settings, // User settings and some defines used across units. SearchUnit, // Is the main starting unit and the search tool. LoadNote, // Will know how to load a Tomboy formatted note. LazFileUtils, // For ExtractFileName() RollBack, // RollBack form Spelling, NoteBook, MainUnit, // Not needed now for anything other than MainForm.Close() // SyncUtils, // Just for IDLooksOK() K_Prn, // Custom print unit. commonmark, //Markdown, Index, // An Index of current note. math, FileUtil, strutils, // just for ExtractSimplePath ... ~#1620 LCLIntf, // OpenUrl() TB_Utils, ResourceStr, // We borrow some search related strings from searchform bufstream, notenormal; // makes the XML look a little prettier const LinkScanRange = 100; // when the user changes a Note, we search +/- around // this value for any links that need adjusting. { ============= T S A V E T H R E A D ================== } procedure TSaveThread.Execute; var Normaliser : TNoteNormaliser; WBufStream : TWriteBufStream; FileStream : TFileStream; begin Normaliser := TNoteNormaliser.Create; Normaliser.NormaliseList(TheSL); Normaliser.Free; TheSL.Add(Footer(TheLoc)); // TWriteBufStream, TFileStream preferable to BufferedFileStream because of a lighter memory load. FileStream := TFileStream.Create(TheLoc.FFName, fmCreate); //FileStream := TFileStream.Create('/home/dbannon/savethread.note', fmCreate); WBufStream := TWriteBufStream.Create(FileStream, 4096); // 4K seems about right on Linux. try try TheSL.SaveToStream(WBufStream); except on E:Exception do begin Debugln('ERROR, failed to save note : ' + E.Message); WBufStream.Free; FileStream.Free; TheSL.Free; end; end; finally WBufStream.Free; FileStream.Free; TheSL.Free; end; BusySaving := False; end; constructor TSaveThread.Create(CreateSuspended: boolean); begin inherited Create(CreateSuspended); FreeOnTerminate := True; end; { ========== U S E R C L I C K F U N C T I O N S ========= } procedure TEditBoxForm.SpeedButtonTextClick(Sender: TObject); begin PopupMenuText.PopUp; end; procedure TEditBoxForm.SpeedButtonToolsClick(Sender: TObject); begin PopupMenuTools.PopUp; end; procedure TEditBoxForm.SpeedButtonSearchClick(Sender: TObject); begin SearchForm.Show; end; procedure TEditBoxForm.SpeedButtonDeleteClick(Sender: TObject); var St : string; begin if KMemo1.ReadOnly then exit(); St := CleanCaption(); if IDYES = Application.MessageBox('Delete this Note', PChar(St), MB_ICONQUESTION + MB_YESNO) then begin TimerSave.Enabled := False; if SingleNoteMode then DeleteFileUTF8(NoteFileName) else if NoteFileName <> '' then SearchForm.DeleteNote(NoteFileName); Dirty := False; DeletingThisNote := True; Close; end; end; procedure TEditBoxForm.SpeedButtonLinkClick(Sender: TObject); var ThisTitle : ANSIString; Index : integer; SL : TStringList; begin if KMemo1.ReadOnly then exit(); if KMemo1.Blocks.RealSelLength > 1 then begin ThisTitle := KMemo1.SelText; // Titles must not start or end with space or contain low characters while ThisTitle[1] = ' ' do UTF8Delete(ThisTitle, 1, 1); while ThisTitle[UTF8Length(ThisTitle)] = ' ' do UTF8Delete(ThisTitle, UTF8Length(ThisTitle), 1); Index := Length(ThisTitle); While Index > 0 do begin if ThisTitle[Index] < ' ' then delete(ThisTitle, Index, 1); dec(Index); end; // showmessage('[' + KMemo1.SelText +']' + LineEnding + '[' + ThisTitle + ']' ); if UTF8Length(ThisTitle) > 1 then begin SL := TStringList.Create; SearchForm.NoteLister.GetNotebooks(SL, ExtractFileNameOnly(NoteFileName)); // that should be just ID if SL.Count > 0 then SearchForm.OpenNote(ThisTitle, '', SL.Strings[0]) else SearchForm.OpenNote(ThisTitle); KMemo1Change(self); SL.Free; end; end; end; procedure TEditBoxForm.SpeedButtonNotebookClick(Sender: TObject); var NotebookPick : TNotebookPick; begin // if its a new note that has been created from a template, then if the user looks at notebook list // here, before its saved, he does not see the notebook listed. So, we force a save to avoid confusion. // SaveTheNote() will clear the templateIS field when it does its stuff. if TemplateIs <> '' then SaveTheNote(); NotebookPick := TNotebookPick.Create(Application); NotebookPick.TheMode := nbSetNoteBooks; NotebookPick.FullFileName := NoteFileName; NotebookPick.Title := NoteTitle; NotebookPick.ChangeMode := False; NotebookPick.Top := Top; NotebookPick.Left := Left; if mrOK = NotebookPick.ShowModal then MarkDirty(); NotebookPick.Free; end; procedure TEditBoxForm.SpeedRollBackClick(Sender: TObject); begin if FormRollBack.Visible then exit; // Must not open model twice ! SaveTheNote(); FormRollBack.Left := left; FormRollBack.Top := top; FormRollBack.NoteFileName := NoteFileName; FormRollBack.ShownBy := self; FormRollBack.ShowModal; end; procedure TEditBoxForm.BulletControl(const Toggle, TurnOn : boolean); var BlockNo : longint = 1; LastBlock, Blar : longint; BulletOn : boolean = false; FirstPass : boolean = True; begin if not Toggle then begin // We'll set it all to TurnOn FirstPass := False; // So its not changed BulletOn := not TurnOn; end; if KMemo1.ReadOnly then exit(); MarkDirty(); BlockNo := Kmemo1.Blocks.IndexToBlockIndex(KMemo1.RealSelStart, Blar); LastBlock := Kmemo1.Blocks.IndexToBlockIndex(KMemo1.RealSelEnd, Blar); if (BlockNo = LastBlock) and (BlockNo > 1) and KMemo1.Blocks.Items[BlockNo].ClassNameIs('TKMemoParagraph') then begin dec(LastBlock); dec(BlockNo); end; // Don't change any trailing empty lines. while KMemo1.Blocks.Items[LastBlock].ClassNameIs('TKMemoParagraph') do if LastBlock > BlockNo then dec(LastBlock) else break; // OK, we are now in a TextBlock, possibly both start and end there. Must mark // next para as numb and then all subsquent ones until we do the one after end. repeat inc(BlockNo); if BlockNo >= Kmemo1.Blocks.count then // no para after block (yet) Kmemo1.Blocks.AddParagraph(); if KMemo1.Blocks.Items[BlockNo].ClassNameIs('TKMemoParagraph') then begin if FirstPass then begin FirstPass := False; BulletOn := (TKMemoParagraph(KMemo1.Blocks.Items[BlockNo]).Numbering = pnuBullets); end; SetBullet(TKMemoParagraph(KMemo1.Blocks.Items[BlockNo]), not BulletOn); // TKMemoParagraph(KMemo1.Blocks.Items[BlockNo]).Numbering := pnuBullets; end; until (BlockNo > LastBlock) and KMemo1.Blocks.Items[BlockNo].ClassNameIs('TKMemoParagraph'); end; procedure TEditBoxForm.KMemo1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin MouseDownPos := KMemo1.CaretPos; // regional record in case we are doing shift click //debugln('Mousedown ' + dbgs(KMemo1.CaretPos)); //{$ifdef LCLCOCOA} if ssCtrl in Shift then PopupMenuRightClick.popup; //{$else} if Button = mbRight then PopupMenuRightClick.PopUp; //{$endif} end; // ------------------ COPY ON SELECTION METHODS for LINUX and Windows ------ procedure TEditBoxForm.KMemo1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); {$IFNDEF DARWIN} // Mac cannot do Primary Paste, ie XWindows Paste var Point : TPoint; LinePos : TKmemoLinePosition; {$endif} begin {$IFNDEF DARWIN} if Button = mbMiddle then begin Point := TPoint.Create(X, Y); // X and Y are pixels, not char positions ! LinePos := eolEnd; while X > 0 do begin // we might be right of the eol marker. KMemo1.PointToIndex(Point, true, true, LinePos); if LinePos = eolInside then break; dec(Point.X); end; PrimaryPaste(KMemo1.PointToIndex(Point, true, true, LinePos)); exit(); end; if KMemo1.SelAvail and (Kmemo1.Blocks.SelLength <> 0) then SetPrimarySelection() else UnsetPrimarySelection(); {$endif} if (Button = mbLeft) and ([ssShift] = Shift) then begin //debugln('Start ' + dbgs(MouseDownPos) + ' to ' + dbgs(KMemo1.CaretPos)); KMemo1.SelStart := MouseDownPos; KMemo1.SelEnd := KMemo1.CaretPos; end; end; procedure TEditBoxForm.SetPrimarySelection; var FormatList: Array [0..1] of TClipboardFormat; begin if (PrimarySelection.OnRequest=@PrimaryCopy) then exit; FormatList[0] := CF_TEXT; try PrimarySelection.SetSupportedFormats(1, @FormatList[0]); PrimarySelection.OnRequest:=@PrimaryCopy; except end; end; procedure TEditBoxForm.UnsetPrimarySelection; begin if PrimarySelection.OnRequest=@PrimaryCopy then PrimarySelection.OnRequest:=nil; end; procedure TEditBoxForm.PrimaryCopy( const RequestedFormatID: TClipboardFormat; Data: TStream); var s : string; begin S := KMemo1.Blocks.SelText; if RequestedFormatID = CF_TEXT then if length(S) > 0 then Data.Write(s[1],length(s)); end; procedure TEditBoxForm.PrimaryPaste(SelIndex : integer); var Buff : string; begin // A primary paste will always have new content, never overwrites anything. if PrimarySelection.HasFormat(CF_TEXT) then begin // I don't know if this is useful at all. Buff := PrimarySelection().AsText; if Buff <> '' then begin Undoer.AddTextInsert(SelIndex, Buff); KMemo1.Blocks.InsertPlainText(SelIndex, Buff); KMemo1.SelStart := SelIndex; Kmemo1.SelEnd := SelIndex + length(Buff); end; end; end; { we insert datestring at selstart and optionall mark it small / italics } procedure TEditBoxForm.InsertDate(); var I : integer; Buff : string; begin Buff := TB_DateStamp(Sett.ComboDateFormat.ItemIndex); Undoer.AddTextInsert(KMemo1.Blocks.SelStart, Buff); KMemo1.ExecuteCommand(ecInsertString, pchar(Buff)); if Sett.CheckStampItalics.checked or sett.CheckStampSmall.Checked then begin KMemo1.SelStart := Kmemo1.SelStart + 1; KMemo1.Sellength := Buff.Length-2; // we do not want to get the spaces. if Sett.CheckStampItalics.checked then AlterFont(3); if Sett.CheckStampBold.checked then AlterFont(2); if Sett.CheckStampSmall.checked then AlterFont(1, Sett.FontSmall); KMemo1.SelStart := Kmemo1.SelStart -1 + Buff.Length; KMemo1.Sellength := 0; end else for I := 0 to Buff.Length-1 do KMemo1.ExecuteCommand(ecRight); // move cursor end; { -------------- U S E R F O N T C H A N G E S ----------------} const ChangeSize = 1; // Used by AlterFont(..) and its friends. ChangeBold = 2; ChangeItalic = 3; ChangeColor = 4; ChangeFixedWidth = 5; ChangeStrikeout = 6; ChangeUnderline = 7; { This function will set font size, Bold or Italic or Color depending on the constant passed as first parameter. NewFontSize is ignored (and can be ommitted) if Command is ChangeBold or ChangeItalic, then toggle. If the function finds that the first char of selection already has that attribute it negates it, ie size becomes normal or no bold, no italics. It has to deal with several possible combinations and does so in three parts - 1. Dealing with what happens around the SelStart. Possibly splitting once or twice 2. Dealing with any complete blocks between start and end. 3. Dealing with the stuff around the end. If its not already been done by 1. The actual Commands are defined above and are not used outside this unit. Consider possible ways this function can be called - a. With selstart at first char in a block, Selend at end of same block. b. Selstart at other than first char, selend at end of same block. c. Selstart after first char and selend before last char of same block. d, e, f. as above but spanning blocks. a. & d. Require no splitting. Just apply change to block or blocks. b. & e. Needs one split. Split at SelStart and Apply to new and subsquent if any. c. & f. Needs two splits. Split at SelStar and SelEnd-1, then as above. So, decide what blocks we apply to, then apply. Sounds easy. AlterFont() is the entry point, it identifies and, if necessary splits blocks and calls AlterBlockFont() to do the changes, block by block. The decision as to turning [Colour,Bold,Italics] on or off SHOULD be made in AlterFont based on first char of selection and passed to AlterBlockFont. } procedure TEditBoxForm.AlterFont(const Command : integer; const NewFontSize : integer = 0); var FirstBlockNo, LastBlockNo, IntIndex, LastChar, FirstChar : longint; SplitStart : boolean = false; begin if KMemo1.ReadOnly then exit(); if Use_Undoer then Undoer.RecordInitial(0); Ready := False; MarkDirty(); LastChar := Kmemo1.RealSelEnd; // SelEnd points to first non-selected char FirstChar := KMemo1.RealSelStart; FirstBlockNo := Kmemo1.Blocks.IndexToBlockIndex(FirstChar, IntIndex); if IntIndex <> 0 then // Not Starting on block boundary. SplitStart := True; LastBlockNo := Kmemo1.Blocks.IndexToBlockIndex(LastChar, IntIndex); if IntIndex <> (length(Kmemo1.Blocks.Items[LastBlockNo].Text) -1) then // Not Last char in block LastBlockNo := KMemo1.SplitAt(LastChar) -1; // we want whats before the split. while LastBlockNo > FirstBlockNo do begin AlterBlockFont(FirstBlockNo, LastBlockNo, Command, NewFontSize); dec(LastBlockNo); end; // Now, only First Block to deal with if SplitStart then FirstBlockNo := KMemo1.SplitAt(FirstChar); AlterBlockFont(FirstBlockNo, FirstBlockNo, Command, NewFontSize); KMemo1.SelEnd := LastChar; // Any splitting above seems to subtly alter SelEnd, reset. KMemo1.SelStart := FirstChar; if Use_Undoer then Undoer.AddMarkup(); Ready := True; end; { Takes a Block number and applies changes to that block } procedure TEditBoxForm.AlterBlockFont(const FirstBlockNo, BlockNo : longint; const Command : integer; const NewFontSize : integer = 0); var Block, FirstBlock : TKMemoTextBlock; begin FirstBlock := TKMemoTextBlock(KMemo1.Blocks.Items[FirstBlockNo]); Block := TKMemoTextBlock(KMemo1.Blocks.Items[BlockNo]); if (Command = ChangeSize) and (NewFontSize = Sett.FontNormal) then begin // Don't toggle, just set to FontNormal Block.TextStyle.Font.Size := Sett.FontNormal; exit(); end; case Command of {ChangeSize : if Block.TextStyle.Font.Size = NewFontSize then begin Block.TextStyle.Font.Size := Sett.FontNormal; end else begin Block.TextStyle.Font.Size := NewFontSize; end; } ChangeSize : Block.TextStyle.Font.Size := NewFontSize; ChangeBold : if fsBold in FirstBlock.TextStyle.Font.style then begin Block.TextStyle.Font.Style := Block.TextStyle.Font.Style - [fsBold]; end else begin Block.TextStyle.Font.Style := Block.TextStyle.Font.Style + [fsBold]; end; ChangeItalic : if fsItalic in FirstBlock.TextStyle.Font.style then begin Block.TextStyle.Font.Style := Block.TextStyle.Font.Style - [fsItalic]; end else begin Block.TextStyle.Font.Style := Block.TextStyle.Font.Style + [fsItalic]; end; ChangeFixedWidth : if FirstBlock.TextStyle.Font.Name <> Sett.FixedFont then begin Block.TextStyle.Font.Pitch := fpFixed; Block.TextStyle.Font.Name := Sett.FixedFont; end else begin Block.TextStyle.Font.Pitch := fpVariable; Block.TextStyle.Font.Name := Sett.UsualFont; end; ChangeStrikeout : if fsStrikeout in FirstBlock.TextStyle.Font.style then begin Block.TextStyle.Font.Style := Block.TextStyle.Font.Style - [fsStrikeout]; end else begin Block.TextStyle.Font.Style := Block.TextStyle.Font.Style + [fsStrikeout]; end; ChangeUnderline : if fsUnderline in FirstBlock.TextStyle.Font.style then begin Block.TextStyle.Font.Style := Block.TextStyle.Font.Style - [fsUnderline]; end else begin Block.TextStyle.Font.Style := Block.TextStyle.Font.Style + [fsUnderline]; end; ChangeColor : if FirstBlock.TextStyle.Brush.Color <> Sett.HiColour then begin Block.TextStyle.Brush.Color := Sett.HiColour; end else begin Block.TextStyle.Brush.Color := Sett.BackGndColour; { clDefault; } end; end; end; // A method for responding to all text menu clicks. Could extend it to whole lot more ... procedure TEditBoxForm.MenuTextGeneralClick(Sender: TObject); begin case TMenuItem(sender).Name of 'MenuItemBulletRight' : BulletControl(false, True); 'MenuItemBulletLeft' : BulletControl(false, False); 'MenuHighLight' : AlterFont(ChangeColor); 'MenuLarge' : AlterFont(ChangeSize, Sett.FontLarge); // Note, fonts won't toggle ! 'MenuNormal' : AlterFont(ChangeSize, Sett.FontNormal); 'MenuSmall' : AlterFont(ChangeSize, Sett.FontSmall); 'MenuHuge' : AlterFont(ChangeSize, Sett.FontHuge); 'MenuBold' : AlterFont(ChangeBold); 'MenuItalic' : AlterFont(ChangeItalic); 'MenuUnderline' : AlterFont(ChangeUnderline); 'MenuStrikeout' : AlterFont(ChangeStrikeout); 'MenuFixedWidth' : AlterFont(ChangeFixedWidth); end; end; procedure TEditBoxForm.PanelFindEnter(Sender: TObject); begin EditFind.SetFocus; end; procedure TEditBoxForm.MenuItemEvaluateClick(Sender: TObject); begin InitiateCalc(); end; procedure TEditBoxForm.MenuItemIndexClick(Sender: TObject); var IForm : TFormIndex; begin IForm := TFormIndex.Create(Self); IForm.ModalResult := mrNone; IForm.TheKMemo := KMemo1; IForm.Left := Left; IForm.Top := Top; //debugln('EditBox, MenuItemIndexClick - about to show Index List'); IForm.ShowModal; if IForm.SelectedBlock >= 0 then begin KMemo1.SelStart := KMemo1.Blocks.BlockToIndex(KMemo1.Blocks.Items[IForm.SelectedBlock]); KMemo1.SelLength := 0; end; IForm.Free; //debugln('EditBox, MenuItemIndexClick - freed Index List'); KMemo1.SetFocus; end; procedure TEditBoxForm.MenuItemSettingsClick(Sender: TObject); begin Sett.show; end; procedure TEditBoxForm.MenuStayOnTopClick(Sender: TObject); begin if MenuStayOnTop.Checked then begin FormStyle := fsNormal; MenuStayOnTop.Checked := false; end else begin FormStyle := fsSystemStayOnTop; MenuStayOnTop.Checked := true; end; end; procedure TEditBoxForm.FormActivate(Sender: TObject); begin if Ready then begin // just possible that a new note was created, check for its link. if KMemo1.Blocks.RealSelLength > 1 then begin //debugln('OnActivate 1, checking for new link, [' + KMemo1.Blocks.SelText + ']'); CheckForLinks(KMemo1.Blocks.RealSelStart, KMemo1.Blocks.RealSelEnd); //debugln('OnActivate 2, checking for new link, [' + KMemo1.Blocks.SelText + ']'); // ToDo : CheckForLinks clears any preexisting selection, should we restore ? end; end; // should we only do this the first time through ? if SingleNoteMode then begin SpeedbuttonSearch.Enabled := False; SpeedButtonLink.Enabled := False; MenuItemSync.Enabled := False; SpeedButtonNotebook.Enabled := False; end; end; // --------------------- LOCAL F I N D M E T H O D S ------------------------- { Overview of local find process (local is note is 'Find', Searching all notes is 'Seach') : Works when the PanelFind is visible or not, gets called at note open if a search is underway. } // Call to start searching at an existing position (usually cursor). // Note that StartAt arrives here as a (utf8) char index, not a byte index. function TEditBoxForm.FindIt(Term : string; StartAt : integer; GoForward, CaseSensitive : boolean) : boolean; var NewPos : integer = 0; // Ptr : PChar; CleanSt : string = ''; {$ifdef WINDOWS} len, I : integer; TempString : string;{$endif} //Tick, Tock : qword; procedure GetFindHits(HitPos : integer = 0); var APos : integer = 0; // AString : string; HitsFound : integer = 1; begin // Assumes both Term and the Text data will have been uppercased if necessary if (HitPos = 0) and (NumbFindHits <> 0) then begin debugln('TEditBoxForm.FindIt - ERROR, Expected NumbFindHits to be zero'); showmessage('TEditBoxForm.FindIt - ERROR, Expected NumbFindHits to be zero'); end; APos := PosEx(Term, CleanSt, APos+1); //Tick := gettickcount64(); while APos > 0 do begin // 1mS on Linux, Very Big test Note, first run if ((HitPos > 0) and (HitPos < APos)) then break; inc(HitsFound); APos := PosEx(Term, CleanSt, APos+1); end; //Tock := gettickcount64(); //debugln('TEditBoxForm.FindIt - Total Hit Find = ' + inttostr(Tock - Tick) + 'mS'); if HitPos > 0 then LabelFindCount.Caption := HitsFound.ToString + '/' + NumbFindHits.ToString() else begin dec(HitsFound); // allow for initial state of 1 NumbFindHits := HitsFound; // regional var, set to zero in UpDownControl if new Find term if HitsFound = 0 then LabelFindCount.Caption := ''; // not sure if we need that end; end; function JumpToItem() : boolean; begin if GoForward then NewPos := PosEx(Term, CleanSt, StartAt + 1) else NewPos := RPosEx(Term, CleanSt, StartAt); result := NewPos <> 0; // false, 0, means item not found. end; begin // Sadly, we also need to account for cr/lf here with windows. KMemo uses a zero based char // index, the Text is still zero based but has cr/lf (in Windows) and counts bytes. The #13, CR, // is generated by KMemo when we ask for Text under Windows, occasionally I see a string with excess #13 // and it makes searching hard. So, I make a new 'Text' string with all #13 removed only for windows. // performance testing using a note about 500K, loads in 4 seconds on Linux, 12 on Windows // Here, StartAT is a zero based char count, a UTF8 char is 1 and a newline is 1 //if GoForward then inc(StartAt); // so we are past previous Find before starting next one {$IFDEF WINDOWS} // We make copy of the Text and work from it, calling Text repeatadly is slow and just setting // setting a pointer, unsafe ! 72 mS on Linux, release mode Very Big Test Note TempString := KMemo1.Blocks.text; Len := length(TempString); // I := 1; if CaseSensitive then begin while (I <= Len) do begin if TempString[I] <> #13 then CleanSt := CleanSt + TempString[I]; inc(I); end; end else begin while (I <= Len) do begin if TempString[I] <> #13 then CleanSt := CleanSt + upcase(TempString[I]); inc(I); end; Term := uppercase(Term); end; {$else} if CaseSensitive then CleanSt := pchar(KMemo1.Blocks.text) else begin //Tick := gettickcount64(); CleanSt := uppercase(KMemo1.Blocks.text); // 50-75mS, Linux, release mode, Very Large Test Note, seem much of that is KMemo // assembling the string in the first place. //Tock := gettickcount64(); //debugln('TEditBoxForm.FindIt - uppercase cleanSt = ' + inttostr(Tock - Tick) + 'mS'); Term := uppercase(Term); end; {$endif} // OK, we can now assume we have a Unix style newline Text string StartAt := length(utf8Copy(CleanSt, 1, StartAt)); // Thats our revised StartAt, now a byte count of where to start Finding if not JumptoItem() then begin // we try to find it, wrapping around once if necessary if GoForward then StartAt := 1 else StartAt := length(KMemo1.Blocks.Text); if not JumpToItem() then exit(False); // we give up. end; // if to here, we have a hit at NewPos, even if its the one we started at, rolled around // NewPos is one based Byte count, UTF8 are 2 or more, in Windows,newline is 2 char long // It starts at 1 and that does not work as a char index, if NewPos > 1 then begin dec(NewPos); // now zero based KMemo1.SelStart := utf8Length(Copy(CleanSt, 1, NewPos)); // NewPos is byte. KMemo1.SelLength := UTF8Length(Term); end; if NumbFindHits = 0 then // Maybe it is zero, but maybe term changed, its fast to ret 0 //GetFindHits(Term, CaseSensitive); GetFindHits(); GetFindHits(NewPos); // GetFindHints expects a byte count Result := true; // we are not using this anyway end; procedure TEditBoxForm.MenuFindNextClick(Sender: TObject); begin SpeedRightClick(Self); end; procedure TEditBoxForm.MenuFindPrevClick(Sender: TObject); begin SpeedLeftClick(Self); end; procedure TEditBoxForm.NewFind(Term : string); // Public, called from SearchForm begin EditFind.Text := Term; //LastFind := 0; FindIt(Term, 1, true, false); // no warning about not finding, Find Panel won't be open. end; const SearchPanelHeight = 39; procedure TEditBoxForm.MenuItemFindClick(Sender: TObject); begin //LastFind := 1; if PanelFind.Height > 5 then begin //debugln('INFO : EditBox MenuItemFindClick Hiding FindPanel'); PanelFind.Height := 1; // Hide it Kmemo1.SetFocus; end else begin //debugln('INFO : EditBox MenuItemFindClick Exposing FindPanel'); PanelFind.Height := SearchPanelHeight; if KMemo1.RealSelLength > 0 then EditFind.Text := KMemo1.SelText; LabelFindInfo.Caption := {$ifdef DARWIN} rsFindNavRightHintMac + ' ' + rsFindNavLeftHintMac {$else}rsFindNavRightHint + ' ' + rsFindNavLeftHint{$endif}; EditFind.SetFocus; end; end; procedure TEditBoxForm.EditFindExit(Sender: TObject); begin if EditFind.Text = '' then begin EditFind.Hint:=rsSearchHint; EditFind.Text := rsMenuSearch; EditFind.SelStart := 1; EditFind.SelLength := length(EditFind.Text); end; EditFind.color := clGray; end; procedure TEditBoxForm.EditFindKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin // This needs to be a keydown else we get the trailing edge of key event that opened panel if (( {$ifdef DARWIN}[ssMeta]{$else}[ssCtrl]{$endif} = Shift) ) then begin if (Key = VK_F) then begin Key := 0; MenuItemFindClick(Sender); KMemo1.SetFocus; exit; end; if (Key = VK_N) then begin Key := 0; SearchForm.OpenNote(''); exit; end; end; end; procedure TEditBoxForm.EditFindKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); // We must move focus back to KMemo on every find, else highlighted text is hidden on Qt with some themes // If we allow user to use Enter to trigger a find, their next press of enter will erase what ever is highlighted var Direction : integer = 0; // 0 = no action, 1 = Next, -1 = prev begin // We now respond to a number of keys - // Ctrl-Enter, F3, Ctrl-G means Next // Alt-Enter, Shift-F3, Ctrl-Shift-G means previous // Enter means user has used wrong key, tell them. if ([] = shift) and (Key = VK_F3) then Direction := 1 else if ({$ifdef DARWIN}[ssMeta]{$else}[ssCtrl]{$endif} = Shift) and // That is ctrl only ((Key = VK_RETURN) or (Key = VK_G)) then Direction := 1 else if ([ssAlt] = Shift) and (Key = VK_RETURN) then Direction := -1 // Alt-Enter else if ([ssShift] = Shift) and (Key = VK_F3) then Direction := -1 // Shift F3 else if ([ssCtrl, ssShift] = Shift) and (Key = VK_G) then // Ctrl-Shift-G Direction := -1; if (Direction = 0) then begin if Key = VK_Return then begin LabelFindCount.caption := ''; if (length(LabelFindInfo.Caption) > 1) and (LabelFindInfo.Caption[1] = ' ') then LabelFindInfo.Caption := {$ifdef DARWIN} rsFindNavRightHintMac + ' ' + rsFindNavLeftHint {$else} rsFindNavRightHint + ' ' + rsFindNavLeftHint{$endif} else LabelFindInfo.Caption := ' ' + {$ifdef DARWIN} rsFindNavRightHintMac + ' ' + rsFindNavLeftHint {$else} rsFindNavRightHint + ' ' + rsFindNavLeftHint{$endif}; EditFind.SetFocus; end; end else begin if Direction = 1 then SpeedRightClick(self) else SpeedLeftClick(self); Key := 0; end; end; procedure TEditBoxForm.EditFindChange(Sender: TObject); begin //FindStatus := fs_EditFindChanged; NumbFindHits := 0; end; procedure TEditBoxForm.EditFindEnter(Sender: TObject); begin editFind.Color:= clDefault; end; procedure TEditBoxForm.SpeedLeftClick(Sender: TObject); // think btPrev var Res : Boolean = false; begin Res := FindIt(EditFind.Text, KMemo1.SelStart, False, False); if Res then LabelFindInfo.Caption := '' else begin LabelFindInfo.Caption := rsNotAvailable; // perhaps user has deleted the only term in the note ? NumbFindHits := 0; LabelFindCount.caption := ''; // this is set to data by GetFindHits() end; KMemo1.setfocus; end; procedure TEditBoxForm.SpeedRightClick(Sender: TObject); // think btNext var Res : Boolean = false; begin Res := FindIt(EditFind.Text, KMemo1.SelStart+1, true, False); if Res then LabelFindInfo.Caption := '' else begin LabelFindInfo.Caption := rsNotAvailable; // perhaps user has deleted the only term in the note ? NumbFindHits := 0; LabelFindCount.caption := ''; // this is set to data by GetFindHits() end; KMemo1.setfocus; end; { ------- S T A N D A R D E D I T I N G F U N C T I O N S ----- } procedure TEditBoxForm.ButtMainTBMenuClick(Sender: TObject); begin PopupMainTBMenu.Popup; end; procedure TEditBoxForm.MenuItemCopyClick(Sender: TObject); begin KMemo1.ExecuteCommand(ecCopy); end; procedure TEditBoxForm.MenuItemCutClick(Sender: TObject); begin if KMemo1.ReadOnly then exit(); KMemo1.ExecuteCommand(ecCut); MarkDirty(); //if not Dirty then TimerSave.Enabled := true; //Dirty := true; //LabelFindInfo.Caption := 'd'; end; procedure TEditBoxForm.MenuItemDeleteClick(Sender: TObject); begin if KMemo1.ReadOnly then exit(); // KMemo1.ExecuteCommand(ecClearSelection); Undoer.AddPasteOrCut(True); KMemo1.Blocks.ClearSelection; MarkDirty(); //if not Dirty then TimerSave.Enabled := true; //Dirty := true; //LabelFindInfo.Caption := 'd'; end; procedure TEditBoxForm.MenuItemExportPlainTextClick(Sender: TObject); begin SaveNoteAs('txt'); end; procedure TEditBoxForm.MenuItemExportRTFClick(Sender: TObject); begin SaveNoteAs('rtf'); end; procedure TEditBoxForm.MenuItemExportMarkdownClick(Sender: TObject); begin SaveNoteAs('md'); end; procedure TEditBoxForm.SaveNoteAs(TheExt : string); var SaveExport : TSaveDialog; MDContent : TStringList; ExpComm : TExportCommon; FName : string; SleepCount : integer =0; begin if not BusySaving then // In case a save has just started. SaveTheNote(); // This should return quickly, before save thread is finished. while BusySaving do begin // So, we wait until BusySaving is clear before proceeding sleep(20); // 20mS inc(SleepCount); if SleepCount > 1000 then begin // 20 seconds ? huge note, slow hardware ?? showmessage('Excessive delay in saving this note'); exit; end; end; SaveExport := TSaveDialog.Create(self); SaveExport.DefaultExt := TheExt; if Sett.ExportPath <> '' then SaveExport.InitialDir := Sett.ExportPath else begin if SingleNoteMode then SaveExport.InitialDir := ExtractFilePath(SingleNoteFileName) else begin {$ifdef UNIX} SaveExport.InitialDir := GetEnvironmentVariable('HOME'); {$endif} {$ifdef WINDOWS} SaveExport.InitialDir := GetEnvironmentVariable('HOMEPATH'); {$endif} end; end; //debugln('TEditBoxForm.SaveNoteAs Filename 1 = ' + CleanCaption()); //debugln('TEditBoxForm.SaveNoteAs Filename 2 = ' + TB_MakeFileName(CleanCaption())); SaveExport.Filename := TB_MakeFileName(CleanCaption()); if SaveExport.Execute then begin case TheExt of 'txt' : KMemo1.SaveToTXT(SaveExport.FileName); 'rtf' : KMemo1.SaveToRTF(SaveExport.FileName); 'md' : begin MDContent := TStringList.Create; ExpComm := TExportCommon.Create; try ExpComm.NotesDir := Sett.NoteDirectory; if SingleNoteMode then FName := NoteFileName else FName := ExtractFileNameOnly(NoteFileName); if ExpComm.GetMDcontent( FName, MDContent) then MDContent.SaveToFile(SaveExport.FileName) else showmessage('Failed to convert to MarkDown'); finally ExpComm.Free; MDContent.Free; end; end; end; end; //showmessage(SaveExport.FileName); SaveExport.Free; end; procedure TEditBoxForm.MarkDirty(); begin {if not Dirty then} TimerSave.Enabled := true; Dirty := true; if Caption = '' then Caption := '*' else if Caption[1] <> '*' then Caption := '* ' + Caption; end; function TEditBoxForm.CleanCaption(): ANSIString; begin if Caption = '' then exit(''); if Caption[1] = '*' then Result := Copy(Caption, 3, 256) else Result := Caption; end; procedure TEditBoxForm.SetReadOnly(ShowWarning : Boolean = True); begin if ShowWarning then PanelReadOnly.Height:= 60; KMemo1.ReadOnly := True; ButtMainTBMenu.Enabled:= False; // in helpnote mode, menu is not being updated. end; procedure TEditBoxForm.MenuItemPasteClick(Sender: TObject); begin if KMemo1.ReadOnly then exit(); Undoer.AddPasteOrCut(); Ready := False; KMemo1.ExecuteCommand(ecPaste); MarkDirty(); Ready := True; end; procedure TEditBoxForm.MenuItemPrintClick(Sender: TObject); var KPrint : TKprn; begin if PrintDialog1.Execute then begin KPrint := TKPrn.Create; KPrint.PrintKmemo(KMemo1); FreeandNil(KPrint); end; end; procedure TEditBoxForm.MenuItemSelectAllClick(Sender: TObject); begin KMemo1.ExecuteCommand(ecSelectAll); end; procedure TEditBoxForm.MenuItemSpellClick(Sender: TObject); var SpellBox : TFormSpell; begin if KMemo1.ReadOnly then exit(); if Sett.SpellConfig then begin SpellBox := TFormSpell.Create(Application); // SpellBox.Top := Placement + random(Placement*2); // SpellBox.Left := Placement + random(Placement*2); SpellBox.TextToCheck:= KMemo1.Blocks.Text; SpellBox.TheKMemo := KMemo1; SpellBox.ShowModal; end else showmessage('Sorry, spelling not configured'); end; procedure TEditBoxForm.MenuItemSyncClick(Sender: TObject); begin if KMemo1.ReadOnly then exit(); if Dirty then SaveTheNote(); Sett.Synchronise(); end; { - - - H O U S E K E E P I N G F U C T I O N S ----- } procedure TEditBoxForm.TimerSaveTimer(Sender: TObject); begin TimerSave.Enabled:=False; // showmessage('Time is up'); SaveTheNote(); end; procedure TEditBoxForm.CleanUTF8(); function BitSet(Value : byte; TheBit : integer) : boolean; // theBit 0-7 begin Result := ((Value shr TheBit) and 1) = 1; end; function CleanedUTF8(var TheText : string) : boolean; var cnt : integer = 1; NumbBytes : integer = 0; i : integer; begin Result := false; while Cnt <= TheText.Length do begin if BitSet(byte(TheText[cnt]), 7) then begin // OK, we have a utf8 code. It will need at least one extra byte, maybe 2 or 3 NumbBytes := 1; if BitSet(byte(TheText[cnt]), 5) then inc(NumbBytes); if BitSet(byte(TheText[cnt]), 4) then inc(NumbBytes); if Cnt + NumbBytes > TheText.Length then begin // enough bytes remaining .... delete(TheText, Cnt, 1); Result := true; continue; end; for i := 1 to NumbBytes do begin // are they the right sort of bytes ? if not BitSet(byte(TheText[cnt + i]), 7) then begin delete(TheText, Cnt, 1); // NumbBytes := -1; // so the dec below does not skip a char Result := true; break; end; end; Cnt := Cnt + NumbBytes; end; inc(cnt); end; end; var i : integer = 0; AStr : string; TB : TKMemoTextBlock; begin KMemo1.blocks.LockUpdate; while i < Kmemo1.blocks.count do begin AStr := Kmemo1.Blocks.Items[i].text; if KMemo1.Blocks.Items[i].ClassNameis('TKMemoTextBlock') or KMemo1.Blocks.Items[i].ClassNameIs('TKMemoHyperlink') then begin if CleanedUTF8(AStr) then begin TB := KMemo1.Blocks.AddTextBlock(AStr, i); TB.TextStyle.Font := TKMemoTextBlock(KMemo1.blocks.Items[i+1]).TextStyle.Font; TB.TextStyle.Brush := TKMemoTextBlock(KMemo1.blocks.Items[i+1]).TextStyle.Brush; KMemo1.Blocks.Delete(i+1); end; end; inc(i); end; KMemo1.blocks.UnLockUpdate; end; function TEditBoxForm.LoadSingleNote() : boolean; var SLNote : TStringList; FileType : string; begin { Here we do some checks of the file name the user put on command line. If the file is not present, we assume that want to make a new note by that name. If its a Tomboy note (and all we test for is 'xml' in first line, 'tomboy' in second, then proceed normally. Note that the rtf import is not working but it loads fine as text, rtf being the kmemo's underlying lang. If we load a Text file, I either append or change extension to .note as by default, it becomes a note. } Result := False; { debugln('Path = [' + ExtractFilePath(NoteFileName) + ']'); debugln('Filename = [' + ExtractFileNameOnly(NoteFileName) + ']'); if DirectoryExistsUTF8(ExtractFilePath(NoteFileName)) then debugln('Dir is writable'); debugln('New name =' + AppendPathDelim(ExtractFilePath(NoteFileName)) + ExtractFileNameOnly(NoteFileName) + '.note'); } FileType := ''; if not FileExistsUTF8(NoteFileName) then FileType := 'new' else begin try SLNote := TStringList.Create; //try SlNote.LoadFromFile(NoteFileName); if SLNote.count = 0 then // to deal with a file created, eg with touch FileType := 'text' else if (UTF8Pos('xml', SLNote.Strings[0]) > 0) and (UTF8Pos('tomboy', SLNote.Strings[1]) > 0) then FileType := 'tomboy' else if (UTF8Pos('{\rtf1', SLNote.Strings[0]) > 0) then FileType := 'rtf' else if FileIsText(NoteFileName) then FileType := 'text'; // Wow, thats brave ! //except on //end; finally FreeAndNil(SLNote); end; end; if Verbose then debugln('Decided the file is of type ' + FileType); case FileType of 'tomboy' : try ImportNote(NoteFileName); except on E: Exception do debugln('!!! EXCEPTION during IMPORT ' + E.Message); end; // 'rtf' : KMemo1.LoadFromRTF(NoteFileName); // Wrong, will write back there ! 'text', 'rtf' : begin try KMemo1.LoadFromFile(NoteFileName); CleanUTF8(); NoteFileName := AppendPathDelim(ExtractFilePath(NoteFileName)) + ExtractFileNameOnly(NoteFileName) + '.note'; except on E: Exception do debugln('!!! EXCEPTION during LoadFromFile ' + E.Message); end; end; 'new' : begin Result := True; NoteTitle := NewNoteTitle(); end; '' : debugln('Error, cannot identify that file type'); end; if Application.HasOption('save-exit') then begin MarkDirty(); NoteFileName := ''; SaveTheNote(); close; end; end; { FormShow gets called under a number of conditions Title Filename Template - Re-show, everything all loaded. Ready = true yes . . just exit - New Note no no no GetNewTitle(), add CR, CR, Ready, MarkTitle(O), zero dates. - New Note from Template no yes, dispose yes R1 ImportNote(), null out filename - New Note from Link Button, save immediatly yes no no cp Title to Caption and to KMemo, Ready, MarkTitle(). - Existing Note from eg Tray Menu, Searchbox yes yes no R1 ImportNote() } procedure TEditBoxForm.FormShow(Sender: TObject); var ItsANewNote : boolean = false; begin if Ready then exit; // its a "re-show" event. Already have a note loaded. PanelReadOnly.Height := 1; TimerSave.Enabled := False; KMemo1.Font.Size := Sett.FontNormal; {$ifdef LCLGTK2} // if SingleNoteFileName = '' then begin // note, in singlenotemode it triggers a GTK2 Assertion KMemo1.ExecuteCommand(ecPaste); // this to deal with a "first copy" issue on Linux. // above line generates a gtk2 assertion but only in single note mode. I suspect // thats because its a modal form and in normal use, this window is not modal. // If we don't make above call in SNM, we get the same assertion sooner or later, as soon // as we select some text so may as well get it over with. No need to do it in Qt5, Win, Mac {$endif} Kmemo1.Clear; if SingleNoteMode then ItsANewNote := LoadSingleNote() // Might not be Tomboy XML format else if NoteFileName = '' then begin // might be a new note or a new note from Link if NoteTitle = '' then // New Note NoteTitle := NewNoteTitle(); ItsANewNote := True; end else begin Caption := NoteFileName; ImportNote(NoteFileName); // also sets Caption and Createdate (* if TemplateIs <> '' then begin // What is this block for ? Why would we get a notefilename AND a Template ? Aug 2021 NoteFilename := ''; NoteTitle := NewNoteTitle(); ItsANewNote := True; writeln('********* Editbox detected TemplateIs and NoteFileName ***********'); end; *) end; //debugln('OK, back in EditBox.OnShow'); if ItsANewNote then begin left := (screen.Width div 2) - (width div 2); top := (screen.Height div 2) - (height div 2); CreateDate := ''; Caption := NoteTitle; KMemo1.Blocks.AddParagraph(); KMemo1.Blocks.AddParagraph(); if kmemo1.blocks.Items[0].ClassNameIs('TKMemoParagraph') then Kmemo1.Blocks.DeleteEOL(0); if kmemo1.blocks.Items[0].ClassNameIs('TKMemoTextBlock') then Kmemo1.Blocks.DeleteEOL(0); KMemo1.Blocks.AddTextBlock(NoteTitle, 0); end; Ready := true; MarkTitle(); KMemo1.SelStart := KMemo1.Text.Length; // set curser pos to end KMemo1.SelEnd := Kmemo1.Text.Length; KMemo1.SetFocus; Dirty := False; { if SearchedTerm <> '' then begin //FindDialog1.FindText:= SearchedTerm; EditFind.Text := SearchedTerm; FindIt(SearchedTerm, True, False) end else } begin KMemo1.executecommand(ecEditorTop); KMemo1.ExecuteCommand(ecDown); end; KMemo1.Blocks.LockUpdate; {$ifdef windows} // Color:= Sett.textcolour; if Sett.DarkTheme then Color := Sett.BackGndColour; {$endif} PanelFind.Color := Sett.AltColour; Panel1.Color := Sett.AltColour; KMemo1.Colors.BkGnd:= Sett.BackGndColour; Kmemo1.Blocks.DefaultTextStyle.Font.Color:=Sett.TextColour; KMemo1.Blocks.UnLockUpdate; // if SingleNoteMode then // SearchForm.MoveWindowHere(NoteTitle); end; { called when user manually closes this form. } procedure TEditBoxForm.FormClose(Sender: TObject; var CloseAction: TCloseAction); begin Release; end; procedure TEditBoxForm.FormCloseQuery(Sender: TObject; var CanClose: boolean); {var OutFile: TextFile; } begin { debugln('^^^^^^^^^^ DANGER writing debug file Unix only editBox.pas#1304 ^^^^^^^^^^^^^'); AssignFile(OutFile, '/home/dbannon/closelogEditForm.txt'); Rewrite(OutFile); writeln(OutFile, 'FormCloseQuery just closing ' + self.NoteTitle); CloseFile(OutFile); } CanClose := True; end; procedure TEditBoxForm.FormCreate(Sender: TObject); begin { if Application.HasOption('shiftaltF-findprev') then begin UseOtherFindPrev := true; end; } Use_Undoer := Sett.CheckUseUndo.checked; // Note, user must close and repen if they change this setting if Use_Undoer then Undoer := TUndo_Redo.Create(KMemo1) else Undoer := Nil; SingleNoteFileName := MainUnit.SingleNoteFileName(); if SingleNoteFileName = '' then SearchForm.RefreshMenus(mkAllMenu, PopupMainTBMenu) else begin SingleNoteMode := True; ButtMainTBMenu.Enabled := false; end; //PanelFind.Visible := False; PanelFind.Height := 1; // That is, hide it for now PanelFind.Caption := ''; {$ifdef WINDOWS}PanelFind.Color := Sett.AltColour;{$endif} // so we see black text, windows cannot change some colours ! {$ifdef DARWIN} SpeedRight.Hint := rsFindNavRightHintMac; SpeedLeft.Hint := rsFindNavLeftHintMac; {$else} SpeedRight.Hint := rsFindNavRightHint; SpeedLeft.Hint := rsFindNavLeftHint; {$endif} (* EditFind.Hint := {$ifdef DARWIN} // Maybe a bit too much ? rsFindNavRightHintMac + ' ' + rsFindNavLeftHint {$else} rsFindNavRightHint + ' ' + rsFindNavLeftHint{$endif}; *) LabelFindCount.caption := ''; EditFind.Text := rsMenuSearch; {$ifdef DARWIN} MenuBold.ShortCut := KeyToShortCut(VK_B, [ssMeta]); MenuItalic.ShortCut := KeyToShortCut(VK_I, [ssMeta]); MenuStrikeout.ShortCut := KeyToShortCut(VK_S, [ssMeta]); MenuHighLight.ShortCut := KeyToShortCut(VK_H, [ssAlt]); MenuFixedWidth.ShortCut:= KeyToShortCut(VK_T, [ssMeta]); MenuUnderline.ShortCut := KeyToShortCut(VK_U, [ssMeta]); MenuItemFind.ShortCut := KeyToShortCut(VK_F, [ssMeta]); MenuItemEvaluate.ShortCut := KeyToShortCut(VK_E, [ssMeta]); MenuFindNext.shortcut := KeyToShortCut(VK_G, [ssMeta]); MenuFindPrev.shortcut := KeyToShortCut(VK_G, [ssShift, ssMeta]); {$endif} DeletingThisNote := False; end; // As UpdateNote does not record Notebook membership, abandon it for now. // Maybe come back later and see if it can be patched, its probably quicker. // Was only called on a clean note .... function TEditBoxForm.UpdateNote(NRec : TNoteUpdaterec) : boolean; var InFile, OutFile: TextFile; {NoteDateSt, }InString, TempName : string; begin if not fileexists(NRec.FFName) then exit(false); // if its not there, the note has just been deleted TempName := AppendPathDelim(Sett.NoteDirectory) + 'tmp'; if not DirectoryExists(TempName) then CreateDir(AppendPathDelim(tempname)); TempName := tempName + pathDelim + 'location.note'; // generate a random name ?? AssignFile(InFile, NRec.FFName); AssignFile(OutFile, TempName); try try Reset(InFile); Rewrite(OutFile); while not eof(InFile) do begin readln(InFile, InString); if (Pos('', InString) > 0) then break; writeln(OutFile, InString); end; // OK, we are looking atthe part we want to change, ignore infile, we know better. writeln(OutFile, ' ' + NRec.CPos + ''); writeln(OutFile, ' 1'); writeln(OutFile, ' ' + NRec.Width + ''); writeln(OutFile, ' ' + NRec.height + ''); writeln(OutFile, ' ' + NRec.X + ''); writeln(OutFile, ' ' + NRec.Y + ''); writeln(OutFile, ' ' + NRec.OOS + ''); //Must see if this note is in a notebook, if so, record here. writeln(OutFile, ''); finally CloseFile(OutFile); CloseFile(InFile); end; except on E: EInOutError do begin debugln('File handling error occurred updating clean note location. Details: ' + E.Message); exit(False); end; end; result := CopyFile(TempName, Nrec.FFName); // wrap this in a Try if result = false then debugln('ERROR moving [' + TempName + '] to [' + NRec.FFName + ']'); end; procedure TEditBoxForm.FormDestroy(Sender: TObject); begin if Undoer <> Nil then Undoer.free; UnsetPrimarySelection; // tidy up copy on selection. if (length(NoteFileName) = 0) and (not Dirty) then exit; // A new, unchanged note, no need to save. if not Kmemo1.ReadOnly then if not DeletingThisNote then if (not SingleNoteMode) or Dirty then // We always save, except in SingleNoteMode (where we save only if dirty) SaveTheNote(Sett.AreClosing); // Jan 2020, just call SaveTheNote, it knows how to record the notebook state SearchForm.NoteClosing(NoteFileName); end; function TEditBoxForm.GetTitle(out TheTitle : ANSIString) : boolean; var BlockNo : longint = 0; //TestSt : ANSIString; begin Result := False; TheTitle := ''; while Kmemo1.Blocks.Items[BlockNo].ClassName <> 'TKMemoParagraph' do begin // while Kmemo1.Blocks.Items[BlockNo].ClassName = 'TKMemoTextBlock' do begin TheTitle := TheTitle + Kmemo1.Blocks.Items[BlockNo].Text; inc(BlockNo); //TestSt := Kmemo1.Blocks.Items[BlockNo].ClassName; if BlockNo >= Kmemo1.Blocks.Count then break; end; // Stopped at first TKMemoParagraph if it exists. if TheTitle <> '' then Result := True; end; procedure TEditBoxForm.MarkTitle(); var BlockNo : integer = 0; //AtTheEnd : Boolean = False; EndBlock, blar : integer; begin if Not Ready then exit(); { if there is more than one block, and the first, [0], is a para, delete it.} if KMemo1.Blocks.Count <= 2 then exit(); // Don't try to mark title until more blocks. Ready := false; Kmemo1.Blocks.LockUpdate; if Kmemo1.Blocks.Items[BlockNo].ClassName = 'TKMemoParagraph' then Kmemo1.Blocks.DeleteEOL(0); try while Kmemo1.Blocks.Items[BlockNo].ClassName <> 'TKMemoParagraph' do begin if Kmemo1.Blocks.Items[BlockNo].ClassNameIs('TKMemoTextBlock') then begin // just possible its an image, ignore .... TKMemoTextBlock(Kmemo1.Blocks.Items[BlockNo]).TextStyle.Font.Size := Sett.FontTitle; TKMemoTextBlock(Kmemo1.Blocks.Items[BlockNo]).TextStyle.Font.Color := Sett.TitleColour; TKMemoTextBlock(Kmemo1.Blocks.Items[BlockNo]).TextStyle.Font.Style := [fsUnderline]; end; inc(BlockNo); if BlockNo >= Kmemo1.Blocks.Count then begin //AtTheEnd := True; break; end; end; // Stopped at first TKMemoParagraph if it exists. BlocksInTitle := BlockNo; { Make sure user has not smeared Title charactistics to next line Scan back from cursor to end of title, if Title font, reset. } EndBlock := KMemo1.Blocks.IndexToBlockIndex(KMemo1.Selstart, Blar); while (EndBlock < 10) and (EndBlock < (KMemo1.Blocks.Count -2)) do inc(EndBlock); // in case user has smeared several lines down. while EndBlock > BlocksInTitle do begin if {KMemo1.Blocks.Items[EndBlock].ClassNameIs('TKMemoTextBlock') and } (TKMemoTextBlock(Kmemo1.Blocks.Items[EndBlock]).TextStyle.Font.Size = Sett.FontTitle) then begin TKMemoTextBlock(Kmemo1.Blocks.Items[EndBlock]).TextStyle.Font.Size := Sett.FontNormal; TKMemoTextBlock(Kmemo1.Blocks.Items[EndBlock]).TextStyle.Font.Color := Sett.TextColour; TKMemoTextBlock(Kmemo1.Blocks.Items[EndBlock]).TextStyle.Font.Style := []; end; dec(EndBlock); end; finally KMemo1.Blocks.UnLockUpdate; Ready := True; end; end; { ----------- L I N K R E L A T E D F U N C T I O N S ---------- } procedure TEditBoxForm.MakeLink({const Link : ANSIString;} const Index, Len : longint); var Hyperlink, HL: TKMemoHyperlink; TrueLink : string; BlockNo, BlockOffset, Blar{, i} : longint; // DontSplit : Boolean = false; // blk : TKMemoTextBlock; begin // Is it already a Hyperlink ? We leave valid hyperlinks in place. BlockNo := KMemo1.Blocks.IndexToBlockIndex(Index, BlockOffset); if KMemo1.Blocks.Items[BlockNo].ClassNameIs('TKHyperlink') then exit(); // Is it all in the same block ? if BlockNo <> Kmemo1.Blocks.IndexToBlockIndex(Index + Len -1, Blar) then exit(); TrueLink := utf8copy(Kmemo1.Blocks.Items[BlockNo].Text, BlockOffset+1, Len); if length(Kmemo1.Blocks.Items[BlockNo].Text) = Len {length(TrueLink)} then begin Kmemo1.Blocks.Delete(BlockNo); //writeln('Block deleted'); end else begin KMemo1.SelStart:= Index; KMemo1.SelLength:=Len; KMemo1.ClearSelection(); BlockNo := KMemo1.SplitAt(Index); //writeln('Block Split'); end; Hyperlink := TKMemoHyperlink.Create; // Hyperlink.Text := Link; Hyperlink.Text := TrueLink; // Hyperlink.TextStyle.Font.Color:= clRed {Sett.TitleColour}; Hyperlink.Textstyle.StyleChanged := true; Hyperlink.OnClick := @OnUserClickLink; HL := KMemo1.Blocks.AddHyperlink(Hyperlink, BlockNo); HL.TextStyle.Font.Color:= Sett.TitleColour; // Note the colour seems to get set to some standard that TK likes when added. end; // Starts searching a string at StartAt for Term, returns 1 based offset from start of str if found, 0 if not. Like UTF8Pos( function TEditBoxForm.RelativePos(const Term : ANSIString; const MText : PChar; StartAt : integer) : integer; begin result := Pos(Term, MText+StartAt); if Result <> 0 then Result := Result + StartAt; end; procedure TEditBoxForm.MakeAllLinks(const PText : PChar; const Term : ANSIString; const StartScan : longint =1; EndScan : longint = 0); var Offset, NumbCR : longint; {$ifdef WINDOWS} {Ptr, }EndP : PChar; // Will generate "not used" warning in Unix {$endif} begin Offset := RelativePos(Term, PText, StartScan); while Offset > 0 do begin NumbCR := 0; {$ifdef WINDOWS} // compensate for Windows silly two char newlines EndP := PText + Offset; while EndP > PText do begin if EndP^ = #13 then inc(NumbCR); dec(EndP); end; {$endif} if (PText[Offset-2] in [' ', #10, #13, ',', '.']) and (PText[Offset + length(Term) -1] in [' ', #10, #13, ',', '.']) then MakeLink(UTF8Length(PText, Offset) -1 -NumbCR, UTF8length(Term)); Offset := RelativePos(Term, PText, Offset + 1); if EndScan > 0 then if Offset> EndScan then break; end; end; procedure TEditBoxForm.CheckForHTTP(const PText : pchar; const StartS, EndS : longint); function ValidWebLength(StartAt : integer) : integer; // stupid ! Don't pass StartAt, use local vars, cheaper.... var I : integer; begin I := 7; // '7' being length of 'http://' if not(PText[StartAt-2] in [' ', ',', #10, #13]) then exit(0); // no leading whitespace while PText[StartAt+I] <> '.' do begin if (StartAt + I) > EndS then exit(0); // beyond our scan zone before dot if PText[StartAt+I] in [' ', ',', #10, #13] then exit(0); // hit whitespace before a dot inc(I); end; inc(i); if (PText[StartAt+I] in [' ', ',', #10, #13]) then exit(0); // the dot is at the end ! while (not(PText[StartAt+I] in [' ', ',', #10, #13])) do begin if (StartAt + I) > EndS then exit(0); // beyond our scan zone before whitespace inc(I); end; if PText[StartAt+I-1] = '.' then Result := I else Result := I+1; end; var http, Offset, NumbCR : integer; Len : integer; {$ifdef WINDOWS}EndP : PChar; {$endif} begin OffSet := StartS; http := pos('http', PText+Offset); while (http <> 0) and ((http+Offset) < EndS) do begin if (copy(PText, Offset+http+4, 3) = '://') or (copy(PText, Offset+http+4, 4) = 's://') then begin Len := ValidWebLength(Offset+http); if Len > 0 then begin NumbCR := 0; {$ifdef WINDOWS} EndP := PText + Offset + http; while EndP > PText do begin if EndP^ = #13 then inc(NumbCR); dec(EndP); end; {$endif} MakeLink({copy(PText, Offset+http, Len), } UTF8Length(PText, OffSet + http)-1 -NumbCR, Len); // debugln('CheckForHTTP Index = ' + inttostr(UTF8Length(PText, OffSet + http)-1 -NumbCR) + ' and Len = ' + inttostr(Len)); end; if len > 0 then end; inc(Offset, http+1); http := pos('http', PText + Offset); end; end; procedure TEditBoxForm.CheckForLinks(const StartScan : longint =1; EndScan : longint = 0); var Searchterm : ANSIstring = ''; Len, httpLen : longint; // Tick, Tock : qword; pText : pchar; begin if not Ready then exit(); // There is a thing called KMemo1.Blocks.SelectableLength but it returns the number of characters, not bytes, much faster though // Note, we don't need Len if only doing http and its not whole note being checked (at startup). So, could save a bit .... Len := length(KMemo1.Blocks.text); // saves 7mS by calling length() only once ! But still 8mS if StartScan >= Len then exit; // prevent crash when memo almost empty if EndScan > Len then EndScan := Len; if EndScan = 0 then httpLen := Len else httpLen := EndScan; Ready := False; KMemo1.Blocks.LockUpdate; //Tick := gettickcount64(); try PText := PChar(lowerCase(KMemo1.Blocks.text)); if Sett.CheckShowExtLinks.Checked then // OK, what are we here for ? CheckForHTTP(PText, StartScan, httpLen); if Sett.ShowIntLinks and (not SingleNoteMode) then begin SearchForm.StartSearch(); while SearchForm.NextNoteTitle(SearchTerm) do if SearchTerm <> NoteTitle then // My tests indicate lowercase() has neglible overhead and is UTF8 ok. MakeAllLinks(PText, lowercase(SearchTerm), StartScan, EndScan); end; finally KMemo1.Blocks.UnLockUpdate; end; //Tock := gettickcount64(); //debugln('MakeAllLinks ' + inttostr(Tock - Tick) + 'mS'); Ready := True; end; procedure TEditBoxForm.ClearNearLink(const StartS, EndS : integer); //CurrentPos : longint); var {BlockNo,} Blar, StartBlock, EndBlock : longint; LinkText : ANSIString; function ValidWebLink() : boolean; // returns true if LinkText is valid web address var DotSpot : integer; Str : String; begin //writeln('Scanning for web address ' + LinkText); if pos(' ', LinkText) > 0 then exit(false); if (copy(LinkText,1, 8) <> 'https://') and (copy(LinkText, 1, 7) <> 'http://') then exit(false); Str := TKMemoTextBlock(KMemo1.Blocks.Items[StartBlock-1]).Text; if (KMemo1.Blocks.Items[StartBlock-1].ClassName <> 'TKMemoParagraph') and not Str.EndsText(' ', Str) then exit(false); if (KMemo1.Blocks.Items[StartBlock+1].ClassName <> 'TKMemoParagraph') and (not TKMemoTextBlock(KMemo1.Blocks.Items[StartBlock+1]).Text.StartsWith(' ')) then exit(false); DotSpot := pos('.', LinkText); if DotSpot = 0 then exit(false); if (DotSpot < 8) or (DotSpot > length(LinkText)-1) then exit(false); if LinkText.EndsWith('.') then exit(false); result := true; //writeln(' Valid http or https addess'); end; begin Ready := False; StartBlock := KMemo1.Blocks.IndexToBlockIndex(StartS, Blar); EndBlock := KMemo1.Blocks.IndexToBlockIndex(EndS, Blar); if StartBlock < 2 then StartBlock := 2; if EndBlock > Kmemo1.Blocks.Count then EndBlock := Kmemo1.Blocks.Count; KMemo1.Blocks.LockUpdate; try while StartBlock < EndBlock do begin if TKMemoTextBlock(KMemo1.Blocks.Items[StartBlock]).TextStyle.Font.Size = Sett.FontTitle then begin inc(StartBlock); continue; end; if KMemo1.Blocks.Items[StartBlock].ClassNameIs('TKMemoHyperlink') then begin LinkText := Kmemo1.Blocks.Items[StartBlock].Text; // if its not a valid link, remove it. But don't check for Title links in SingleNoteMode // don't remove it if its a valid web link or ! SingleNotemode and its a valid local link. // if not (ValidWebLink() or SingleNoteMode or SearchForm.IsThisaTitle(LinkText)) then begin if not (ValidWebLink() or (not SingleNoteMode and SearchForm.IsThisaTitle(LinkText))) then begin // if not (SearchForm.IsThisaTitle(LinkText) or ValidWebLink()) then begin Kmemo1.Blocks.Delete(StartBlock); KMemo1.Blocks.AddTextBlock(Linktext, StartBlock); end; end else begin // Must check here that its not been subject to the copying of a links colour and underline // we know its not a link and we know its not title. So, check color ... if TKMemoTextBlock(KMemo1.Blocks.Items[StartBlock]).TextStyle.Font.Color = Sett.TitleColour then begin // we set links to title colour TKMemoTextBlock(KMemo1.Blocks.Items[StartBlock]).TextStyle.Font.Style := TKMemoTextBlock(KMemo1.Blocks.Items[StartBlock]).TextStyle.Font.Style - [fsUnderLine]; TKMemoTextBlock(KMemo1.Blocks.Items[StartBlock]).TextStyle.Font.Color := Sett.TextColour; end; end; inc(StartBlock); end; finally KMemo1.Blocks.UnlockUpdate; Ready := True; end; end; { Scans across whole note removing any links it finds. Block containing link must be removed and new non-link block created in its place. Note that the scaning is very quick, gets bogged down doing the remove/add This function is not needed at present but leave it here in case its useful after user chooses to not display links. } procedure TEditBoxForm.ClearLinks(const StartScan : longint =0; EndScan : longint = 0); var BlockNo, EndBlock, Blar : longint; LinkText : ANSIString; begin Ready := False; BlockNo := KMemo1.Blocks.IndexToBlockIndex(StartScan, Blar); // DANGER, we must adjust StartScan to block boundary EndBlock := KMemo1.Blocks.IndexToBlockIndex(EndScan, Blar); // DANGER, we must adjust EndScan to block boundary KMemo1.Blocks.LockUpdate; while BlockNo <= EndBlock do begin // DANGER, must check these block numbers work if Kmemo1.Blocks.Items[BlockNo].ClassName = 'TKMemoHyperlink' then begin LinkText := Kmemo1.Blocks.Items[BlockNo].Text; Kmemo1.Blocks.Delete(BlockNo); KMemo1.Blocks.AddTextBlock(Linktext, BlockNo); end; inc(BlockNo); end; KMemo1.Blocks.UnLockUpdate; Ready := True; end; procedure TEditBoxForm.OnUserClickLink(sender : TObject); begin if (copy(TKMemoHyperlink(Sender).Text, 1, 7) = 'http://') or (copy(TKMemoHyperlink(Sender).Text, 1, 8) = 'https://') then OpenUrl(TKMemoHyperlink(Sender).Text) else SearchForm.OpenNote(TKMemoHyperlink(Sender).Text); end; procedure TEditBoxForm.DoHousekeeping(); var CurserPos, SelLen, StartScan, EndScan, BlockNo, Blar : longint; TempTitle : ANSIString; // TS1, TS2, TS3, TS4 : TTimeStamp; // Temp time stamping to test speed begin if KMemo1.ReadOnly then exit(); CurserPos := KMemo1.RealSelStart; SelLen := KMemo1.RealSelLength; StartScan := CurserPos - LinkScanRange; if StartScan < length(Caption) then StartScan := length(Caption); EndScan := CurserPos + LinkScanRange; if EndScan > length(KMemo1.Text) then EndScan := length(KMemo1.Text); // Danger - should be KMemo1.Blocks.Text !!! // TS1:=DateTimeToTimeStamp(Now); BlockNo := KMemo1.Blocks.IndexToBlockIndex(CurserPos, Blar); if ((BlocksInTitle + 10) > BlockNo) then begin // We don't check title if user is not close to it. MarkTitle(); GetTitle(TempTitle); if not ((TempTitle = caption) or ('* ' + TempTitle = Caption)) then TitleHasChanged := True; if Dirty then Caption := '* ' + TempTitle else Caption := TempTitle; end; // OK, if we are in the first or second (?) block, no chance of a link anyway. if BlockNo < 2 then begin if KMemo1.Blocks.Count = 0 then // But bad things happen if its really empty ! KMemo1.Blocks.AddParagraph(); exit(); end; if Sett.ShowIntLinks or Sett.CheckShowExtLinks.Checked then begin ClearNearLink(StartScan, EndScan {CurserPos}); // TS2:=DateTimeToTimeStamp(Now); CheckForLinks(StartScan, EndScan); // TS3:=DateTimeToTimeStamp(Now); end; KMemo1.SelStart := CurserPos; KMemo1.SelLength := SelLen; //Debugln('Housekeeper called'); // Memo1.append('Clear ' + inttostr(TS2.Time-TS1.Time) + 'ms Check ' + inttostr(TS3.Time-TS2.Time)); { Some notes about timing, 'medium' powered Linux laptop, 20k note. Checks and changes to Title - less than mS ClearNearLinks (none present) - less than mS CheckForLinks (none present) - 180mS, thats mostly used up by MakeLinks() but length(KMemo1.Blocks.text) needs about 7mS too. Can do better ! } end; procedure TEditBoxForm.TimerHousekeepingTimer(Sender: TObject); begin TimerHouseKeeping.Enabled := False; DoHouseKeeping(); end; { ---------------------- C A L C U L A T E F U N C T I O N S ---------------} procedure TEditBoxForm.ExprTan(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := tan(x); end; function TEditBoxForm.DoCalculate(CalcStr : string) : string; var FParser: TFPExpressionParser; parserResult: TFPExpressionResult; begin result := ''; if length(CalcStr) < 1 then exit(''); if CalcStr[length(CalcStr)] = '=' then CalcStr := copy(CalcStr, 1, length(CalcStr)-1); FParser := TFPExpressionParser.Create(nil); try try FParser.Identifiers.AddFunction('tan', 'F', 'F', @ExprTan); FParser.Builtins := [bcMath]; FParser.Expression := CalcStr; parserResult := FParser.Evaluate; case parserResult.ResultType of rtInteger : result := inttostr(parserResult.ResInteger); rtFloat : result := floattostrf(parserResult.ResFloat, ffFixed, 0, 3); end; finally FParser.Free; end; except on E: EExprParser do showmessage(E.Message); end; end; RESOURCESTRING rsUnabletoEvaluate = 'Unable to find an expression to evaluate'; // Called from a Ctrl-E, 'Equals', maybe 'Evaluate' ? Anyway, directs to appropriate // methods. procedure TEditBoxForm.InitiateCalc(); var AnsStr : string; begin if Kmemo1.blocks.RealSelLength > 0 then begin if not ComplexCalculate(AnsStr) then exit; AnsStr := '=' + AnsStr; end else if not SimpleCalculate(AnsStr) then if not ColumnCalculate(AnsStr) then exit; if AnsStr = '' then showmessage(rsUnabletoEvaluate) else begin //debugln('KMemo1.SelStart=' + inttostr(KMemo1.SelStart) + 'KMemo1.RealSelStart=' + inttostr(KMemo1.RealSelStart)); KMemo1.SelStart := KMemo1.Blocks.RealSelEnd; KMemo1.SelLength := 0; KMemo1.Blocks.InsertPlainText(KMemo1.SelStart, AnsStr); KMemo1.SelStart := KMemo1.SelStart + length(AnsStr); KMemo1.SelLength := 0; //debugln('KMemo1.SelStart=' + inttostr(KMemo1.SelStart) + 'KMemo1.RealSelStart=' + inttostr(KMemo1.RealSelStart)); end; end; // Returns all text in a para, 0 says current one, 1 previous para etc ... function TEditBoxForm.PreviousParagraphText(const Backby : integer) : string; var BlockNo, StopBlockNo, Index : longint; begin Result := ''; StopBlockNo := KMemo1.NearestParagraphIndex; // if we are on first line, '1'. Index := BackBy + 1; // we want to overshoot BlockNo := StopBlockNo; while Index > 0 do begin dec(BlockNo); dec(Index); if BlockNo < 1 then begin debugln('underrun1'); exit; end; // its all empty up there .... while not Kmemo1.Blocks.Items[BlockNo].ClassNameIs('TKMemoParagraph') do begin dec(BlockNo); if BlockNo < 1 then begin debugln('Underrun 2'); exit; end; end; if Index = 1 then StopBlockNo := BlockNo; // almost there yet ? end; inc(BlockNo); while BlockNo < StopBlockNo do begin Result := Result + Kmemo1.Blocks.Items[BlockNo].Text; inc(BlockNo); end; //debugln('PREVIOUS BlockNo=' + inttostr(BlockNo) + ' StopBlockNo=' + inttostr(StopBlockNo)); end; // Return content of paragraph that caret is within, up to caret pos. function TEditBoxForm.ParagraphTextTrunc() : string; var BlockNo, StopBlockNo, PosInBlock : longint; begin Result := ''; StopBlockNo := kmemo1.Blocks.IndexToBlockIndex(KMemo1.RealSelEnd, PosInBlock); if StopBlockNo < 0 then StopBlockNo := 0; BlockNo := StopBlockNo-1; while (BlockNo > 0) and (not Kmemo1.Blocks.Items[BlockNo].ClassNameIs('TKMemoParagraph')) do dec(BlockNo); // debugln('BlockNo=' + inttostr(BlockNo) + ' StopBlock=' + inttostr(StopBlockNo) + ' PosInBlock=' + inttostr(PosInBlock)); if BlockNo > 0 then inc(BlockNo); if BlockNo < 0 then BlockNo := 0; if (BlockNo > StopBlockNo) then exit; while BlockNo < StopBlockNo do begin Result := Result + Kmemo1.Blocks.Items[BlockNo].Text; inc(BlockNo); end; if (PosInBlock > 0) then begin Result := Result + copy(KMemo1.Blocks.Items[BlockNo].Text, 1, PosInBlock); end; end; // Looks for a number at both begining and end of string. Ret empty ones if unsuccessful function TEditBoxForm.FindNumbersInString(AStr: string; out AtStart, AtEnd : string) : boolean; var Index : integer = 1; begin if AStr = '' then exit(false); AtStart := ''; AtEnd := ''; while AStr[length(AStr)] = ' ' do delete(AStr, Length(AStr), 1); // remove trailing spaces while Index <= length(AStr) do begin if AStr[Index] in ['0'..'9', '.'] then AtStart := AtStart + AStr[Index] else break; inc(Index); end; Index := length(AStr); while Index > 0 do begin if AStr[Index] in ['0'..'9', '.'] then AtEnd := AStr[Index] + AtEnd else break; dec(Index); end; result := (AtStart <> '') or (AtEnd <> ''); end; // Tries to find a column of numbers above, trying to rhs, then lhs. // if we find tow or more lines, use it. function TEditBoxForm.ColumnCalculate(out AStr : string) : boolean; var TheLine, CalcStrStart, CalcStrEnd : string; AtStart, AtEnd : string; // strings that hold a token, if found at start or end of line Index : integer = 1; StartDone : boolean = False; EndDone : boolean = False; begin AStr := ''; // The string we will do our calc on CalcStrStart := ''; CalcStrEnd := ''; repeat // until we have a unusable line both left and right. TheLine := PreviousParagraphText(Index); FindNumbersInString(TheLine, AtStart, AtEnd); //debugln('Scanned string [' + TheLine + '] and found [' + AtStart + '] and [' + atEnd + ']'); if AtEnd = '' then if StartDone then break else EndDone := True; if AtStart = '' then if EndDone then break else StartDone := True; // record that no more tokens at Start will be used if (AtStart <> '') and (not StartDone) then if CalcStrStart = '' then CalcStrStart := AtStart else CalcStrStart := CalcStrStart + ' + ' + AtStart; if (AtEnd <> '') and (not EndDone) then if CalcStrEnd = '' then CalcStrEnd := AtEnd else CalcStrEnd := CalcStrEnd + ' + ' + AtEnd; inc(Index); until (AtStart = '') and (AtEnd = ''); // Note, we break before that situation anyway ! if not EndDone then AStr := CalcStrEnd; if not StartDone then AStr := CalcStrStart; AStr := DoCalculate(AStr); Result := (AStr <> ''); end; // Assumes that the current selection contains a complex calc expression. function TEditBoxForm.ComplexCalculate(out AStr : string) : boolean; var BlockNo, Temp : longint; begin BlockNo := kmemo1.Blocks.IndexToBlockIndex(KMemo1.RealSelEnd-1, Temp); if kmemo1.blocks.Items[BlockNo].ClassNameIs('TKMemoParagraph') then begin // debugln('Para cleanup in progress'); Temp := KMemo1.SelLength; Kmemo1.SelStart := KMemo1.Blocks.RealSelStart; KMemo1.SelLength := Temp-1; end; if abs(KMemo1.SelLength) < 1 then exit(false); // debugln('Complex Calc [' + KMemo1.Blocks.SelText + ']'); AStr := DoCalculate(KMemo1.Blocks.SelText); Result := (AStr <> ''); end; const CalcChars : set of char = ['0'..'9'] + ['^', '*', '-', '+', '/'] + ['.', '=', ' ', '(', ')']; // acts iff char under curser or to left is an '=' function TEditBoxForm.SimpleCalculate(out AStr : string) : boolean; var Index : longint; GotEquals : boolean = false; begin Result := False; AStr := ParagraphTextTrunc(); // look for equals while length(AStr) > 0 do begin if AStr[length(AStr)] = ' ' then begin delete(AStr, length(AStr), 1); continue; end; if AStr[length(AStr)] = '=' then begin delete(AStr, length(AStr), 1); GotEquals := True; continue; end; if not GotEquals then exit else break; end; // if to here, we have a string that used to start with =, lets see what else it has ? Index := length(AStr); if Index = 0 then exit; while AStr[Index] in CalcChars do begin dec(Index); if Index < 1 then break; end; delete(AStr, 1, Index); debugln('SimpleCalc=[' + AStr + ']'); // Special case exists, if the calc string was following some text terminated with // a '.', we end up a string starting with '. ' and thats bad. if copy(AStr, 1, 2) = '. ' then delete(AStr, 1, 2); AStr := DoCalculate(AStr); exit(AStr <> ''); end; { Any change to the note text and this gets called. So, vital it be quick } procedure TEditBoxForm.KMemo1Change(Sender: TObject); begin if not Ready then exit(); // don't do any of this while starting up. //if not Dirty then TimerSave.Enabled := true; MarkDirty(); TimerHouseKeeping.Enabled := False; TimerHouseKeeping.Enabled := True; // HouseKeeping is now driven by a timer; end; function TEditBoxForm.NearABulletPoint(out Leading, Under, Trailing, IsFirstChar, NoBulletPara : Boolean; out BlockNo, TrailOffset, LeadOffset : longint ) : boolean; // on medium linux laptop, 20k note this function takes less than a mS var PosInBlock, Index, CharCount : longint; begin Under := False; NoBulletPara := False; BlockNo := kmemo1.Blocks.IndexToBlockIndex(KMemo1.RealSelStart, PosInBlock); if kmemo1.blocks.Items[BlockNo].ClassNameIs('TKMemoParagraph') then begin Under := (TKMemoParagraph(kmemo1.blocks.Items[BlockNo]).Numbering = pnuBullets); NoBulletPara := not Under; end; Index := 1; CharCount := PosInBlock; while BlockNo >= Index do begin if kmemo1.blocks.Items[BlockNo-Index].ClassNameIs('TKMemoParagraph') then break; CharCount := CharCount + kmemo1.blocks.Items[BlockNo-Index].Text.Length; inc(Index); // Danger - what if we don't find one going left ? end; if BlockNo < Index then begin Result := False; if Verbose then debugln('Returning False as we appear to be playing in Heading.'); exit(); end else Leading := (TKMemoParagraph(kmemo1.blocks.Items[BlockNo-Index]).Numbering = pnuBullets); IsFirstChar := (CharCount = 0); LeadOffset := Index; Index := 0; while true do begin // must not call Classnameis with blockno = count if Verbose then debugln('Doing para seek, C=' + inttostr(KMemo1.Blocks.Count) + ' B=' + inttostr(BlockNo) + ' I=' + inttostr(Index)); inc(Index); if (BlockNo + Index) >= (Kmemo1.Blocks.Count) then begin if Verbose then debugln('Overrun looking for a para marker.'); // means there are no para markers beyond here. So cannot be TrailingBullet Index := 0; break; end; if kmemo1.blocks.Items[BlockNo+Index].ClassNameIs('TKMemoParagraph') then break; end; TrailOffset := Index; if TrailOffset > 0 then Trailing := (TKMemoParagraph(kmemo1.blocks.Items[BlockNo+Index]).Numbering = pnuBullets) else Trailing := False; Result := (Leading or Under or Trailing); if Verbose then begin debugln('IsNearBullet -----------------------------------'); Debugln(' Result =' + booltostr(Result, true)); Debugln(' Leading =' + booltostr(Leading, true)); Debugln(' Under =' + booltostr(Under, true)); Debugln(' Trailing =' + booltostr(Trailing, true)); Debugln(' IsFirstChar =' + booltostr(IsFirstChar, true)); Debugln(' NoBulletPara=' + booltostr(NoBulletPara, true)); Debugln(' LeadOffset =' + inttostr(LeadOffset)); Debugln(' TrailOffset =' + inttostr(Trailoffset)); Debugln(' BlockNo =' + inttostr(BlockNo)); end; end; { procedure TEditBoxForm.CancelBullet(const BlockNo : longint; const UnderBullet : boolean); begin debugln('Cancel this bullet'); if UnderBullet then begin if Kmemo1.Blocks.Items[BlockNo].ClassNameis('TKMemoParagraph') then if TKMemoParagraph(KMemo1.Blocks.Items[BlockNo]).Numbering = pnuBullets then SetBullet(TKMemoParagraph(kmemo1.blocks.Items[BlockNo]), False); end else if (BlockNo+1) < Kmemo1.Blocks.Count then if Kmemo1.Blocks.Items[BlockNo+1].ClassNameis('TKMemoParagraph') then begin if TKMemoParagraph(KMemo1.Blocks.Items[BlockNo+1]).Numbering = pnuBullets then SetBullet(TKMemoParagraph(kmemo1.blocks.Items[BlockNo+1]), False); end; end; } { To behave like end users expect when pressing BackSpace we have to alter KMemo's way of thinking. a If the cursor is at the end of a Bullet Text, KMemo would remove the Bullet Marker, we stop that and remove the last character of the visible string. b If the cursor is at the begininng of a Bullet Text we must cancel the bullet (which is at the end of the Text) and not merge this line with one above. We know this is the case if the trailing paragraph marker is bullet AND we are the first char of the first block of the text. c If the cursor is on next line after a bullet, on a para marker that is not a bullet and there is no text on that line after the cursor, all we do is delete that para marker. d Again, we are on first char of the line after a bullet, this line is not a bullet itself and it has some text after the cursor. We merge that text up to the bullet line above, retaining its bulletness. So, mark trailing para bullet, delete leading. x A blank line, no bullet between two bullet lines. Use BS line should dissapear. That is, delete para under cursor, move cursor to end line above. This same as c y There is nothing after our bullet para marker. So, on an empty bulletline, user presses BS to cancel bullet but that cancels bullet and moves us up to next (bulleted) line. It has to, there is nowhere else to go. Verbose shows this as a case c ???? Lead Under Trail First OnPara(not bulleted) a ? T ? F remove the last character of the visible string to left. b ? F T T F Cursor at start, cancel bullet, don't merge x T F T T T Just delete this para. if Trailing move cursor to end of line above. c T F F T T Just delete this para. if Trailing move cursor to end of line above. y T T F T F Like c but add a para and move down. Not happy ..... d T F F T F mark trailing para as bullet, delete leading. e T T T T F must remove Bullet for para under cursor Special case where curser is at end of a bullet and there is no para beyond there ? So, its should act as (a) but did, once, act as (d) ?? Needs more testing ...... } procedure TEditBoxForm.KMemo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); var TrailOffset, BlockNo, // Will hold block number cursor is under. LeadOffset : longint; LeadingBullet, // The para immediatly previous to cursor is a bullet UnderBullet, // We are under a Para and its a Bullet TrailingBullet, // We are under Text but the block behind us is a Bullet. FirstChar : boolean; // Cursor is under the first character of a line of text. NoBulletPara : boolean = false; begin if not Ready then exit(); // should we drop key on floor ???? // don't let any ctrl char get through the kmemo on mac {$ifdef DARWIN} if [ssCtrl] = Shift then begin case Key of VK_1 : AlterFont(ChangeSize, Sett.FontSmall); VK_2 : AlterFont(ChangeSize, Sett.FontNormal); VK_3 : AlterFont(ChangeSize, Sett.FontLarge); VK_4 : AlterFont(ChangeSize, Sett.FontHuge); end; Key := 0; exit; end; if ([ssAlt, ssShift] = Shift) and ((Key = VK_RIGHT) or (Key = VK_LEFT)) then exit; // KMemo - extend selection one word left or right {$endif} // Record this event in the Undoer if its ssShift or empty set, rest are ctrl, meta etc .... if Use_Undoer and (([ssShift] = Shift) or ([] = Shift)) then // while we pass presses like this to undoer, not all are Undoer.RecordInitial(Key); // used, onKeyPress must follow and it gets only text type keys. {$ifndef DARWIN} // -------------- Shift ------------------- if [ssShift] = shift then begin if (Key = VK_LEFT) or (Key = VK_RIGHT) then exit; // KMemo - extend selection one char left or right if (Key = VK_F3) then begin key := 0; if (EditFind.Text <> rsMenuSearch) then SpeedLeftClick(self); end; end; {$endif} // -------------- Control ------------------ if {$ifdef Darwin}[ssMeta] = Shift {$else}[ssCtrl] = Shift{$endif} then begin case key of VK_Return, VK_G : begin key := 0; if (EditFind.Text <> rsMenuSearch) then SpeedRightClick(self); end; VK_Q : MainForm.close(); VK_1 : AlterFont(ChangeSize, Sett.FontSmall); VK_2 : AlterFont(ChangeSize, Sett.FontNormal); VK_3 : AlterFont(ChangeSize, Sett.FontLarge); VK_4 : AlterFont(ChangeSize, Sett.FontHuge); VK_B : AlterFont(ChangeBold); VK_I : AlterFont(ChangeItalic); VK_S : AlterFont(ChangeStrikeOut); VK_T : AlterFont(ChangeFixedWidth); VK_H : AlterFont(ChangeColor); VK_U : AlterFont(ChangeUnderLine); VK_F : begin Key := 0; MenuItemFindClick(self); end; VK_L : SpeedButtonLinkClick(Sender); VK_V : begin if Use_Undoer then Undoer.AddPasteOrCut(); exit; end; // Must exit to prevent setting Key to 0 VK_X : begin if Use_Undoer then Undoer.AddPasteOrCut(True); exit; end; // Must exit to prevent setting Key to 0 VK_Z : if Use_Undoer then Undoer.UnDo; // Note : Ctrl-Z does not go through to KMemo VK_Y : if Use_Undoer then Undoer.Redo; // Note : Ctrl-Y does not go through to KMemo VK_D : InsertDate(); VK_N : SearchForm.OpenNote(''); VK_E : InitiateCalc(); VK_F4 : close; // close just this note, normal saving will take place VK_C, VK_A, VK_HOME, VK_END, VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT, VK_PRIOR, VK_NEXT, VK_INSERT : exit; end; Key := 0; // so we don't get a ctrl key character in the text exit(); end; // ------------- Alt (or Option in Mac) ------------------ if [ssAlt] = Shift then begin case key of {$ifdef DARWIN} VK_H : begin AlterFont(ChangeColor); ; Key := 0; end; {$endif} VK_RIGHT : begin BulletControl(False, True); Key := 0; end; VK_LEFT : begin BulletControl(False, False); Key := 0; end; VK_Return : if (EditFind.Text <> rsMenuSearch) then begin Key := 0; SpeedLeftClick(self); end; end; exit(); end; // ------------------ Control and Shift (or, Mac, Command and Shift) ---------------- if {$ifdef Darwin}[ssMeta, ssShift]{$else}[ssCtrl, ssShift]{$endif} = Shift then begin case Key of VK_F : SpeedButtonSearchClick(self); // Search all notes VK_G : if (EditFind.Text <> rsMenuSearch) then SpeedLeftClick(self); {$ifndef DARWIN} VK_RIGHT, VK_LEFT : exit; // KMemo knows how to do this, select word ... {$endif} end; Key := 0; exit(); end; if Key = VK_TAB then begin // ToDo : Tabs do not work as expected KMemo1.InsertChar(KMemo1.Blocks.RealSelStart, ' '); KMemo1.InsertChar(KMemo1.Blocks.RealSelStart, ' '); KMemo1.InsertChar(KMemo1.Blocks.RealSelStart, ' '); KMemo1.InsertChar(KMemo1.Blocks.RealSelStart, ' '); Key := 0; exit; end; if Key = VK_F3 then begin key := 0; if (EditFind.Text <> rsMenuSearch) then SpeedRightClick(self); end; if Key <> 8 then exit(); // We are watching for a BS on a Bullet Marker // Mac users don't have a del key, they use a backspace key thats labled 'delete'. Sigh... if KMemo1.Blocks.RealSelEnd > KMemo1.Blocks.RealSelStart then exit(); if not NearABulletPoint(LeadingBullet, UnderBullet, TrailingBullet, FirstChar, NoBulletPara, BlockNo, TrailOffset, LeadOffset) then exit(); if (not FirstChar) and (not UnderBullet) then exit(); // We do have to act, don't pass key on. Key := 0; Ready := False; MarkDirty(); TimerHouseKeeping.Enabled := False; TimerHouseKeeping.Enabled := True; // KMemo1.Blocks.LockUpdate; Do not lock because we move the cursor down here. if UnderBullet and (not FirstChar) then begin // case a KMemo1.ExecuteCommand(ecDeleteLastChar); if Verbose then debugln('Case a'); Ready := True; exit(); end; // anything remaining must have FirstChar if TrailingBullet and (not NoBulletPara) then begin // case b if Verbose then debugln('Case b or e'); if UnderBullet then // case e TrailOffset := 0; if kmemo1.blocks.Items[BlockNo+TrailOffset].ClassNameIs('TKMemoParagraph') then SetBullet(TKMemoParagraph(kmemo1.blocks.Items[BlockNo+TrailOffset]), False) // TKMemoParagraph(kmemo1.blocks.Items[BlockNo+TrailOffset]).Numbering := pnuNone else DebugLn('ERROR - this case b block should be a para'); Ready := True; exit(); end; // anything remaining is outside bullet list, looking in. Except if Trailing is set... if kmemo1.blocks.Items[BlockNo].ClassNameIs('TKMemoParagraph') then begin KMemo1.Blocks.Delete(BlockNo); // delete this blank line. if TrailingBullet then begin KMemo1.ExecuteCommand(ecUp); KMemo1.ExecuteCommand(ecLineEnd); if Verbose then debugln('Case x'); end else begin if UnderBullet then begin // this test is wrong, real test is are we at end of text ? if Verbose then DebugLn('Case y'); KMemo1.Blocks.AddParagraph(); // Maybe only need add that if at end of text, NearABulletPoint() could tell us ? KMemo1.ExecuteCommand(ecDown); end else if Verbose then debugln('Case c'); end; end else begin // merge the current line into bullet above. if kmemo1.blocks.Items[BlockNo+TrailOffset].ClassNameIs('TKMemoParagraph') then SetBullet(TKMemoParagraph(kmemo1.blocks.Items[BlockNo+TrailOffset]), True) // TKMemoParagraph(kmemo1.blocks.Items[BlockNo+TrailOffset]).Numbering := pnuBullets; else DebugLn('ERROR - this case d block should be a para'); if kmemo1.blocks.Items[BlockNo-Leadoffset].ClassNameIs('TKMemoParagraph') then begin KMemo1.Blocks.Delete(BlockNo-LeadOffset); if Verbose then debugln('Case d'); end; end; Ready := True; // most of the intevention paths through this method take ~180mS on medium powered linux laptop end; procedure TEditBoxForm.KMemo1KeyPress(Sender: TObject; var Key: char); begin if Use_Undoer then Undoer.AddKeyPress(Key); end; procedure TEditBoxForm.KMemo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Use_Undoer then Undoer.AddKeyUp(Key, Shift); end; procedure TEditBoxForm.SetBullet(PB : TKMemoParagraph; Bullet : boolean); {var Index : integer; } //Tick, Tock : qword; begin // KMemo declares a number of Bullets/Paragraph number thingos. We map // BulletOne .. BulletEight to them in tb_utils. Change order/appearance there. // You cannot have different blocks using same bullet (ie pnuBullet, // pnuArrowBullet) with different indent levels. Its a KMemo thing. // The numbers here must match what we use in Loadnote, should be constants too. // Here I set the different bullet indents each and every time they are used. // ToDo : can I initialise the different bullet indents during startup ? KMemo1.Blocks.lockUpdate; try case PB.Numbering of pnuNone : if Bullet then begin PB.Numbering := BulletOne; PB.NumberingListLevel.FirstIndent:=-20; PB.NumberingListLevel.LeftIndent := 30; end; BulletOne : begin PB.Numbering:=pnuNone; if Bullet then begin PB.Numbering := BulletTwo; PB.NumberingListLevel.FirstIndent:=-20; PB.NumberingListLevel.LeftIndent := 50; end; end; BulletTwo : begin PB.Numbering:=pnuNone; if Bullet then begin PB.Numbering := BulletThree; PB.NumberingListLevel.FirstIndent:=-20; PB.NumberingListLevel.LeftIndent := 70; end else PB.Numbering := BulletOne; end; BulletThree : begin PB.Numbering:=pnuNone; if Bullet then begin PB.Numbering := BulletFour; PB.NumberingListLevel.FirstIndent:=-20; PB.NumberingListLevel.LeftIndent := 90; end else PB.Numbering := BulletTwo; end; BulletFour : begin PB.Numbering:=pnuNone; if Bullet then begin PB.Numbering := BulletFive; PB.NumberingListLevel.FirstIndent:=-20; PB.NumberingListLevel.LeftIndent := 110; end else PB.Numbering := BulletThree; end; BulletFive : begin PB.Numbering:=pnuNone; if Bullet then begin PB.Numbering := BulletSix; PB.NumberingListLevel.FirstIndent:=-20; PB.NumberingListLevel.LeftIndent := 130; end else PB.Numbering := BulletFour; end; BulletSix : begin PB.Numbering:=pnuNone; if Bullet then begin PB.Numbering := BulletSeven; PB.NumberingListLevel.FirstIndent:=-20; PB.NumberingListLevel.LeftIndent := 150; end else PB.Numbering := BulletFive; end; BulletSeven : begin PB.Numbering:=pnuNone; if Bullet then begin PB.Numbering := BulletEight; PB.NumberingListLevel.FirstIndent:=-20; PB.NumberingListLevel.LeftIndent := 170; end else PB.Numbering := BulletSix; end; BulletEight : if not Bullet then begin PB.Numbering:=pnuNone; PB.Numbering := BulletSeven; end; end; // end of case statement finally KMemo1.Blocks.UnlockUpdate; end; end; { --- I M P O R T I N G and E X P O R T I N G F U N C T I O N S --- } // Make sure position and size is appropriate. procedure TEditBoxForm.AdjustFormPosition(); begin // First of all, deal with zero or neg settings if Top < 20 then Top := 20; if Left < 20 then Left := 20; if Width < 50 then width := 50; if Height < 50 then height := 50; // ensure we don't start with more than two thirds _beyond_ boundaries. // don't seem to need this, on Linux at least, new window is always within screen. Test on Windows/Mac {$ifdef LINUX}exit;{$endif} // Jan 2020, a possible problem in at least single note mode of notes beyond right hand edge of screen. bug #116 if (Left + (Width div 3)) > Screen.Width then begin Left := Screen.Width - (Width div 3); end; if (Top + (Height div 3)) > Screen.Height then begin Top := Screen.Height - (Height div 3); end; end; procedure TEditBoxForm.ImportNote(FileName: string); var Loader : TBLoadNote; //T1 : qword; // Temp time stamping to test speed begin // Timing numbers below using MyRecipes on my Acer linux laptop. For local comparison only ! //T1 := gettickcount64(); Loader := TBLoadNote.Create(); Loader.FontNormal:= Sett.FontNormal; // Loader.FontName := FontName; Loader.FontSize:= Sett.FontNormal; KMemo1.Blocks.LockUpdate; KMemo1.Clear; Loader.LoadFile(FileName, KMemo1); // 340mS KMemo1.Blocks.UnlockUpdate; // 370mS // debugln('Load Note=' + inttostr(gettickcount64() - T1) + 'mS'); Createdate := Loader.CreateDate; Ready := true; Caption := Loader.Title; if Sett.ShowIntLinks or Sett.CheckShowExtLinks.checked then CheckForLinks(); // 360mS Left := Loader.X; Top := Loader.Y; Height := Loader.Height; Width := Loader.Width; // AdjustFormPosition() will fix if necessary AdjustFormPosition(); Loader.Free; TimerHouseKeeping.Enabled := False; // we have changed note but no housekeeping reqired // debugln('Load Note=' + inttostr(gettickcount64() - T1) + 'mS'); end; {$define SAVETHREAD} function TEditBoxForm.SaveStringList(const SL: TStringList; Loc : TNoteUpdateRec) : boolean; var {$ifdef SAVETHREAD} TheSaveThread : TSaveThread; {$else} Normaliser : TNoteNormaliser; WBufStream : TWriteBufStream; FileStream : TFileStream; {$ENDIF} begin if BusySaving then exit(False); BusySaving := True; Result := True; {$ifdef SAVETHREAD} TheSaveThread := TSaveThread.Create(true); TheSaveThread.TheLoc := Loc; TheSaveThread.TheSL := Sl; TheSaveThread.Start; // It will clean up after itself. {$else} Normaliser := TNoteNormaliser.Create; Normaliser.NormaliseList(SL); Normaliser.Free; SL.Add(Footer(Loc)); // TWriteBufStream, TFileStream preferable to BufferedFileStream because of a lighter memory load. FileStream := TFileStream.Create(Loc.FFName, fmCreate); //FileStream := TFileStream.Create('/home/dbannon/savethread.note', fmCreate); WBufStream := TWriteBufStream.Create(FileStream, 4096); // 4K seems about right on Linux. try try SL.SaveToStream(WBufStream); except on E:Exception do begin Debugln('ERROR, failed to save note : ' + E.Message); WBufStream.Free; FileStream.Free; SL.Free; end; end; finally WBufStream.Free; FileStream.Free; SL.Free; end; BusySaving := False; {$ENDIF} end; procedure TEditBoxForm.SaveTheNote(WeAreClosing : boolean = False); var Title : string; Saver : TBSaveNote; SL : TStringList; OldFileName : string =''; Loc : TNoteUpdateRec; // T1, T2, T3, T4, T5, T6, T7 : qword; // Timing shown is for One Large Note. begin if BusySaving then begin // ShowMessage('ERROR, unable to save ' + NoteFileName); // No, don't do that, it stops the process exit; end; //T1 := gettickcount64(); Saver := Nil; if KMemo1.ReadOnly then exit(); if length(NoteFileName) = 0 then NoteFileName := Sett.NoteDirectory + GetAFilename(); if (not WeAreClosing) and (Sett.NoteDirectory = CleanAndExpandDirectory(ExtractFilePath(NoteFileName))) then begin // Check name of Repo note, not SNM. UTF8 OK if not IDLooksOK(ExtractFileNameOnly(NoteFileName)) then if mrYes = QuestionDlg('Invalid GUID', 'Give this note a new GUID Filename (recommended) ?', mtConfirmation, [mrYes, mrNo], 0) then begin OldFileName := NoteFileName; NoteFileName := Sett.NoteDirectory + GetAFilename(); Loc.LastChangeDate:= SearchForm.NoteLister.GetLastChangeDate(ExtractFileNameOnly(OldFileName)); SearchForm.UpdateList(CleanCaption(), Loc.LastChangeDate, NoteFileName, self); // some timewasting menu rewrite ?? Debugln('We have just registered a new name for that note with invalid GUID'); end; end; if TemplateIs <> '' then begin SL := TStringList.Create(); SL.Add(TemplateIs); SearchForm.NoteLister.SetNotebookMembership(ExtractFileNameOnly(NoteFileName) + '.note', SL); SL.Free; TemplateIs := ''; end; Saver := TBSaveNote.Create(); Saver.CreateDate := CreateDate; if not GetTitle(Title) then exit(); // If title has changed, we make a backup copy. if TitleHasChanged then begin SearchForm.BackupNote(NoteFileName, 'ttl'); TitleHasChanged := False; end; Caption := Title; KMemo1.Blocks.LockUpdate; // to prevent changes during read of kmemo //T2 := GetTickCount64(); SL := TStringList.Create(); try Saver.ReadKMemo(NoteFileName, Title, KMemo1, SL); // Puts all the content into the StringList, SL //T3 := GetTickCount64(); finally KMemo1.Blocks.UnLockUpdate; if Saver <> Nil then Saver.Destroy; Caption := CleanCaption(); end; Loc.Width:=inttostr(Width); Loc.Height:=inttostr(Height); Loc.X := inttostr(Left); Loc.Y := inttostr(Top); Loc.OOS := booltostr(WeAreClosing, True); Loc.CPos:='1'; loc.FFName := NoteFileName; loc.CreateDate := CreateDate; if Dirty or SingleNoteMode then begin // In SingeNoteMode, there is no NoteLister, so date is always updated. Loc.LastChangeDate:= TB_GetLocalTime(); SearchForm.UpdateList(CleanCaption(), Loc.LastChangeDate, NoteFileName, self); // 6mS - 8mS timewasting menu rewrite ?? end else Loc.LastChangeDate:= SearchForm.NoteLister.GetLastChangeDate(ExtractFileNameOnly(NoteFileName)); //T4 := GetTickCount64(); if SaveStringList(SL, Loc) then Dirty := False; // Note, thats not a guaranteed good save, //T5 := GetTickCount64(); // T6 := GetTickCount64(); { debugln('Save Note Initial=' + inttostr(T2-T1) + ' ReadMemo=' + inttostr(T3-T2) + ' MenuUpDate=' + Inttostr(T4-T3) + ' Normalise_Save=' + inttostr(T5-T4)); } (* {$ifdef SAVETHREAD} debugln('Total time to save threaded is ' + inttostr(T5-T1)); {$else} debugln('Total time to save UN-threaded is ' + inttostr(T5-T1)); {$endif} *) end; function TEditBoxForm.NewNoteTitle(): ANSIString; begin Result := 'New Note ' + FormatDateTime('YYYY-MM-DD hh:mm:ss.zzz', Now); end; function TEditBoxForm.GetAFilename() : ANSIString; var GUID : TGUID; begin CreateGUID(GUID); Result := copy(GUIDToString(GUID), 2, 36) + '.note'; end; end. tomboy-ng_0.34-1/source/spelling.pas0000644000175000017500000002654014145033507017246 0ustar dbannondbannonunit Spelling; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ A GUI unit that uses hunspell.pas to check spelling of the passed KMemo Note we start at the end of doc and scan back to beginning } { HISTORY - 2018/03/03 Initial Commit 2018/03/24 Win only bug, missed counting a #13 when replacing first word on line. Win only - allow for #13 in a selected block 2018/04/07 Changes in ReplaceWord to really get it right for Windows UTF8 but some changes outside ifdef so must check on Linux too. 2018/06/21 Hide an unnecessary debug line 2018/11/29 Fixed bug when spell checking a selection of text 2019/05/19 Display strings all (?) moved to resourcestrings 2020/10/04 Bugfix, selected single word chopped off last character 2020/10/04 Now respond to double click in suggested word list box. } {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons, kmemo; type { TFormSpell } TFormSpell = class(TForm) BitBtn1: TBitBtn; ButtonSkip: TButton; ButtonIgnore: TButton; ButtonUseAndNextWord: TButton; //Label1: TLabel; LabelContext: TLabel; LabelPrompt: TLabel; Label4: TLabel; LabelStatus: TLabel; LabelSuspect: TLabel; ListBox1: TListBox; procedure ButtonIgnoreClick(Sender: TObject); procedure ButtonUseAndNextWordClick(Sender: TObject); procedure ButtonSkipClick(Sender: TObject); procedure FormHide(Sender: TObject); procedure FormShow(Sender: TObject); procedure ListBox1Click(Sender: TObject); procedure ListBox1DblClick(Sender: TObject); private function CleanContext(): AnsiString; { Returns the number of #13 before the indicated location - bloody windows ! } function NewLinesBefore(const Idx: integer): integer; { Returns True if it found another mis spelt word } procedure PreviousWord(var TheIndex: longint); procedure ReplaceWord(const NewWord: AnsiString); procedure ShowContents; procedure ShowSuggestions(); procedure WeAreDone(); function WordToCheck(): boolean; public TextToCheck : AnsiString; TheKMemo : TKmemo; end; var FormSpell: TFormSpell; implementation uses hunspell, settings, LazUTF8, LazLogger; const SetofDelims = [#10, #13, ' '..'@', '['..'`', '{'..'~']; // all askii visible char ?? // SetofDelims = [' ',#10,#13,'(', ')', ',', '[', ']', '1', '2', '3', '4', '5', '6', '7', '8', '9', '0', '.', ';', '/', '-']; ContextSize = 20; // Thats plus and minus var Spell : THunspell; { Index points to character before word we are checking, a deliminator or its 0 its a count of UTF8 characters, not bytes } Index : integer; FinishIndex : integer; TheWord : ANSIString; // The word we think might be mis-spelt LeadContext, TrailContext : AnsiString; SaveSelStart, SaveSelEnd : integer; Str_Text : ANSIString; // Will have a copy of KMemo's Text property, faster {$R *.lfm} { TFormSpell } function TFormSpell.NewLinesBefore(const Idx : integer) : integer; var BlockNo, LocalOffset : integer; begin Result := 0; BlockNo := TheKmemo.Blocks.IndexToBlockIndex(Idx, LocalOffset); while BlockNo > 0 do begin if TheKmemo.Blocks.Items[BlockNo].ClassNameIs('TKMemoParagraph') then inc(Result); dec(BlockNo); end; end; RESOURCESTRING rsCheckingFull = 'Checking full document'; rsCheckingSelection = 'Checking selection'; rsSpellNotConfig = 'Spelling not configured'; procedure TFormSpell.FormShow(Sender: TObject); begin // ShowContents(); SaveSelStart := TheKmemo.RealSelStart; SaveSelEnd := TheKMemo.RealSelEnd; // SelEnd points to first non-selected char if SaveSelEnd > (SaveSelStart+1) then begin // Something was selected ... Index := SaveSelEnd; FinishIndex := SaveSelStart; {$ifdef WINDOWS} // yet again, Windows silly line endings in .Text property Index := Index + NewLinesBefore(Index) + 1; FinishIndex := FinishIndex + NewLinesBefore(FinishIndex); {$endif} LabelStatus.Caption := rsCheckingSelection; end else begin // note only one char selected, we treat as check whole doc FinishIndex := 0; Index := UTF8Length(TheKMemo.Blocks.Text); LabelStatus.Caption := rsCheckingFull; end; TheKMemo.SelEnd := TheKMemo.SelStart; // Now, nothing selected. LabelStatus.Caption := ''; TheKMemo.Blocks.LockUpdate; Str_Text := TheKMemo.Blocks.Text; // Make a copy to work with, faster if Sett.SpellConfig then begin Spell := THunspell.Create(Application.HasOption('debug-spell'), Sett.LabelLibrary.Caption); if Spell.ErrorMessage = '' then begin if Spell.SetDictionary(Sett.LabelDic.Caption) then PreviousWord(Index); end; end else LabelStatus.Caption := rsSpellNotConfig; end; RESOURCESTRING rsREPLACE_with_1 = 'replace'; rsReplace_WITH_2 = 'with'; procedure TFormSpell.ListBox1Click(Sender: TObject); begin LabelStatus.Caption := rsREPLACE_with_1 + ' ' + TheWord + ' ' + rsReplace_WITH_2 + ' ' + ListBox1.Items[ListBox1.ItemIndex]; ButtonUseAndNextWord.Enabled := True; end; procedure TFormSpell.ListBox1DblClick(Sender: TObject); begin LabelStatus.Caption := rsREPLACE_with_1 + ' ' + TheWord + ' ' + rsReplace_WITH_2 + ' ' + ListBox1.Items[ListBox1.ItemIndex]; ButtonUseAndNextWord.Click; end; procedure TFormSpell.ReplaceWord(const NewWord : AnsiString); var BlockNo, TempIndex : integer; LocalIndex {$ifdef WINDOWS}, I {$endif} : integer; TB: TKMemoTextBlock; TextSize : integer; begin TempIndex := Index; {$ifdef WINDOWS} // Must allow for Windows extra CR in newline // need to know how many CRs between Index and 0 I := length(UTF8copy(Str_Text, 1, Index+1)); // One based St, we need a byte count, not char while I > 0 do begin if Str_Text[I] = #13 then dec(TempIndex); dec(I); end; {$endif} //BlockNo := TheKmemo.Blocks.IndexToBlockIndex(TempIndex+1, LocalIndex); BlockNo := TheKmemo.Blocks.IndexToBlockIndex(TempIndex, LocalIndex); //debugln('Operating on BK=' + inttostr(BlockNo) + ' Loc=' + inttostr(LocalIndex) + ' TempIndex=' + inttostr(TempIndex) + ' Index=' + inttostr(Index)); TextSize := TKMemoTextBlock(TheKmemo.Blocks.Items[BlockNo]).TextStyle.Font.Size; // and Style ???? TheKMemo.SelStart := TempIndex; // zero based TheKMemo.SelEnd := TempIndex + UTF8Length(TheWord); //TheKMemo.Blocks.DeleteChar(0); // will delete selected text, maybe use ClearSelection() ?? TheKMemo.Blocks.ClearSelection(); if TheKmemo.Blocks.Items[BlockNo].ClassNameIs('TKMemoParagraph') then begin TB := TheKMemo.Blocks.AddTextBlock(NewWord, BlockNo); TB.TextStyle.Font.Size := TextSize; end else //TheKmemo.Blocks.Items[BlockNo].InsertString(NewWord, LocalIndex-1); // TKSelectionIndex is 0 based TheKmemo.Blocks.Items[BlockNo].InsertString(NewWord, LocalIndex); LabelStatus.Caption := ''; end; procedure TFormSpell.ShowSuggestions(); begin Spell.Suggest(TheWord, ListBox1.Items); LabelPrompt.Visible:= True; ListBox1.Items.Add(TheWord); end; function TFormSpell.CleanContext() : AnsiString; // Ah, what about bloody windows ? var LineEndPos : integer; begin // DebugLn('[[' + LeadContext + ' & ' + TrailContext + ']]'); LineEndPos := UTF8Pos(LineEnding, LeadContext, 1); While LineEndPos > 0 do begin UTF8Delete(LeadContext, 1, LineEndPos); LineEndPos := UTF8Pos(LineEnding, LeadContext, 1); end; // DebugLn('[' + LeadContext + ']'); LineEndPos := UTF8Pos(LineEnding, TrailContext); if LineEndPos > 0 then UTF8Delete(TrailContext, LineEndPos, ContextSize); // DebugLn('[' + TrailContext + ']'); Result := LeadContext + ' ' + TrailContext; end; function TFormSpell.WordToCheck() : boolean; begin Result := False; if UTF8Length(TheWord) > 1 then if not Spell.Spell(TheWord) then Result := True; if Result then begin ShowSuggestions(); LabelSuspect.Caption := TheWord; LabelContext.Caption := CleanContext(); // ShowContents(); end else TheWord := '' end; RESOURCESTRING rsSpellComplete = 'Spell check complete'; procedure TFormSpell.WeAreDone(); begin LabelStatus.Caption := rsSpellComplete; LabelContext.Caption := ''; ListBox1.Clear; LabelSuspect.Caption:=''; ButtonSkip.Enabled := False; ButtonIgnore.Enabled := False; end; procedure TFormSpell.PreviousWord(var TheIndex : longint); var //TS1, TS2, TS3, TS4 : TTimeStamp; // Temp time stamping to test speed UTFCode : AnsiString; begin LabelPrompt.Visible:= False; // Dec(TheIndex); // why ? something to do with detecting spell check complete TheWord := ''; ButtonUseAndNextWord.Enabled := False; //Str_Text := TheKMemo.Blocks.Text; // much faster ! but tough on memory ? while TheIndex > FinishIndex do begin // remember, first char is #1 UTFCode := UTF8Copy(Str_Text, TheIndex, 1); if UTFCode[1] in SetOfDelims then begin LeadContext := UTF8Copy(Str_Text, TheIndex - ContextSize, ContextSize); TrailContext := UTF8Copy(Str_Text, TheIndex+1, ContextSize); if WordToCheck() then exit(); end else TheWord := UTFCode + TheWord; dec(TheIndex); end; // if to here, TheIndex is 0 or equal to FinishIndex if (UTF8Length(TheWord) > 1) then begin if (not WordToCheck()) then WeAreDone(); end else dec(TheIndex); // iff we didn't enter above loop, must still dec ! if TheIndex < FinishIndex then WeAreDone(); end; procedure TFormSpell.ButtonUseAndNextWordClick(Sender: TObject); begin ReplaceWord(ListBox1.Items[ListBox1.ItemIndex]); PreviousWord(Index); end; procedure TFormSpell.ButtonIgnoreClick(Sender: TObject); begin Spell.Add(TheWord); PreviousWord(Index); end; procedure TFormSpell.ButtonSkipClick(Sender: TObject); begin PreviousWord(Index); end; procedure TFormSpell.FormHide(Sender: TObject); begin FreeandNil(Spell); TheKMemo.Blocks.UnLockUpdate; TheKMemo.SelEnd := SaveSelEnd; // Restore selection as best we can TheKMemo.SelStart := SaveSelStart; // but if spelling has changed size of intermediate text ..... end; procedure TFormSpell.ShowContents; // this method for debug only // To see debug messages in ($#$@#!) windows, Lazarus->Run->Run Parameter and set (eg) --debug-log=logfile.txt // Note that you need to exit the app to flush all content to file. And file is not zeroed on startup. Sigh..... var Cnt : integer = 0; begin debugln('------------'); while Cnt < TheKMemo.Blocks.Count do begin debugln(TheKMemo.Blocks.Items[Cnt].ClassName + '=' + inttostr(Cnt) + ' [' + TheKMemo.Blocks.Items[Cnt].Text + '] starts at ' + inttostr(TheKMemo.Blocks.BlockToIndex(TheKMemo.Blocks.Items[Cnt])) ); inc(Cnt); end; debugln('------------'); end; end. tomboy-ng_0.34-1/source/rollback.pas0000644000175000017500000001312714145033507017217 0ustar dbannondbannonunit RollBack; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ This form will allow a user to roll back an open note to either the backup made when it was opened or a backup made if the Title was changed. It will close the open note, swap the files as required, advise Note_lister and reopen. It can toggle, repeatedly switch between. But if end user changes the title, it (obviously) writes a new backup, probably not what they want but I cannot determine their intentions. } {$mode objfpc}{$H+} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Buttons, StdCtrls, EditBox; type { TFormRollBack } TFormRollBack = class(TForm) Label1: TLabel; LabelOpnTitle: TLabel; LabelttlTitle: TLabel; LabelOpn: TLabel; Labelttl: TLabel; SpeedCancel: TSpeedButton; SpeedRollToOpen: TSpeedButton; SpeedRollToTitle: TSpeedButton; procedure FormCreate(Sender: TObject); procedure FormShow(Sender: TObject); procedure SpeedCancelClick(Sender: TObject); procedure SpeedRollToOpenClick(Sender: TObject); procedure SpeedRollToTitleClick(Sender: TObject); private function GetNoteTitle(FullFileName: ANSIString): ANSIString; procedure RollBackNote(FileType, Title: string); public NoteFileName : string; // Give me ID, Filename or FullFilename before show. { The EditBox that opened this form, only it can close this form and this form can close that EditBox } ShownBy : TForm; end; var FormRollBack: TFormRollBack; implementation {$R *.lfm} { TFormRollBack } uses LazFileUtils, SyncUtils, Settings, LazLogger, FileUtil, SearchUnit, laz2_DOM, laz2_XMLRead, ResourceStr; procedure TFormRollBack.FormCreate(Sender: TObject); begin Label1.Caption := rsRollBackIntro; end; procedure TFormRollBack.FormShow(Sender: TObject); var ttlName, opnName : string; LCDstr, ErrorStr : string; begin SpeedRollToOpen.Enabled:= False; SpeedRollToTitle.Enabled:= False; LabelttlTitle.Caption := ''; ttlName := ExtractFileNameOnly(NoteFileName); // following must match name mangling rules from TSearchForm.BackupNote() opnName := Sett.NoteDirectory + 'Backup' + PathDelim + copy(ttlName, 1, 32) + '-opn.note'; ttlName := Sett.NoteDirectory + 'Backup' + PathDelim + copy(ttlName, 1, 32) + '-ttl.note'; if FileExistsUTF8(opnName) then begin // should always be there ? LCDStr := GetNoteLastChangeSt(opnName, ErrorStr); if LCDStr = '' then LabelOpn.Caption := ErrorStr else begin LCDStr[11] := ' '; LabelOpn.Caption := rsContentDated + ' ' + copy(LCDStr, 1, 16); LabelOpnTitle.Caption := GetNoteTitle(opnName); SpeedRollToOpen.Enabled := True; end; end; if FileExistsUTF8(ttlName) then begin LCDStr := GetNoteLastChangeSt(ttlName, ErrorStr); if LCDStr = '' then Labelttl.Caption := ErrorStr else begin LCDStr[11] := ' '; Labelttl.Caption := rsContentDated + ' ' + copy(LCDStr, 1, 16); LabelttlTitle.Caption := GetNoteTitle(ttlName); SpeedRollToTitle.Enabled := True; end; end else Labelttl.Caption := rsNotAvailable; end; procedure TFormRollBack.RollBackNote(FileType, Title : string); var FFName : string; LCDStr, ErrorStr : string; begin FFName := Sett.NoteDirectory + 'Backup' + PathDelim + copy(ExtractFileNameOnly(NoteFileName), 1, 32) + FileType + '.note'; if not (RenameFile(FFName, FFName+'-temp') and fileexistsUTF8(FFName+'-temp')) then begin debugln('ERROR, failed to move : ' + FFName); exit; end; TEditBoxForm(ShownBy).SetReadOnly(False); // Prevent a resave ShownBy.Close; // The editBox is a bit slow closing, make sure its disregarded. We did save before opening this form. SearchForm.NoteClosing(ExtractFileNameOnly(NoteFileName)); // Maybe not necessary cos we call UpdateList below ? RenameFileUTF8(NoteFileName, FFName); RenameFileUTF8(FFName+'-temp', NoteFileName); LCDStr := GetNoteLastChangeSt(NoteFileName, ErrorStr); // Hmm, not checking for errors ? SearchForm.UpdateList(Title, LCDStr, NoteFileName, nil); SearchForm.OpenNote(Title, NoteFileName, '', False); close; end; procedure TFormRollBack.SpeedRollToOpenClick(Sender: TObject); begin RollBackNote('-opn', LabelopnTitle.Caption); end; procedure TFormRollBack.SpeedRollToTitleClick(Sender: TObject); begin RollBackNote('-ttl', LabelttlTitle.Caption); end; procedure TFormRollBack.SpeedCancelClick(Sender: TObject); begin close; end; function TFormRollBack.GetNoteTitle(FullFileName : ANSIString) : ANSIString; var Doc : TXMLDocument; Node : TDOMNode; begin Result := 'ERROR, Title Not Found'; if FileExistsUTF8(FullFileName) then begin try try ReadXMLFile(Doc, FullFileName); Node := Doc.DocumentElement.FindNode('title'); Result := Node.FirstChild.NodeValue; except on EXMLReadError do Result := 'Note has no Title '; on EAccessViolation do Result := 'Access Violation ' + FullFileName; end; finally Doc.free; end; end; end; end. tomboy-ng_0.34-1/source/syncgui.lfm0000644000175000017500000001177514145033507017111 0ustar dbannondbannonobject FormSync: TFormSync Left = 957 Height = 418 Top = 257 Width = 699 Caption = 'Sync' ClientHeight = 418 ClientWidth = 699 OnClose = FormClose OnCreate = FormCreate OnHide = FormHide OnShow = FormShow LCLVersion = '2.3.0.0' object Panel1: TPanel AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom Left = 0 Height = 91 Top = 0 Width = 699 Anchors = [akTop, akLeft, akRight] ClientHeight = 91 ClientWidth = 699 TabOrder = 0 object Label1: TLabel Left = 35 Height = 19 Top = 24 Width = 59 Caption = 'Label1' Font.Height = -16 Font.Name = 'Sans' Font.Style = [fsBold] ParentFont = False end object Label2: TLabel Left = 35 Height = 19 Top = 56 Width = 47 Caption = 'Label2' end object LabelProgress: TLabel AnchorSideTop.Control = Label1 AnchorSideRight.Control = Panel1 AnchorSideRight.Side = asrBottom Left = 585 Height = 19 Top = 24 Width = 101 Anchors = [akTop, akRight] BorderSpacing.Right = 12 Caption = 'LabelProgress' end end object Panel2: TPanel AnchorSideLeft.Control = Owner AnchorSideTop.Control = Panel1 AnchorSideTop.Side = asrBottom AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Side = asrBottom Left = 0 Height = 37 Top = 91 Width = 699 Anchors = [akTop, akLeft, akRight] ClientHeight = 37 ClientWidth = 699 TabOrder = 1 object ButtonCancel: TButton AnchorSideLeft.Control = Panel2 AnchorSideTop.Control = Panel2 AnchorSideBottom.Control = Panel2 AnchorSideBottom.Side = asrBottom Left = 1 Height = 35 Top = 1 Width = 150 Anchors = [akTop, akLeft, akBottom] Caption = 'Cancel' OnClick = ButtonCancelClick TabOrder = 0 end object ButtonClose: TButton AnchorSideLeft.Control = ButtonCancel AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel2 AnchorSideBottom.Control = Panel2 AnchorSideBottom.Side = asrBottom Left = 151 Height = 35 Top = 1 Width = 150 Anchors = [akTop, akLeft, akBottom] Caption = 'Close' OnClick = ButtonCloseClick TabOrder = 1 end object ButtonSave: TButton AnchorSideLeft.Control = ButtonClose AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel2 AnchorSideBottom.Control = Panel2 AnchorSideBottom.Side = asrBottom Left = 301 Height = 35 Top = 1 Width = 150 Anchors = [akTop, akLeft, akBottom] Caption = 'Save and Sync' OnClick = ButtonSaveClick TabOrder = 2 end end object Panel3: TPanel AnchorSideLeft.Control = Owner AnchorSideTop.Control = Panel2 AnchorSideTop.Side = asrBottom AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 0 Height = 290 Top = 128 Width = 699 Anchors = [akTop, akLeft, akRight, akBottom] Caption = 'Panel3' ClientHeight = 290 ClientWidth = 699 TabOrder = 2 object Memo1: TMemo AnchorSideLeft.Control = Splitter3 AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel3 AnchorSideRight.Control = Panel3 AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Panel3 AnchorSideBottom.Side = asrBottom Left = 394 Height = 288 Top = 1 Width = 304 Align = alRight Anchors = [akTop, akLeft, akRight, akBottom] Lines.Strings = ( 'Memo1' ) TabOrder = 0 end object Splitter3: TSplitter AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel3 AnchorSideRight.Control = Memo1 AnchorSideBottom.Control = Panel3 AnchorSideBottom.Side = asrBottom Left = 384 Height = 236 Top = 48 Width = 10 Align = alNone Anchors = [] end object ListViewReport: TListView AnchorSideLeft.Control = Panel3 AnchorSideTop.Control = Panel3 AnchorSideRight.Control = Splitter3 AnchorSideBottom.Control = Panel3 AnchorSideBottom.Side = asrBottom Left = 2 Height = 286 Top = 2 Width = 381 Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Left = 1 BorderSpacing.Top = 1 BorderSpacing.Right = 1 BorderSpacing.Bottom = 1 Columns = < item AutoSize = True Caption = 'Action' Width = 53 end item AutoSize = True Caption = 'Title' Width = 40 end item Caption = 'Note ID' Width = 379 end> ReadOnly = True ScrollBars = ssAutoBoth TabOrder = 2 ViewStyle = vsReport end end end tomboy-ng_0.34-1/source/loadnote.pas0000644000175000017500000004434414145033507017240 0ustar dbannondbannonunit LoadNote; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ This unit is responsible for loading a note into the passed Richmemo. The note is expected to be in Tomboy's XML format. Note that the class expects a few things to be passed to it, after creation that it will need before you call LoadNote(). History - 20170928 - showed it how to set the title during loading rather than afterwards. saves about 200mS in a big (20K) file. 20171003 - Added a line in load file to drop any CR (#13) on the floor. Otherwise on Windows, we were reading two newlines, one for the CR and one for the LF. Its not worth an ifdef, we'll only see #13 on windows I assume ? Set the title, as loaded by this unit, to be FontTitle big. ?? 2017/10/07 - enabled bullets. 2017/11/12 - added code to restore < and > 2018/01/31 - and & 2018/03/18 Nothing 2018/03/18 Added a test it AddText to ensure we don't put an empty text block in. Issue #27 2018/07/27 Called ReplaceAngles() on string assigned to Title. 2018/08/15 ReplaceAngles() works with bytes, not char, so don't use UTF8Copy and UTF8Length .... 2018/10/13 Altered LoadFile() so Tabs are allowed through 2019/04/29 Restore note's previous previous position and size. 2019/07/21 Use Sett.TitleColour; 2020/05/01 Stop using local replaceAngles(), use tb_utils.RestoreBadXMLChar() 2021/08/27 Extensive changes to support multilevel bullets, use Tomboy or Conboy model } {$mode objfpc}{$H+} interface uses Classes, SysUtils, KMemo; type { TBLoadNote } TBLoadNote = class private InContent : boolean; FirstTime : boolean; // Set when first line (Title) is added to KMemo Bold : boolean; Italic : boolean; HighLight : boolean; Underline : boolean; Strikeout : boolean; FixedWidth : boolean; //InBullet, BulletOwing : boolean; BulletLevel : integer; InStr : ANSIString; KM : TKMemo; { Is passed an XML tag content, such as bold or /italics and sets up the regional vars so that AddText knows how to markup the next block} procedure ActOnTag(buff: string); { This procedure writes note content to the KMemo in EditBox. It relies on the Global constants (in the Settings Unit) to tell it about style, and size. The Regional InStr has what to write. A number of 'state' regional vars (ie Bold, Strikeout) tell it about the active styles at present. This method adds one textblock (or possibly parablock) from InStr to the kmemo. It gets called when LoadFile() encounters a newline or the start of a Tag.} procedure AddText(AddPara : Boolean); { called when ReadTag encounters a , process through to corresponding including any intermediat pairs. Ignores any newlines in content during this period. Drops any content that is not between tags. We arrive here after having read the first '. Remove trailing newline before returning. InStr should be empty and BulletLevel should be zero.} procedure ReadList(fs: TFileStream); { Gets called when LoadFile finds the start of a tag. It immediatly calls AddText to flush any existing content to Kmemo and then looks at tag.} Procedure ReadTag(fs : TFileStream); public FontSize : integer; // Must be set externally after creation // FontName : ANSIstring; // Must be set externally after creation Title : ANSIString; // Read from the note being loaded. // BulletString : ANSIString; // as above FontNormal : integer; // as above CreateDate : ANSIString; X, Y : integer; Height, Width : integer; { Public : the main, lets do it method } procedure LoadFile(FileName : ANSIString; RM : TKMemo); end; implementation uses Graphics, // For some font style defs LazUTF8, Settings, // User settings and some defines across units. TB_Utils, LazLogger; procedure TBLoadNote.LoadFile(FileName : ANSIString; RM : TKMemo); var fs : TFileStream; ch : char = ' '; Blocks : longint = 0; begin KM := RM; FirstTime := True; fs := TFileStream.Create(Utf8ToAnsi(FileName), fmOpenRead or fmShareDenyNone); try while fs.Position < fs.Size do begin fs.read(ch, 1); if Ch = #13 then fs.read(ch, 1); // drop #13 on floor. Silly Windows double newline. if Ch = #9 then Ch := ' '; // ToDo : this is temp cludge, KMemo cannot handle tabs, they // come in via pasted text, better fix during the paste process. // This might mess with UTF8 ?? if (Ch = '<') or (Ch < ' ') then begin // start of tag or ctrl char if (Ch < ' ') then // thats a newline (other ctrl ? drop on floor) AddText(True) // flush through to kMemo, new paragraph else begin AddText(false); // flush through to kmemo ReadTag(fs); // deals with _only_ tag unless its a list tag ! end; inc(Blocks); InStr := ''; // AddText does that ???? Maybe not in every case ? end else InStr := InStr + ch; end; finally FreeAndNil(fs); end; //debugln('TBLoadNote.LoadFile Height=' + inttostr(Height) + ' Width=' + inttostr(Width)); end; procedure TBLoadNote.AddText(AddPara : Boolean); var FT : TFont; PB : TKMemoParagraph; TB : TKMemoTextBlock ; //T1, T2 : qword; begin if not InContent then exit; if (InStr = '') and (not AddPara) then exit; // if to here, we have content to flush or a new para has been requested. //debugln('TBLoadNote.AddText bulletlevel=' + inttostr(bulletLevel) + ', BOLD=' + booltostr(Bold, true) + ' and InStr=[' + ']'); if InStr <> '' then begin FT := TFont.Create(); if FirstTime then begin // Title FT.Style := [fsUnderline]; //Title := ReplaceAngles(InStr); Title := RestoreBadXMLChar(InStr); // SyncUtils Function FT.Size := Sett.FontTitle; FT.Color := Sett.TitleColour; end else begin FT.Style := []; FT.Size:= FontSize; end; TB := KM.Blocks.AddTextBlock(RestoreBadXMLChar(InStr)); if Bold then FT.Style := FT.Style + [fsBold]; if Italic then FT.Style := FT.Style + [fsItalic]; if HighLight then TB.TextStyle.Brush.Color := Sett.HiColour; if Underline then FT.Style := Ft.Style + [fsUnderline]; if Strikeout then FT.Style := Ft.Style + [fsStrikeout]; if FixedWidth then FT.Name := Sett.FixedFont; if FixedWidth then FT.Pitch := fpFixed; if not FixedWidth then FT.Name := Sett.UsualFont; // Because 'FixedWidth := false;' does not specify a font to return to // if Sett.DarkTheme then Ft.Color:=Sett.DarkTextColour; Ft.Color:=Sett.TextColour; TB.TextStyle.Font := Ft; FT.Free; end; InStr := ''; if AddPara then begin PB := KM.Blocks.AddParagraph; if BulletLevel > 0 then begin {$if declared(pnuCircleBullets)} // Note IDE assumes true, versions of KControls earlier than Late August 2021 are FALSE case BulletLevel of 1 : begin //debugln('AddText - BulletLevel One'); PB.Numbering:=BulletOne; PB.NumberingListLevel.FirstIndent:=-20; // Ahh ! some magic numbers ? PB.NumberingListLevel.LeftIndent := 30; // Note, these numbers need match SettBullet() in editbox end; 2 : begin //debugln('AddText - BulletLevel Two'); PB.Numbering:=pnuNone; PB.Numbering := BulletTwo; PB.NumberingListLevel.FirstIndent:=-20; PB.NumberingListLevel.LeftIndent := 50; end; 3 : begin PB.Numbering:=pnuNone; PB.Numbering := BulletThree; PB.NumberingListLevel.FirstIndent:=-20; PB.NumberingListLevel.LeftIndent := 70; end; 4 : begin PB.Numbering:=pnuNone; PB.Numbering := BulletFour; PB.NumberingListLevel.FirstIndent:=-20; PB.NumberingListLevel.LeftIndent := 90; end; 5 : begin PB.Numbering:=pnuNone; PB.Numbering := BulletFive; PB.NumberingListLevel.FirstIndent:=-20; PB.NumberingListLevel.LeftIndent := 110; end; 6,7,8,9 : begin PB.Numbering:=pnuNone; PB.Numbering := BulletSix; PB.NumberingListLevel.FirstIndent:=-20; PB.NumberingListLevel.LeftIndent := 130; end; otherwise debugln('LoadNote.AddText - BulletLevel otherwise, ' + inttostr(BulletLevel)); // we just stop at 4 end; BulletLevel := 0; {$else} PB.Numbering := pnuBullets; PB.NumberingListLevel.FirstIndent := -20; // Note, these numbers need match SettBullet() in editbox PB.NumberingListLevel.LeftIndent := 30; {$endif} end; end; if FirstTime then begin FirstTime := false; KM.Blocks.DeleteEOL(0); end; end; procedure TBLoadNote.ActOnTag(buff : string); begin case Buff of 'note-content' : InContent := true; '/note-content' : InContent := false; 'bold' : Bold := True; '/bold' : Bold := False; 'italic' : Italic := True; '/italic' : Italic := false; 'highlight' : HighLight := true; '/highlight' : HighLight := false; 'underline' : Underline := true; '/underline' : Underline := false; 'strikeout' : Strikeout := true; '/strikeout' : Strikeout := false; 'monospace' : FixedWidth := true; '/monospace' : FixedWidth := false; 'size:small' : FontSize := Sett.FontSmall; '/size:small' : FontSize := Sett.FontNormal; 'size:large' : FontSize := Sett.FontLarge; '/size:large' : FontSize := Sett.FontNormal; 'size:huge' : FontSize := Sett.FontHuge; '/size:huge' : FontSize := Sett.FontNormal; '/create-date' : CreateDate := InStr; '/x' : X := strtointDef(InStr, 20); '/y' : Y := strtointDef(InStr, 20); '/width' : Width := strtointdef(InStr, 300); '/height' : height := strtointdef(InStr, 200); 'text', 'note' : ; // a block of tags we ignore here. 'x', 'y', 'title', '/title', '?xml', 'last-change-date', '/last-change-date', 'width', 'height', '/text' : ; 'create-date', 'cursor-position', '/cursor-position', 'selection-bound-position', '/selection-bound-position' : ; 'open-on-startup', '/open-on-startup', '/note', 'last-metadata-change-date', '/last-metadata-change-date' : ; 'tag', '/tag', 'tags', '/tags', 'link:broken', '/link:broken' : ; // Note we do not process AND should not get 'list', '/list', 'list-item', '/list-item' here. otherwise debugln('TBLoadNote.ActOnTag ERROR sent an unrecognised tag [' + Buff + ']'); end; end; procedure TBLoadNote.ReadList(fs : TFileStream); var Buff : String; Ch : char = ' '; ST : string = ''; ListCount : integer = 1; function FindNextTag(OnIt : boolean) : boolean; begin Buff := ''; Result := false; if (not OnIt) and (fs.Position < fs.Size) then fs.read(Ch, 1); while fs.Position < fs.Size do begin if ch='<' then break; fs.read(Ch, 1); end; if Ch <> '<' then begin debugln('TBLoadNote.ReadList - ERROR, early exit from FindNextTag'); exit(false); end; while fs.Position < fs.Size do begin // Capture the tag fs.read(Ch, 1); if (Ch = '>') or (Ch = ' ') then break; // end of the content we need. Buff := Buff + ch; end; if Ch in [' ', '>'] then begin while (ch<>'>') and (fs.Position < fs.Size) do begin fs.read(Ch, 1); if Ch = '>' then break; end; Result := Ch = '>'; end else debugln('TBLoadNote.ReadList - ERROR failed to find end of list'); //if result then debugln('FindNextTag = ' + buff ); end; procedure ListSt2KMemo(); var i : integer = 1; ATag : string = ''; begin // debugln('++++++++++ LstSt2KMemo : ' + St); InStr := ''; BulletLevel := ListCount; while i <= St.length do begin if St[i] = '<' then begin // start of a tag while i < St.length do begin inc(i); if St[i] = '>' then break else ATag := ATag + St[i]; end; if St[i] <> '>' then begin debugln('TBLoadNote.ReadList ERROR missing > in ' + St); exit; end; AddText(False); //debugln('call ActOnTag with ' + ATag); ActOnTag(ATag); ATag := ''; inc(i); end else begin InStr := InStr + St[i]; inc(i); end; end; AddText(True); BulletLevel := 0; St := ''; //debugln('++++++++++ Leaving LstSt2KMemo : ' + St); end; begin if (InStr <> '') or (BulletLevel <> 0) then debugln('--------------- Bugger --------------'); // Find the next tag, should always be list-item, ignore anything between //debugln('----------- We have just entered ReadList ---------'); try if FindNextTag(False) and (Buff='list-item') then // Anything up to next list related tag is content. while fs.Position < fs.Size do begin fs.read(Ch, 1); if Ch in [#10, #13] then continue; // ignore newline in list mode if ch='<' then begin if FindNextTag(True) then begin // debugln('ReadList, tag=[' + Buff + '] and St=' + St); case Buff of 'list' : begin if St <> '' then ListSt2KMemo(); inc(ListCount); end; '/list' : if ListCount = 1 then exit else dec(ListCount); '/list-item' : if St <> '' then ListSt2KMemo(); 'list-item' : ; // I THINK we don't need do anything with that ?? otherwise St := St + '<' + Buff + '>'; // put it back where you found it end; end; end else St := St + Ch; end else exit; debugln('TBLoadNote.ReadList - ERROR, hit bottom of method'); finally { We are left here with a trailing newline, remove it but we don't know if the note was created in Unix or Windows } if fs.Position < fs.Size then begin fs.read(Ch, 1); if ch <> #10 then begin // Linux and mac, what we expect if ch = #13 then begin // B8#$# Windows fs.read(Ch, 1); // OK, is probably #13#10 if ch <> #10 then // Woops, stop messing here ! fs.Seek(-1, fsFromCurrent); // That should never happen end else fs.Seek(-1, fsFromCurrent); // note #10, not #13 poke it back and run away ! end; end; //debugln('----------- We have just left ReadList ---------'); end; end; Procedure TBLoadNote.ReadTag(fs : TFileStream); // we are here because '<' var Buff : String; Ch : char = ' '; begin //Addtext(False); // Write the text we have so far with existing params Buff := ''; // now, lets set new params or get other data while fs.Position < fs.Size do begin fs.read(Ch, 1); if (Ch = '>') or (Ch = ' ') then begin // we will exit after case statement // if InContent then debugln('ReadTag - Testing ' + Buff); if Buff = 'list' then ReadList(fs) else begin // debugln('Sending tag to ActOnTag =' + Buff); ActOnTag(Buff); end; while Ch <> '>' do fs.read(Ch, 1); // eat everything else in the tag exit; end; Buff := Buff + Ch; end; end; { When we hit a List or a /list-item, if there is content in InStr, flush it. } end. tomboy-ng_0.34-1/source/tb_sdiff.lfm0000644000175000017500000004254014145033507017202 0ustar dbannondbannonobject FormSDiff: TFormSDiff Left = 784 Height = 481 Top = 157 Width = 645 VertScrollBar.Visible = False Caption = 'A Note Sync Clash has been Detected' ClientHeight = 481 ClientWidth = 645 OnShow = FormShow LCLVersion = '2.1.0.0' object Panel1: TPanel AnchorSideLeft.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = BitBtnUseLocal Left = 2 Height = 50 Top = 389 Width = 643 Anchors = [akLeft, akRight, akBottom] BorderSpacing.Left = 2 ClientHeight = 50 ClientWidth = 643 TabOrder = 0 object LabelRemote: TLabel Left = 140 Height = 19 Top = 6 Width = 95 Caption = 'LabelRemote' ParentColor = False end object LabelLocal: TLabel Left = 140 Height = 19 Top = 24 Width = 74 Caption = 'LabelLocal' ParentColor = False end object Label3: TLabel Left = 11 Height = 19 Top = 6 Width = 124 Caption = 'Remote Changed' ParentColor = False end object Label4: TLabel Left = 11 Height = 19 Top = 24 Width = 103 Caption = 'Local Changed' ParentColor = False end object RadioLong: TRadioButton Left = 488 Height = 23 Hint = 'Maybe necessary to show difference' Top = 24 Width = 100 Caption = 'Long Lines' OnChange = RadioLongChange ParentShowHint = False ShowHint = True TabOrder = 0 end object RadioShort: TRadioButton Left = 488 Height = 23 Hint = 'Easier to read' Top = 1 Width = 104 Caption = 'Short Lines' Checked = True ParentShowHint = False ShowHint = True TabOrder = 1 TabStop = True end end object Label1: TLabel AnchorSideBottom.Control = ButtAllRemote Left = 22 Height = 19 Top = 436 Width = 302 Anchors = [akBottom] Caption = 'Or make a choice for remainder of this run' ParentColor = False end object ButtAllOldest: TButton AnchorSideRight.Control = BitBtnUseRemote AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 284 Height = 25 Top = 455 Width = 101 Anchors = [akRight, akBottom] BorderSpacing.Bottom = 1 Caption = 'Oldest' ModalResult = 11 TabOrder = 1 end object ButtAllNewest: TButton AnchorSideRight.Control = ButtAllOldest AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 184 Height = 25 Top = 455 Width = 100 Anchors = [akRight, akBottom] BorderSpacing.Bottom = 1 Caption = 'Newest' ModalResult = 8 TabOrder = 2 end object ButtAllLocal: TButton AnchorSideRight.Control = ButtAllNewest AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 109 Height = 25 Top = 455 Width = 75 Anchors = [akRight, akBottom] BorderSpacing.Bottom = 1 Caption = 'Local' ModalResult = 9 TabOrder = 3 end object ButtAllRemote: TButton AnchorSideRight.Control = ButtAllLocal AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 34 Height = 25 Top = 455 Width = 75 Anchors = [akRight, akBottom] BorderSpacing.Bottom = 1 Caption = 'Remote' ModalResult = 10 TabOrder = 4 end object BitBtnUseLocal: TBitBtn AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 515 Height = 42 Top = 439 Width = 130 Anchors = [akRight, akBottom] Caption = 'Use Local' Color = clAqua Glyph.Data = { 760B0000424D760B000000000000360000002800000014000000240000000100 200000000000400B000064000000640000000000000000000000FFFF00EAFFFF 00F3FFFF00F3FFFF00F3FFFF00F3FFFF00F3FFFF00F3FFFF00F3FFFF00F3FFFF 00F3FFFF00F3FFFF00F3FFFF00F3FFFF00F3FFFF00F3FFFF00F3FFFF00F3FFFF 00F3FFFF00F3FFFF00EAFFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00EAFFFF00F3FFFF00F3FFFF00F3FFFF00F3FFFF 00F3FFFF00F3FFFF00F3FFFF00F3FFFF00F3FFFF00F3FFFF00F3FFFF00F3FFFF 00F3FFFF00F3FFFF00F3FFFF00F3FFFF00F3FFFF00F3FFFF00EA } ModalResult = 7 TabOrder = 5 end object BitBtnUseRemote: TBitBtn AnchorSideRight.Control = BitBtnUseLocal AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 385 Height = 42 Top = 439 Width = 130 Anchors = [akRight, akBottom] Caption = 'Use Remote' Color = clYellow Glyph.Data = { 760B0000424D760B000000000000360000002800000014000000240000000100 200000000000400B00006400000064000000000000000000000039FFC6EA1DFF E2F31DFFE2F31DFFE2F31DFFE2F31DFFE2F31DFFE2F31DFFE2F31DFFE2F31DFF E2F31DFFE2F31DFFE2F31DFFE2F31DFFE2F31DFFE2F31DFFE2F31DFFE2F31DFF E2F31DFFE2F339FFC6EA1DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F339FFC6EA1DFFE2F31DFFE2F31DFFE2F31DFFE2F31DFF E2F31DFFE2F31DFFE2F31DFFE2F31DFFE2F31DFFE2F31DFFE2F31DFFE2F31DFF E2F31DFFE2F31DFFE2F31DFFE2F31DFFE2F31DFFE2F339FFC6EA } ModalResult = 6 TabOrder = 6 end object KMemo1: TKMemo AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Panel1 Left = 0 Height = 389 Top = 0 Width = 645 Anchors = [akTop, akLeft, akRight, akBottom] ContentPadding.Left = 5 ContentPadding.Top = 5 ContentPadding.Right = 5 ContentPadding.Bottom = 5 ParentFont = False TabOrder = 7 Visible = True OnChange = KMemo1Change end end tomboy-ng_0.34-1/source/rollback.lfm0000644000175000017500000000331714145033507017212 0ustar dbannondbannonobject FormRollBack: TFormRollBack Left = 499 Height = 274 Top = 276 Width = 586 Caption = 'FormRollBack' ClientHeight = 274 ClientWidth = 586 OnCreate = FormCreate OnShow = FormShow LCLVersion = '2.1.0.0' object SpeedCancel: TSpeedButton Left = 25 Height = 32 Top = 82 Width = 200 Caption = 'Cancel' OnClick = SpeedCancelClick end object SpeedRollToOpen: TSpeedButton AnchorSideLeft.Control = SpeedCancel AnchorSideTop.Control = SpeedCancel AnchorSideTop.Side = asrBottom Left = 25 Height = 32 Top = 144 Width = 200 BorderSpacing.Top = 30 Caption = 'Opening Backup' OnClick = SpeedRollToOpenClick end object SpeedRollToTitle: TSpeedButton AnchorSideLeft.Control = SpeedCancel AnchorSideTop.Control = SpeedRollToOpen AnchorSideTop.Side = asrBottom Left = 25 Height = 32 Top = 206 Width = 200 BorderSpacing.Top = 30 Caption = 'Title Change Backup' OnClick = SpeedRollToTitleClick end object LabelOpn: TLabel Left = 248 Height = 19 Top = 157 Width = 68 Caption = 'LabelOpn' ParentColor = False end object Labelttl: TLabel Left = 248 Height = 19 Top = 219 Width = 54 Caption = 'Labelttl' ParentColor = False end object LabelOpnTitle: TLabel Left = 249 Height = 19 Top = 133 Width = 100 Caption = 'LabelOpnTitle' ParentColor = False end object LabelttlTitle: TLabel Left = 249 Height = 19 Top = 192 Width = 86 Caption = 'LabelttlTitle' ParentColor = False end object Label1: TLabel Left = 28 Height = 19 Top = 42 Width = 47 Caption = 'Label1' ParentColor = False end end tomboy-ng_0.34-1/source/k_prn.pas0000644000175000017500000002144014145033507016534 0ustar dbannondbannonunit K_Prn; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ Intended specificially to print tomboy-ng notes but will not too far from a generic (text only) KMemo print unit. Note tomboy-ng won't ever have a blank line at the top, could be messy if you try and print a KMemo with a leading TKMemoParagraph. See KMemoRead() } {$mode objfpc}{$H+} interface uses Classes, SysUtils, Graphics, kmemo; type PWord=^TWord; TWord= record AWord : ANSIString; Size : integer; Bold, Italic, NewLine : boolean; Colour : TColor; end; type { TWordList } TWordList = class(TList) private function Get(Index : Integer) : PWord; public destructor Destroy; Override; procedure Add(TheWord : ANSIString; S : integer; B, I, NL : boolean; Colour : TColor); //function SameStyle(const S1, S2 : integer) : boolean; procedure Dump(); property Items[Index : integer] : PWord read Get; default; end; type { TKPrn } TKPrn = class private FirstLine : Boolean; WordList : TWordList; CurrentY : Integer; MaxY : Integer; LeftEdge, RightEdge : integer; BlankLineHeight : integer; { Determines a suitable height for blank lines } function BlankLineH(): integer; { Copies the interesting font characteristics } procedure CopyFont(FromFont, ToFont: TFont); { Copies the KMemo into WordList, one word per item } function KMemoRead(const TheKMemo: TKMemo) : boolean; { returns the height of higest char in Line between passed params } function LineHeight(const SWord, EWord: integer): integer; { Prints, at CurrentY, the Line between passed params } procedure LinePrint(const SWord, EWord: integer); { Indicates width, in display pixels, of words between passed params } function LineWidth(const SWord, EWord: integer): integer; { set the style of the printer to that of the the Item in WordList } procedure SetPrinter(ItemNo: integer); public { call this to print the KMemo via previously setup Printer } function PrintKmemo(KM1 : TKMemo) : boolean; destructor Destroy; Override; constructor Create(); end; implementation uses Printers, LazUTF8; Const VNudge = 0.85; // Vert align of different font sizes. Small value pulls // larger fonts lower compared to small characters. // So, if big fonts appear to sit above base line, drop // this number down a bit. Margin = 0.05; // Fraction of page width and height reserved for margins. { TLumpList } function TWordList.Get(Index: Integer): PWord; begin Result := PWord(inherited get(Index)); end; destructor TWordList.Destroy; var I : integer; begin for I := 0 to Count-1 do begin dispose(Items[I]); end; inherited Destroy; end; procedure TWordList.Add(TheWord: ANSIString; S: integer; B, I, NL: boolean; Colour : TColor); var PL : PWord; begin new(PL); PL^.AWord:=TheWord; PL^.Size:=S; PL^.Bold:=B; PL^.Italic:=I; PL^.Colour:=Colour; PL^.NewLine:= NL; inherited Add(PL); end; procedure TWordList.Dump(); var I : integer; begin for I := 0 to Count-1 do writeln('NL=' + booltostr(Items[I]^.NewLine, True) + ' [' + Items[I]^.AWord + ']'); end; { ====================== T KPrn ======================= } { TKPrn } function TKPrn.PrintKmemo(KM1: TKMemo): boolean; var StartWord : integer = 0; EndWord : integer = 0; begin if not KMemoRead(KM1) then exit(False); try Printer.BeginDoc; BlankLineHeight := BlankLineH(); while EndWord < WordList.Count do begin inc(Endword); if EndWord = WordList.Count then break; if WordList.Items[EndWord]^.NewLine then begin if WordList.Items[EndWord-1]^.AWord = '' then inc(CurrentY, BlankLineHeight) else LinePrint(StartWord, EndWord); StartWord := EndWord; continue; end; if Linewidth(StartWord, EndWord) > (RightEdge-LeftEdge) then begin dec(EndWord); LinePrint(StartWord, EndWord); StartWord := EndWord; end; end; finally Printer.EndDoc; end; end; destructor TKPrn.Destroy; begin FreeandNil(WordList); inherited Destroy; end; constructor TKPrn.Create(); begin inherited Create(); LeftEdge := round(Printer.PageWidth * Margin); RightEdge := Printer.PageWidth - (2 * LeftEdge); MaxY := round(Printer.PageHeight * (1-(2*Margin))); CurrentY := round(Printer.PageHeight * Margin); FirstLine := True; end; function TKPrn.BlankLineH() : integer; begin Printer.Canvas.Font.Size := 10; Printer.Canvas.Font.Bold := False; Printer.Canvas.Font.Italic := False; Result := Printer.Canvas.TextHeight('I'); end; procedure TKPrn.SetPrinter(ItemNo : integer); begin Printer.Canvas.Font.Size := WordList.Items[ItemNo]^.Size; Printer.Canvas.Font.Color := WordList.Items[ItemNo]^.Colour; Printer.Canvas.Font.Bold := WordList.Items[ItemNo]^.Bold; Printer.Canvas.Font.Italic := WordList.Items[ItemNo]^.Italic; end; // Up to but not inc EWord. procedure TKPrn.LinePrint(const SWord, EWord : integer); var ItemNo, XOffset, YOffset : integer; begin ItemNo := SWord; XOffset := LeftEdge; CurrentY := CurrentY + LineHeight(SWord, EWord); While ItemNo < EWord do begin SetPrinter(ItemNo); YOffset := CurrentY - round(VNudge * Printer.Canvas.TextHeight('I')); // nudge factor to get all sizes font on same baseline Printer.Canvas.TextOut(XOffset, YOffset, WordList.Items[ItemNo]^.AWord); //printer.canvas.Line(XOffset, CurrentY, XOffset + 50, CurrentY); //printer.canvas.Line(XOffset, YOffset, XOffset + 50, YOffset); XOffset := XOffset + Printer.Canvas.TextWidth(WordList.Items[ItemNo]^.AWord); //St := St + WordList.Items[ItemNo]^.AWord; inc(ItemNo); end; if FirstLine then begin printer.canvas.Line(LeftEdge, CurrentY, RightEdge, CurrentY); printer.canvas.Line(LeftEdge, CurrentY+1, RightEdge, CurrentY+1); CurrentY := CurrentY + round(0.5 * BlankLineHeight); FirstLine := False; end; if CurrentY > MaxY then begin Printer.EndDoc; Printer.BeginDoc; CurrentY := round(Printer.PageHeight * Margin); end; // Memo1.Append('Line at ' + inttostr(CurrentY) + '=[' + St + ']'); end; // Up to but not inc EWord. function TKPrn.LineWidth(const SWord, EWord : integer) : integer; var ItemNo : integer; begin Result := 0; ItemNo := SWord; While ItemNo < EWord do begin SetPrinter(ItemNo); Result := Result + Printer.Canvas.TextWidth(WordList.Items[ItemNo]^.AWord); inc(ItemNo); end; end; function TKPrn.LineHeight(const SWord, EWord: integer): integer; var ItemNo : integer; begin ItemNo := SWord; Result := 0; While ItemNo < EWord do begin SetPrinter(ItemNo); if Printer.Canvas.TextHeight('I') > Result then Result := Printer.Canvas.TextHeight('I'); inc(ItemNo); end; Result := Result + Round(0.2 * BlankLineHeight); //writeln('Line Height=' + inttostr(Result)); end; procedure TKPrn.CopyFont(FromFont, ToFont : TFont); begin ToFont.Bold := FromFont.Bold; ToFont.Italic := FromFont.Italic; ToFont.Size := FromFont.Size; ToFont.Color := FromFont.Color; end; function TKPrn.KMemoRead(const TheKMemo : TKMemo) : boolean; var BlockNo : integer = 0; I : integer; ExFont : TFont; St : ANSIString = ''; begin if WordList <> Nil then WordList.Free; WordList := TWordList.Create; ExFont := TFont.Create(); CopyFont(TKMemoTextBlock(TheKmemo.Blocks.Items[0]).TextStyle.Font, ExFont); // Carefull, what if its a Para ? for BlockNo := 0 to TheKMemo.Blocks.Count-1 do begin if not TheKMemo.Blocks.Items[BlockNo].ClassNameIs('TKMemoParagraph') then begin CopyFont(TKMemoTextBlock(TheKmemo.Blocks.Items[BlockNo]).TextStyle.Font, ExFont); for I := 0 to TheKMemo.Blocks.Items[BlockNo].WordCount-1 do begin St := TheKMemo.Blocks.Items[BlockNo].Words[I]; WordList.Add(St, ExFont.Size, ExFont.Bold, ExFont.Italic, False, ExFont.Color); end; end else WordList.Add('', ExFont.Size, ExFont.Bold, ExFont.Italic, True, ExFont.Color); end; FreeandNil(ExFont); result := (WordList.Count > 1); //WordList.Dump(); end; end. tomboy-ng_0.34-1/source/colours.pas0000644000175000017500000000742114145033507017114 0ustar dbannondbannonunit colours; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ A dialog that allows setting of the colours used to display tomboy-ng notes. } {$mode objfpc}{$H+} interface uses Classes, SysUtils, kmemo, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons; type { TFormColours } TFormColours = class(TForm) ColorDialog1: TColorDialog; KMemo1: TKMemo; Label1: TLabel; Label2: TLabel; SpeedTitle: TSpeedButton; SpeedText: TSpeedButton; SpeedBackground: TSpeedButton; SpeedHighlight: TSpeedButton; SpeedDefault: TSpeedButton; SpeedCancel: TSpeedButton; SpeedOK: TSpeedButton; procedure FormCreate(Sender: TObject); procedure FormShow(Sender: TObject); procedure SpeedBackgroundClick(Sender: TObject); procedure SpeedCancelClick(Sender: TObject); procedure SpeedDefaultClick(Sender: TObject); procedure SpeedHighlightClick(Sender: TObject); procedure SpeedOKClick(Sender: TObject); procedure SpeedTextClick(Sender: TObject); procedure SpeedTitleClick(Sender: TObject); private procedure PopulateMemo; public CTitle, CBack, CText, CHiBack : TColor; end; var FormColours: TFormColours; implementation {$R *.lfm} { TFormColours } procedure TFormColours.PopulateMemo; var TB : TKMemoTextBlock; begin KMemo1.Clear(False); KMemo1.Colors.BkGnd:= CBack; TB := KMemo1.Blocks.AddTextBlock('The Title'); TB.TextStyle.Font.Size:= 16; TB.TextStyle.Font.Color:= CTitle; //TB.TextStyle.Brush.Color:= CBack; TB.TextStyle.Font.Underline := true; KMemo1.blocks.AddParagraph(); TB := KMemo1.Blocks.AddTextBlock('Normal Text'); TB.TextStyle.Font.Size:= 11; TB.TextStyle.Font.Color:=CText; //TB.TextStyle.Brush.Color:= CBack; KMemo1.blocks.AddParagraph(); TB := KMemo1.Blocks.AddTextBlock('Some Highlight'); TB.TextStyle.Font.Size:= 11; TB.TextStyle.Font.Color:= CText; TB.TextStyle.Brush.Color:= CHiBack; KMemo1.blocks.AddParagraph(); TB := KMemo1.Blocks.AddTextBlock('More normal Text'); TB.TextStyle.Font.Size:=11; TB.TextStyle.Font.Color:= CText; //TB.TextStyle.Brush.Color:= CBack; KMemo1.blocks.AddParagraph(); end; procedure TFormColours.FormCreate(Sender: TObject); begin { CBack := clCream; CHiBack := clYellow; CText := clBlack; CTitle := clBlue; } end; procedure TFormColours.FormShow(Sender: TObject); begin PopulateMemo; left := (screen.Width div 2) - (width div 2); top := (screen.Height div 2) - (width div 2); end; procedure TFormColours.SpeedBackgroundClick(Sender: TObject); begin ColorDialog1.Color := CBack; if ColorDialog1.Execute then begin CBack := ColorDialog1.Color; PopulateMemo; end; end; procedure TFormColours.SpeedCancelClick(Sender: TObject); begin ModalResult := mrCancel; end; procedure TFormColours.SpeedDefaultClick(Sender: TObject); begin ModalResult := mrRetry; end; procedure TFormColours.SpeedHighlightClick(Sender: TObject); begin ColorDialog1.Color := CHiBack; if ColorDialog1.Execute then begin CHiBack := ColorDialog1.Color; PopulateMemo; end; end; procedure TFormColours.SpeedOKClick(Sender: TObject); begin ModalResult:=mrOK; end; procedure TFormColours.SpeedTextClick(Sender: TObject); begin ColorDialog1.Color := CText; if ColorDialog1.Execute then begin CText := ColorDialog1.Color; PopulateMemo; end; end; procedure TFormColours.SpeedTitleClick(Sender: TObject); begin ColorDialog1.Color := CTitle; if ColorDialog1.Execute then begin CTitle := ColorDialog1.Color; PopulateMemo; end; end; end. tomboy-ng_0.34-1/source/markdown.pas0000644000175000017500000003613214145033507017251 0ustar dbannondbannonunit markdown; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ This unit converts a note to markdown format. HISTORY 2018/12/05 This unit is pleased to serve. 2018/12/06 Fixed a bug in Addtag, if Buff is only spaces. 2019/05/14 Display strings all (?) moved to resourcestrings 2019/09/27 Added SmallFont, actually subscript because markdown does not do a small font. 2020/01/22 Enabled sending md to clipboard and saving to a file. 2021/01/25 Remove special char from filename when exporting to file. 2021/01/29 Use TB_Utils/TB_MakeFileName when exporting } // ToDo : replace this with one from TomboyTools, it does a better standard. Might be // included in the nextCloud Notes version if it ever makes it here. {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, KMemo; type { TFormMarkdown } TFormMarkdown = class(TForm) ButtonClose: TButton; ButtonCopyAll: TButton; ButtonSave: TButton; Label1: TLabel; Memo1: TMemo; Panel1: TPanel; SaveDialog1: TSaveDialog; procedure ButtonCloseClick(Sender: TObject); procedure ButtonCopyAllClick(Sender: TObject); procedure ButtonSaveClick(Sender: TObject); procedure FormActivate(Sender: TObject); procedure FormShow(Sender: TObject); private FSize : integer; SmallFont : boolean; Bold : boolean; Italics : boolean; HiLight : boolean; Underline : boolean; Strikeout : boolean; FixedWidth : boolean; PrevFSize : integer; PrevBold : boolean; PrevItalics : boolean; PrevHiLight : boolean; PrevUnderline : boolean; PrevStrikeout : boolean; PrevFixedWidth : boolean; PrevSmallFont : boolean; //InList : boolean; function AddCodeBlock(var BlkNo: integer): string; function AddHeading(BlkNo: integer): string; function AddTag(const FT: TKMemoTextBlock; var Buff: ANSIString; CloseOnly: boolean=False): ANSIString; procedure CopyLastFontAttr(); procedure DisplayMarkDown(); function GetNextTextBlock(const BlkNo: integer): integer; public TheKMemo : TKMemo; end; var FormMarkdown: TFormMarkdown; implementation uses settings, Clipbrd, TB_Utils; {$R *.lfm} { TFormMarkdown } procedure TFormMarkdown.FormShow(Sender: TObject); begin {$ifdef DARWIN} Label1.Caption := 'Press Cmd-A, Cmd-C to copy'; {$endif} end; procedure TFormMarkdown.ButtonCloseClick(Sender: TObject); begin close; end; procedure TFormMarkdown.ButtonCopyAllClick(Sender: TObject); begin Clipboard.astext := Memo1.text; end; procedure TFormMarkdown.ButtonSaveClick(Sender: TObject); //var //TempFName : string; begin SaveDialog1.DefaultExt := 'md'; {$ifdef UNIX} SaveDialog1.InitialDir := GetEnvironmentVariable('HOME'); {$endif} {$ifdef WINDOWS} SaveDialog1.InitialDir := GetEnvironmentVariable('HOMEPATH'); {$endif} {TempFName := StringReplace(Caption, #32, '', [rfReplaceAll]); TempFName := StringReplace(TempFName, '/', '_', [rfReplaceAll]); TempFName := StringReplace(TempFName, '\', '_', [rfReplaceAll]); TempFName := StringReplace(TempFName, '*', '_', [rfReplaceAll]);} SaveDialog1.Filename := TB_MakeFileName(Caption); //SaveDialog1.Filename := TempFName + '.' + 'md'; if SaveDialog1.Execute then Memo1.Lines.SaveToFile(SaveDialog1.Filename); end; procedure TFormMarkdown.FormActivate(Sender: TObject); begin Memo1.Clear; DisplayMarkDown(); end; procedure TFormMarkdown.CopyLastFontAttr(); begin PrevSmallFont := SmallFont; PrevFSize := FSize; PrevBold := Bold; PrevItalics := Italics; PrevHiLight := HiLight; PrevUnderline := Underline; PrevStrikeout := Strikeout; PrevFixedWidth := FixedWidth; PrevFSize := FSize; end; function TFormMarkdown.GetNextTextBlock(const BlkNo : integer) : integer; begin Result := BlkNo; while Result < TheKmemo.Blocks.Count do begin if (TheKMemo.Blocks.Items[Result].ClassNameIs('TKMemoTextBlock') or TheKMemo.Blocks.Items[Result].ClassNameIs('TKMemoHyperlink')) and (TKMemoTextBlock(TheKMemo.Blocks.Items[Result]).Text <> '') then exit(Result); inc(Result); end; Result := 0; end; procedure TFormMarkdown.DisplayMarkDown(); var Buff : ANSIstring = ''; BlockNo : integer = 0; Block : TKMemoBlock; NextBlock : integer; begin SmallFont := false; Bold := false; Italics := False; HiLight := False; FixedWidth := False; try try repeat if BlockNo >= TheKMemo.Blocks.Count then break; Buff := AddHeading(BlockNo); if Buff <> '' then begin Memo1.Append(Buff); inc(BlockNo, 2); continue; end; Buff := AddCodeBlock(BlockNo); // carefull, we fiddle blockno in there .... if Buff <> '' then begin Memo1.Append(Buff); continue; end; CopyLastFontAttr(); while not TheKMemo.Blocks.Items[BlockNo].ClassNameIs('TKMemoParagraph') do begin Block := TheKmemo.Blocks.Items[BlockNo]; if Block.ClassNameIs('TKMemoTextBlock') then begin if Block.Text.Length > 0 then begin AddTag(TKMemoTextBlock(Block), Buff); Buff := Buff + Block.Text; end; end; if Block.ClassNameIs('TKMemoHyperlink') then Buff := Buff + Block.Text; // debugln('Block=' + inttostr(BlockNo) + ' ' +BlockAttributes(Block)); inc(BlockNo); if BlockNo >= TheKMemo.Blocks.Count then break; end; // At this stage, BlockNo points to either a Paragraph marker or beyond items if BlockNo < TheKMemo.Blocks.Count then if TKMemoParagraph(TheKMemo.Blocks.Items[BlockNo]).Numbering = pnuBullets then Buff := '* ' + Buff; NextBlock := GetNextTextBlock(BlockNo); if NextBlock > 0 then AddTag(TKMemoTextBlock(TheKMemo.Blocks.Items[NextBlock]), Buff, True); Memo1.Append(Buff); inc(BlockNo); if BlockNo >= TheKMemo.Blocks.Count then break; until false; { At this point we may have unsaved content in Buff cos last block was not a Para. But it cannot be Bullet. If it was a Para, Buff is empty. But we could still have hanging xml tags. So either case, send it to add tag with an empty Font. } Buff := ''; if SmallFont then Buff := ''; if Bold then Buff := Buff + '**'; if Italics then Buff := Buff + '_'; //if HiLight then Buff := Buff + ''; //if Underline then Buff := Buff + ''; if Strikeout then Buff := Buff + '~~'; if FixedWidth then Buff := Buff + #10'```'#10; // if FSize <> Sett.FontNormal then // Buff := Buff + SetFontXML(FSize, False); if length(Buff) > 0 then Memo1.Append(Buff); Except on EListError do begin Memo1.Append(Buff); end; end; finally end; end; // Called on first block after a paragraph marker, deals with single block, whole para in monospace // Must be one block followed by paragaraph marker. If it cannot help, returns empty string. // Assumes an para that starts with Mono font is all code. No arguments ! // Sequential mono paras are kept together as long as nothing between them. function TFormMarkDown.AddCodeBlock(var BlkNo : integer) : string; var Found : integer = 0; Starting : integer; begin Starting := BlkNo; Result := #10'```'#10; while TheKMemo.Blocks.Items[BlkNo].ClassNameIs('TKMemoTextBlock') and (TKMemoTextBlock(TheKMemo.Blocks.Items[BlkNo]).TextStyle.Font.Pitch = fpFixed) do begin inc(Found); while TheKMemo.Blocks.Items[BlkNo].ClassNameIs('TKMemoTextBlock') do begin Result := Result + TKmemoTextBlock(TheKMemo.Blocks.Items[BlkNo]).Text; inc(BlkNo); if BlkNo >= TheKmemo.Blocks.Count then break; end; if BlkNo >= TheKmemo.Blocks.Count then break; // OK, if to here, we must be on a para marker, end of that line. Result := Result + #10; inc(BlkNo); // step over the para marker end; // BlkNo is now pointing to block after the para marker at end of a mono para // or, possibly its pointing beyond kmemo and maybe we did not find a Mono para ? if Found > 0 then Result := Result + #10'```'#10 else begin Result := ''; BlkNo := Starting; // I didn't mess with it .... end; end; // Called on first block after a paragraph marker, deals with larger fonts that are headers // Must be one block followed by paragaraph marker. If it cannot help, returns empty string. function TFormMarkdown.AddHeading(BlkNo : integer) : string; begin Result := ''; if TheKMemo.Blocks.Items[BlkNo].ClassNameIs('TKMemoTextBlock') and ((BlkNo +1) < TheKMemo.Blocks.Count) and TheKMemo.Blocks.Items[BlkNo+1].ClassNameIs('TKMemoParagraph') then begin // OK, its a single block line. But is it a heading ? if TKmemoTextBlock(TheKMemo.Blocks.Items[BlkNo]).TextStyle.Font.Size = Sett.FontTitle then Result := '# ' + TKmemoTextBlock(TheKMemo.Blocks.Items[BlkNo]).Text; if TKmemoTextBlock(TheKMemo.Blocks.Items[BlkNo]).TextStyle.Font.Size = Sett.FontHuge then Result := '## ' + TKmemoTextBlock(TheKMemo.Blocks.Items[BlkNo]).Text; if TKmemoTextBlock(TheKMemo.Blocks.Items[BlkNo]).TextStyle.Font.Size = Sett.FontLarge then Result := '### ' + TKmemoTextBlock(TheKMemo.Blocks.Items[BlkNo]).Text; end; end; // AddTag deals with markup that has a pre and post componet, ie **Bold** function TFormMarkdown.AddTag(const FT : TKMemoTextBlock; var Buff : ANSIString; CloseOnly : boolean = False) : ANSIString; var BorrowedSpaces : integer = 0; begin // Important that we keep the tag order consistent. Good xml requires no cross over // tags. If the note is to be readable by Tomboy, must comply. (EditBox does not care) // Tag order - // FontSize HiLite Ital Bold Bullet TEXT BulletOff BoldOff ItalOff HiLiteOff FontSize // Processing Order is the reverse - // ListOff BoldOff ItalicsOff HiLiteOff FontSize HiLite Ital Bold List //debugln(BlockAttributes(FT)); // When Bold Turns OFF if Buff <> '' then // remove, temporarly, any trailing spaces while Buff[length(Buff)] = ' ' do begin inc(BorrowedSpaces); delete(Buff, length(Buff), 1); if Buff = '' then break; end; if CloseOnly then begin // In closeonly mode, we are just shuttig them all done prior to newline if Bold then begin Buff := Buff + '**'; Bold := false; end; if Italics then begin Buff := Buff + '_'; Italics := false; end; if Strikeout then begin Buff := Buff + '~~'; Strikeout := false; end; if FixedWidth then begin Buff := Buff + '`'; FixedWidth := False; end; if SmallFont then begin Buff := Buff + ''; SmallFont := False; end; end; // Normal mode. // When smallfont turns off if (SmallFont and (FT.TextStyle.Font.Size <> Sett.FontSmall)) then begin Buff := Buff + ''; SmallFont := False; end; if (Bold and (not (fsBold in FT.TextStyle.Font.Style))) then begin Buff := Buff + '**'; Bold := false; end; // When Italic turns OFF if (Italics and (not (fsItalic in FT.TextStyle.Font.Style))) then begin if Bold then Buff := Buff + '**'; Buff := Buff + '_'; if Bold then Buff := Buff + '**'; Italics := false; end; // When Strikeout turns OFF if (Strikeout and (not (fsStrikeout in FT.TextStyle.Font.Style))) then begin if Bold then Buff := Buff + '**'; if Italics then Buff := Buff + '_'; Buff := Buff + '~~'; if Italics then Buff := Buff + '_'; if Bold then Buff := Buff + '**'; Strikeout := false; end; // Full para fixed with is already looked after, here we deal with bits in an a para // When FixedWidth turns OFF //if (FixedWidth <> (FT.TextStyle.Font.Pitch = fpFixed) or (FT.TextStyle.Font.Name = MonospaceFont)) then begin if (FixedWidth and ((FT.TextStyle.Font.Pitch <> fpFixed) {or (FT.TextStyle.Font.Name <> MonospaceFont)})) then begin if Bold then Buff := Buff + '**'; if Italics then Buff := Buff + '_'; if Strikeout then Buff := Buff + '~~'; Buff := Buff + '`'; if Strikeout then Buff := Buff + '~~'; if Italics then Buff := Buff + '_'; if Bold then Buff := Buff + '**'; FixedWidth := false; end; while BorrowedSpaces > 0 do begin Buff := Buff + ' '; dec(BorrowedSpaces); end; if CloseOnly then exit(Buff); // FixedWidth turns ON if ((not FixedWidth) and ((FT.TextStyle.Font.Pitch = fpFixed))) then begin if Bold then Buff := Buff + '**'; if Italics then Buff := Buff + '_'; if Strikeout then Buff := Buff + '~~'; Buff := Buff + '`'; if Strikeout then Buff := Buff + '~~'; if Italics then Buff := Buff + '_'; if Bold then Buff := Buff + '**'; FixedWidth := true; end; // Strikeout turns ON if ((not Strikeout) and (fsStrikeout in FT.TextStyle.Font.Style)) then begin if Bold then Buff := Buff + '**'; if Italics then Buff := Buff + '_'; Buff := Buff + '~~'; if Italics then Buff := Buff + '_'; if Bold then Buff := Buff + '**'; Strikeout := true; end; // Italic turns On if ((not Italics) and (fsItalic in FT.TextStyle.Font.Style)) then begin if Bold then Buff := Buff + '**'; Buff := Buff + '_'; if Bold then Buff := Buff + '**'; Italics := true; end; // Bold turns On if ((not Bold) and (fsBold in FT.TextStyle.Font.Style)) then begin Buff := Buff + '**'; Bold := true; end; // SmallFont turns on if ((not SmallFont) and (FT.TextStyle.Font.Size = Sett.FontSmall)) then begin Buff := Buff + ''; SmallFont := True; end; Result := Buff; end; end. tomboy-ng_0.34-1/source/tomdroidfile.pas0000644000175000017500000004134314145033507020110 0ustar dbannondbannonunit tomdroidFile; {$mode objfpc}{$H+} { This unit is opened by the user, it tries to find the gio/gvfs mtp directory that contains $MTPDIR/Phone/tomdroid/tomboy.serverid. It may find - 1. No mtp directory - likely the device is not connected. 2. A $mtpdir/Phone - Its connected but tomdroid is not configured to dump sync files in /storage/emulated/0/tomdroid - rsInstallTomdroid 3. A $mtpdir/Phone/tomdroid - Its ready to create a new repo. 4. A $mtpdir/Phone/tomboy.serverid - Its ready to sync as an existing repo, We do not need to save repo details in config file, if we have local manifest that matches the serverid we found, we are good to go. If we don't have a manifest that matches, we must not proceed, it might do very bad things, we should offer user a chance to do a JOIN instead (with appropriate warnings). } { HISTORY 2018/12/06 Added AdjustNoteList() to call ProcessSyncUpdates at end of a sync 2018/04/28 Ensure user does not save profile after a Test run, the ID will change. 2019/05/14 Display strings all (?) moved to resourcestrings 2020/07/09 New help notes location. 2021/01/04 Refocused on to USB cable based transport. } interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls, StdCtrls, ExtCtrls, Grids, LCLIntf, SyncUtils; // For TClashRec type { TFormTomdroidFile } TFormTomdroidFile = class(TForm) ButtonOldSSH: TButton; ButtonClose: TButton; ButtonJoin: TButton; ButtonHelp: TButton; ButtonSync: TButton; CheckBoxTestRun: TCheckBox; Label1: TLabel; Label6: TLabel; LabelAdvice2: TLabel; LabelAdvice1: TLabel; LabelAdvice: TLabel; Memo1: TMemo; Panel1: TPanel; Panel2: TPanel; PanelAdvice: TPanel; Splitter1: TSplitter; StringGridReport: TStringGrid; procedure ButtonHelpClick(Sender: TObject); procedure ButtonJoinClick(Sender: TObject); procedure ButtonOldSSHClick(Sender: TObject); procedure ButtonSyncClick(Sender: TObject); procedure FormShow(Sender: TObject); private //ServerID : string; // Keep copies to see if user changed after selection procedure AdjustNoteList(); procedure CheckStatus(); procedure DisplaySync(); procedure DoNewSync(); function GetLocalManifestDateS(ID: string): string; function Proceed(const ClashRec: TClashRecord): TSyncAction; procedure ShowReport(); function DoSync(): boolean; public end; var FormTomdroidFile: TFormTomdroidFile; implementation {$R *.lfm} { TFormTomdroidFile } uses Settings, Sync, TB_SDiff, typInfo, LazLogger, LCLType, LazFileUtils, laz2_DOM, laz2_XMLRead, SearchUnit // we call ProcessSyncUpdates( and ShowHelpNote( , Tomdroid; // For the old, legacy ssh based version of this RESOURCESTRING // ToDo : once the ssh based tomdroid sync is removed, we could move the active rs to Resourcestr file ? rsSetUpNewSync ='Setting up a new sync ....'; // file rsFailedToConnect = 'Failed to connect.'; // file rsTalking = 'OK, talking to device. Wait for it ....'; rsNoTomdroid = 'Unable to find Tomdroid sync dir on that device.'; // file rsInstallTomdroid = 'Install Tomdroid, config filesync, and run a sync'; // file rsNoConnection = 'Failed to establish a connection. '; // file rsFixConnection = 'If you are sure its there, check settings.'; // file rsConnectionGood = 'Connection is looking Good.'; // file // rsCheckingForExistingSync = 'Checking for an existing sync ....'; // rsTalkingToDevice = 'OK, talking to device. Wait for it ....'; rsNotExistingRepo = 'That''s not an existing Repo, maybe click "Join" ?'; // file rsNotCorrectProfile = 'This is not correct profile for that device'; // rsFailedToFindConnection_1 = 'Failed to find an existing connection.'; rsFailedToFindConnection_2 = 'If you are sure there should be an existing connection, check settings.'; // file // rsFailedToFindConnection_3 = 'Otherwise, try joining a new connection.'; rsHaveValidSync = 'Looking Good. Last sync date '; // file // New items in this unit rsJoinAnyway = 'Forcing a Join may "recover" some notes you thought you have deleted.'; // file // Maybe some resourcestrings are defined in syncUtils.pas ?? var ASync : TSync; procedure TFormTomdroidFile.CheckStatus(); begin ASync := TSync.Create({DebugMode}); ASync.NotesDir := Sett.NoteDirectory; ASync.ConfigDir := Sett.LocalConfig; ASync.DebugMode := Application.HasOption('s', 'debug-sync'); ASync.RepoAction:= RepoJoin; ButtonHelp.SetFocus; case Async.SetTransport(SyncFileAndroid) of SyncReady : // We found a server id, but does it match a manifest ? if FileExistsUTF8(Sett.LocalConfig + 'android' + pathdelim + copy(Async.LocalServerID, 1, 13) + 'manifest.xml') then begin ButtonClose.Enabled := True; ButtonSync.Enabled := True; ButtonJoin.Enabled := False; LabelAdvice1.Caption := rsHaveValidSync + GetLocalManifestDateS(Async.LocalServerID); LabelAdvice2.Caption := Async.LocalServerID; ButtonSync.SetFocus; end else begin debugln('ID mismatch, local manifest ' + Sett.LocalConfig + 'android' + pathdelim + copy(Async.LocalServerID, 1, 13) + 'manifest.xml'); ButtonClose.Enabled := True; ButtonSync.Enabled := False; ButtonJoin.Enabled := True; LabelAdvice1.Caption := rsNotCorrectProfile; LabelAdvice2.Caption := rsJoinAnyway; end; SyncNoRemoteRepo : begin // We found the necessary dir but it has not been used before. ButtonClose.Enabled := True; ButtonSync.Enabled := False; ButtonJoin.Enabled := True; LabelAdvice1.Caption := rsNotExistingRepo; LabelAdvice2.Caption := rsFailedToFindConnection_2; ButtonJoin.SetFocus; Memo1.append(ASync.SyncAddress); end; SyncNoRemoteDir : begin // Dir is not there, maybe no device connected ? ButtonClose.Enabled := True; ButtonSync.Enabled := False; ButtonJoin.Enabled := False; LabelAdvice1.Caption := rsNoTomdroid; LabelAdvice2.Caption := rsInstallTomdroid; Memo1.append(ASync.SyncAddress); end; end; ASync.Free; end; function TFormTomdroidFile.GetLocalManifestDateS(ID : string) : string; var Doc : TXMLDocument; Node : TDOMNode; begin ReadXMLFile(Doc, Sett.LocalConfig + 'android' + pathdelim + copy(ID, 1, 13) + 'manifest.xml'); Node := Doc.DocumentElement.FindNode('last-sync-date'); if assigned(Node) then begin Result := copy(Node.FirstChild.NodeValue, 1, 19); end else Result := 'Failed to get LSD'; Doc.Free; end; procedure TFormTomdroidFile.FormShow(Sender: TObject); begin //debugln('Tomdroid screen OnShow event'); left := (screen.Width div 2) - (width div 2); top := (screen.Height div 2) - (height div 2); Memo1.Clear; StringGridReport.Clear; CheckStatus(); end; procedure TFormTomdroidFile.ButtonHelpClick(Sender: TObject); begin SearchForm.ShowHelpNote('tomdroid.note'); end; { --------------- S C R E E N F U N C T I O N S ---------------------------} //RESOURCESTRING // rsSelectProfile = 'Select a profile'; { --------------- S Y N C R E L A T E D F U N C T I O N S ----------------} procedure TFormTomdroidFile.ButtonSyncClick(Sender: TObject); begin ButtonSync.Enabled := false; ButtonClose.Enabled := False; DoSync(); ButtonClose.Enabled := True; end; procedure TFormTomdroidFile.DoNewSync(); var Tick1, Tick2, Tick3, Tick4 : QWord; begin Memo1.clear; StringGridReport.Clear; Memo1.append(rsSetUpNewSync); Application.ProcessMessages; try ASync := TSync.Create(); ASync.DebugMode := Application.HasOption('s', 'debug-sync'); ASync.TestRun := CheckBoxTestRun.Checked; ASync.ProceedFunction:=@Proceed; ASync.NotesDir:= Sett.NoteDirectory; ASync.ConfigDir := Sett.LocalConfig; ASync.SyncAddress := ''; // ASync.LocalServerID := LabelServerID.Caption; // Only do this for Tomdroid Use! ASync.RepoAction:= RepoJoin; ASync.Password:= ''; Tick1 := GetTickCount64(); if SyncNetworkError = Async.SetTransport(SyncFileAndroid) then begin // will set sync.manprefix, is sync.localserverID set ? memo1.append(rsFailedToConnect + ' ' + ASync.ErrorString); exit(); end; Memo1.Append(rsTalking); Application.ProcessMessages; Tick2 := GetTickCount64(); case ASync.TestConnection() of SyncNoRemoteDir : begin Memo1.append(rsNoTomdroid ); Memo1.append(rsInstallTomdroid); Memo1.Append(ASync.Errorstring); exit(); end; SyncNetworkError : begin Memo1.Append(rsNoConnection + ' ' + ASync.ErrorString); memo1.append(rsFixConnection); exit(); end; SyncReady, SyncNoRemoteRepo : ; // For TransFileAnd its SyncNoRemoteRepo else begin showmessage(ASync.ErrorString); exit(); end; end; // If to here, sync should be enabled and know about remote files it might need. Memo1.append(rsConnectionGood); Memo1.append(rsNextBitSlow); Application.ProcessMessages; Tick3 := GetTickCount64(); ASync.StartSync(); //LabelServerID.Caption := ASync.LocalServerID; Tick4 := GetTickCount64(); DisplaySync(); memo1.Append('Set=' + inttostr(Tick2 - Tick1) + 'mS Test=' + inttostr(Tick3 - Tick2) + 'mS Sync=' + inttostr(Tick4 - Tick3) + 'mS '); ShowReport(); AdjustNoteList(); finally ASync.Free; end; if not CheckBoxTestRun.Checked then // don't write a config if its only a test run. ; // do something here ?? end; procedure TFormTomdroidFile.AdjustNoteList(); var DeletedList, DownList : TStringList; Index : integer; begin DeletedList := TStringList.Create; DownList := TStringList.Create; with ASync.RemoteMetaData do begin for Index := 0 to Count -1 do begin if Items[Index]^.Action = SyDeleteLocal then DeletedList.Add(Items[Index]^.ID); if Items[Index]^.Action = SyDownload then DownList.Add(Items[Index]^.ID); end; end; if (DeletedList.Count > 0) or (DownList.Count > 0) then SearchForm.ProcessSyncUpdates(DeletedList, DownList); FreeandNil(DeletedList); FreeandNil(DownList); end; procedure TFormTomdroidFile.ButtonJoinClick(Sender: TObject); begin ButtonJoin.Enabled := False; DoNewSync(); ButtonSync.Enabled := True; end; procedure TFormTomdroidFile.ButtonOldSSHClick(Sender: TObject); var TomdroidForm : TFormTomdroid; begin TomdroidForm := TFormTomdroid.Create(self); TomdroidForm.ShowModal; TomdroidForm.Free; end; procedure TFormTomdroidFile.DisplaySync(); var UpNew, UpEdit, Down, DelLoc, DelRem, Clash, DoNothing, Errors : integer; begin ASync.ReportMetaData(UpNew, UpEdit, Down, DelLoc, DelRem, Clash, DoNothing, Errors); Memo1.Append(rsNewUploads + inttostr(UpNew)); Memo1.Append(rsEditUploads + inttostr(UpEdit)); Memo1.Append(rsDownloads + inttostr(Down)); Memo1.Append(rsLocalDeletes + inttostr(DelLoc)); Memo1.Append(rsRemoteDeletes + inttostr(DelRem)); Memo1.Append(rsClashes + inttostr(Clash)); Memo1.Append(rsDoNothing + inttostr(DoNothing)); end; procedure TFormTomdroidFile.ShowReport(); var Index : integer; Rows : integer = 0; begin StringGridReport.Clean; with ASync.RemoteMetaData do begin for Index := 0 to Count -1 do begin if Items[Index]^.Action <> SyNothing then begin StringGridReport.InsertRowWithValues(Rows , [ASync.RemoteMetaData.ActionName(Items[Index]^.Action) , Items[Index]^.Title, Items[Index]^.ID]); inc(Rows); end; end end; StringGridReport.AutoSizeColumn(0); StringGridReport.AutoSizeColumn(1); if Rows = 0 then Memo1.Append(rsNoNotesNeededSync); Memo1.Append(inttostr(ASync.RemoteMetaData.Count) + rsNotesWereDealt); end; function TFormTomdroidFile.DoSync() : boolean; var Tick1, Tick2, Tick3, Tick4 : DWord; begin Memo1.clear; StringGridReport.Clear; //Memo1.append(rsCheckingForExistingSync); // no point .... //Application.ProcessMessages; try ASync := TSync.Create(); ASync.DebugMode := Application.HasOption('s', 'debug-sync'); ASync.TestRun := CheckBoxTestRun.Checked; ASync.ProceedFunction:=@Proceed; ASync.NotesDir:= Sett.NoteDirectory; ASync.ConfigDir := Sett.LocalConfig; ASync.SyncAddress := ''; ASync.RepoAction:= RepoUse; ASync.Password:= ''; Tick1 := GetTickCount64(); if SyncNetworkError = Async.SetTransport(SyncFileAndroid) then begin // this just pings remote dev memo1.append(rsFailedToConnect + ASync.ErrorString); exit(false); end; // Memo1.Append(rsTalkingToDevice); // Application.ProcessMessages; Tick2 := GetTickCount64(); case ASync.TestConnection() of // SyncXMLError, SyncNoRemoteWrite, SyncNoRemoteDir : SyncNoLocal : begin Memo1.Append(ASync.ErrorString); Memo1.Append('Sync is cancelled'); exit(False); end; // That may be caused by a previous failure to complete a Join or New, look for bad notes perhaps ? SyncNoRemoteRepo : begin Memo1.Append(rsNotExistingRepo); exit(False); end; { SyncMisMatch : begin Memo1.Append(rsNotCorrectProfile); exit(False); end; } { SyncNetworkError : begin Memo1.Append(rsFailedToFindConnection_1 + ASync.ErrorString); memo1.append(rsFailedToFindConnection_2); memo1.append(rsFailedToFindConnection_3); exit(false); end; } SyncReady : ; else begin showmessage(ASync.ErrorString); exit(False); end; end; // If to here, sync should be enabled and know about remote files it might need. Memo1.append(rsHaveValidSync + ASync.LocalLastSyncDateSt); Memo1.append(rsNextBitSlow); Application.ProcessMessages; Tick3 := GetTickCount64(); ASync.StartSync(); Tick4 := GetTickCount64(); DisplaySync(); memo1.Append('Set=' + inttostr(Tick2 - Tick1) + 'mS Test=' + inttostr(Tick3 - Tick2) + 'mS Sync=' + inttostr(Tick4 - Tick3) + 'mS '); ShowReport(); AdjustNoteList(); finally ASync.Free; end; result := True; end; function TFormTomdroidFile.Proceed(const ClashRec : TClashRecord) : TSyncAction; var SDiff : TFormSDiff; Res : integer; begin result := SyDownload; SDiff := TFormSDiff.Create(self); SDiff.RemoteFilename := ClashRec.ServerFileName; SDiff.LocalFilename := ClashRec.LocalFileName; Res := SDiff.ShowModal; case Res of mrYes : Result := SyDownLoad; mrNo : Result := SyUpLoadEdit; mrNoToAll : Result := SyAllLocal; mrYesToAll : Result := SyAllRemote; mrAll : Result := SyAllNewest; mrClose : Result := SyAllOldest; end; SDiff.Free; Application.ProcessMessages; // so dialog goes away while remainder are being processed. end; end. tomboy-ng_0.34-1/source/Tomboy_NG.res0000644000175000017500000002636414145033507017300 0ustar dbannondbannon   True false 0MAINICON00 %% (0` $ddo o o+p{  to)o o  po oKy   ~oGop     rooo\|    oXooq    sooon   oloo+s %**#uo)oo  9VGJHGM/ o~oo9v  -I?:53.*$)!wo7o o  3'$##%%$$#%#&- po oIy  +2,-/137679:~:x;s;l8j<{&zoFop  LT_hfU?& $.9< qo os 3_XVXRt}iR::FD=;A, usL PX[Z]__]d{PILH@@<:9wg  3WW]^bdffdb^i\TTSMLJB>633*  LRX[]aaeiijfggb```\YYURMJC>;72..  3QNRWaagdhjjlnmjljdaba^XVQLFA=55-&%% DILPWZ^ecijnnpvsnrolifa`ZUPLIB>83+)"!'  /@BJOQW\]fkgkssrquqronlfc_]WRNHB@55-+$!!!/ 7:?ENNUZ]^eiiomvsuuttpnlhc^^TSLKA?93.+&! S"249AELPRY]adjjnnrqkjjjrnjhd\ZUQNICC:50)!2*&.8>?EJNVY]cbiikhe\VQVbkomjh_[[TQHE?74)&`a814>?BLQRW]`ba`_UOSZNPJ|Fmylhdd`ZWSRJF>=)<@A^m_TS`}pc`a]_[S>]ztlg\^?hς==Rr`D}Y]qcaa[\ZXKEztlg_\v ~6||}Hhv[LRd}dZY[ZYXUAhyrmg^[q/~ymHwX[q~mVWYUVVRFHyske^[gu5,8.[`Y||}cSfy||SNTSUSUL=lzrkd_W^†#=2 7+_Wmlljjjunvx{gT[JOOP>Jwrld^VZsa@5B7@3rvyOC8o}xrkc^WSbE8#G:`TNGb}xqjc\WQV~NOA~PBu󹹹 ~pid[UNNdTGVH]THqf08pZV]a3fLVH55tomboy-ng_0.34-1/source/settings.lfm0000644000175000017500000014147614145033507017272 0ustar dbannondbannonobject Sett: TSett Left = 564 Height = 530 Top = 273 Width = 726 BorderIcons = [] Caption = 'Form Caption' ClientHeight = 530 ClientWidth = 726 OnClose = FormClose OnCreate = FormCreate OnDestroy = FormDestroy OnHide = FormHide OnKeyDown = FormKeyDown OnShow = FormShow LCLVersion = '2.2.0.2' object PageControl1: TPageControl AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = SpeedButHide Left = 0 Height = 488 Top = 0 Width = 726 ActivePage = TabSync Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Bottom = 2 TabIndex = 2 TabOrder = 0 OnChange = PageControl1Change object TabBasic: TTabSheet Caption = 'Basic' ClientHeight = 459 ClientWidth = 722 OnResize = TabBasicResize object ButtonSetNotePath: TButton AnchorSideLeft.Control = TabBasic Left = 7 Height = 48 Hint = 'If you have notes somewhere else' Top = 144 Width = 353 BorderSpacing.Left = 7 Caption = 'Set Path to Note Files' OnClick = ButtonSetNotePathClick ParentShowHint = False ShowHint = True TabOrder = 0 end object LabelSettingPath: TLabel Left = 7 Height = 19 Top = 42 Width = 122 Caption = 'LabelSettingPath' end object LabelNotesPath: TLabel Left = 8 Height = 19 Top = 120 Width = 113 Caption = 'LabelNotesPath' end object Label1: TLabel Left = 8 Height = 19 Top = 16 Width = 179 Caption = 'Settings will be saved in :' end object Label2: TLabel Left = 11 Height = 19 Top = 94 Width = 270 Caption = 'Notes will be looked for and saved in :' end object ButtDefaultNoteDir: TButton AnchorSideLeft.Control = ButtonSetNotePath AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = ButtonSetNotePath AnchorSideRight.Control = TabBasic AnchorSideRight.Side = asrBottom Left = 370 Height = 48 Hint = 'Will work for many new users' Top = 144 Width = 345 Anchors = [akTop, akLeft, akRight] BorderSpacing.Left = 10 BorderSpacing.Right = 7 Caption = 'Use Default Notes Location' OnClick = ButtDefaultNoteDirClick ParentShowHint = False ShowHint = True TabOrder = 1 end object CheckAutostart: TCheckBox AnchorSideLeft.Control = CheckShowTomdroid AnchorSideTop.Control = CheckShowTomdroid AnchorSideTop.Side = asrBottom Left = 16 Height = 21 Top = 264 Width = 156 BorderSpacing.Top = 21 Caption = 'Autostart at Logon' OnChange = SaveSettings TabOrder = 3 end object CheckShowSearchAtStart: TCheckBox AnchorSideLeft.Control = CheckShowTomdroid AnchorSideTop.Control = CheckAutostart AnchorSideTop.Side = asrBottom Left = 16 Height = 21 Top = 306 Width = 171 BorderSpacing.Top = 21 Caption = 'Show Search at Start' OnChange = SaveSettings TabOrder = 4 end object CheckShowSplash: TCheckBox AnchorSideTop.Control = CheckShowSearchAtStart AnchorSideTop.Side = asrBottom Left = 16 Height = 21 Hint = 'Always shown if error loading notes.' Top = 348 Width = 169 BorderSpacing.Top = 21 Caption = 'Show Splash at Start' Checked = True OnChange = SaveSettings ParentShowHint = False ShowHint = True State = cbChecked TabOrder = 5 end object CheckShowTomdroid: TCheckBox AnchorSideTop.Control = ButtonSetNotePath AnchorSideTop.Side = asrBottom Left = 16 Height = 21 Top = 222 Width = 280 BorderSpacing.Top = 30 Caption = 'Show Tomdroid Sync (experimental)' OnChange = SaveSettings TabOrder = 2 end object CheckNotifications: TCheckBox AnchorSideLeft.Control = CheckShowTomdroid AnchorSideTop.Control = CheckShowSplash AnchorSideTop.Side = asrBottom Left = 16 Height = 21 Top = 390 Width = 157 BorderSpacing.Top = 21 Caption = 'Show Notifications' Checked = True OnChange = SaveSettings State = cbChecked TabOrder = 6 end end object TabDisplay: TTabSheet Caption = 'Notes' ClientHeight = 459 ClientWidth = 722 object GroupBox5: TGroupBox Left = 32 Height = 176 Top = 24 Width = 264 Caption = 'Font Size' ClientHeight = 155 ClientWidth = 260 TabOrder = 7 object RadioFontBig: TRadioButton AnchorSideLeft.Control = GroupBox5 Left = 19 Height = 21 Top = 55 Width = 46 Anchors = [akLeft] BorderSpacing.Left = 19 Caption = 'Big' Checked = True OnChange = SaveSettings TabOrder = 0 TabStop = True end object RadioFontMedium: TRadioButton AnchorSideLeft.Control = GroupBox5 Left = 19 Height = 21 Top = 91 Width = 82 Anchors = [akLeft] BorderSpacing.Left = 19 Caption = 'Medium' OnChange = SaveSettings TabOrder = 1 end object RadioFontSmall: TRadioButton AnchorSideLeft.Control = GroupBox5 Left = 19 Height = 21 Top = 128 Width = 62 Anchors = [akLeft] BorderSpacing.Left = 19 Caption = 'Small' OnChange = SaveSettings TabOrder = 2 end object RadioFontHuge: TRadioButton AnchorSideLeft.Control = GroupBox5 Left = 19 Height = 21 Top = 19 Width = 61 Anchors = [akLeft] BorderSpacing.Left = 19 Caption = 'Huge' OnChange = SaveSettings TabOrder = 3 end end object CheckShowIntLinks: TCheckBox AnchorSideLeft.Control = GroupBox5 AnchorSideTop.Control = GroupBox5 AnchorSideTop.Side = asrBottom Left = 32 Height = 21 Top = 220 Width = 161 BorderSpacing.Top = 20 Caption = 'Show Internal Links' OnChange = SaveSettings TabOrder = 0 end object CheckShowExtLinks: TCheckBox AnchorSideLeft.Control = GroupBox5 AnchorSideTop.Control = CheckShowIntLinks AnchorSideTop.Side = asrBottom Left = 32 Height = 21 Top = 259 Width = 169 BorderSpacing.Top = 18 Caption = 'Show External Links' OnChange = SaveSettings TabOrder = 1 end object CheckManyNotebooks: TCheckBox AnchorSideLeft.Control = GroupBox5 AnchorSideTop.Control = CheckShowExtLinks AnchorSideTop.Side = asrBottom Left = 32 Height = 21 Hint = 'This may adversly affect traditional Tomboy, take care.' Top = 298 Width = 322 BorderSpacing.Top = 18 Caption = 'Allow a Note to be in Multiple Notebooks.' OnChange = SaveSettings ParentShowHint = False ShowHint = True TabOrder = 2 end object ButtonFont: TButton AnchorSideLeft.Control = ComboHelpLanguage AnchorSideRight.Side = asrBottom Left = 404 Height = 25 Top = 32 Width = 167 Anchors = [akTop, akLeft, akRight] Caption = 'Usual Font' OnClick = ButtonFontClick ParentShowHint = False ShowHint = True TabOrder = 4 end object ButtonFixedFont: TButton AnchorSideLeft.Control = ComboHelpLanguage AnchorSideRight.Control = ButtonFont AnchorSideRight.Side = asrBottom Left = 404 Height = 25 Top = 76 Width = 167 Anchors = [akTop, akLeft, akRight] Caption = 'Fixed Font' OnClick = ButtonFixedFontClick ParentShowHint = False ShowHint = True TabOrder = 5 end object ButtonSetColours: TButton AnchorSideLeft.Control = GroupBox5 AnchorSideTop.Control = CheckUseUndo AnchorSideTop.Side = asrBottom AnchorSideRight.Side = asrBottom Left = 32 Height = 32 Top = 376 Width = 240 BorderSpacing.Top = 18 Caption = 'Set Colours' OnClick = ButtonSetColoursClick TabOrder = 3 end object ComboHelpLanguage: TComboBox AnchorSideLeft.Control = ButtonFont AnchorSideRight.Control = TabDisplay AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = GroupBox5 AnchorSideBottom.Side = asrBottom Left = 404 Height = 32 Top = 168 Width = 288 Anchors = [akTop, akRight, akBottom] AutoSize = False BorderSpacing.Right = 30 ItemHeight = 0 OnChange = ComboHelpLanguageChange Style = csDropDownList TabOrder = 6 end object Label10: TLabel AnchorSideLeft.Control = ComboHelpLanguage AnchorSideTop.Control = ComboHelpLanguage AnchorSideTop.Side = asrBottom AnchorSideBottom.Control = ComboHelpLanguage Left = 404 Height = 19 Top = 149 Width = 153 Anchors = [akLeft, akBottom] Caption = 'Help Notes Language' end object CheckUseUndo: TCheckBox AnchorSideTop.Control = CheckManyNotebooks AnchorSideTop.Side = asrBottom Left = 32 Height = 21 Hint = 'Close and reopen a note to take effect. Use Ctrl-Z Ctrl-Y' Top = 337 Width = 267 BorderSpacing.Top = 18 Caption = 'Use Undo Redo (may slow editing)' Checked = True OnChange = SaveSettings ParentShowHint = False ShowHint = True State = cbChecked TabOrder = 8 end object ComboDateFormat: TComboBox AnchorSideLeft.Control = ComboHelpLanguage AnchorSideTop.Control = Label17 AnchorSideTop.Side = asrBottom AnchorSideRight.Control = ComboHelpLanguage AnchorSideRight.Side = asrBottom Left = 404 Height = 32 Top = 256 Width = 288 Anchors = [akTop, akLeft, akRight] AutoSize = False BorderSpacing.Top = 5 ItemHeight = 0 OnChange = SaveSettings Style = csDropDownList TabOrder = 9 end object Label17: TLabel AnchorSideLeft.Control = ComboHelpLanguage AnchorSideTop.Control = ComboHelpLanguage AnchorSideTop.Side = asrBottom Left = 404 Height = 19 Top = 232 Width = 139 BorderSpacing.Top = 32 Caption = 'Date Stamp Format' end object CheckStampItalics: TCheckBox AnchorSideLeft.Control = ComboDateFormat AnchorSideTop.Control = CheckStampSmall Left = 404 Height = 21 Top = 296 Width = 63 Caption = 'Italics' OnChange = SaveSettings TabOrder = 10 end object CheckStampSmall: TCheckBox AnchorSideTop.Control = ComboDateFormat AnchorSideTop.Side = asrBottom AnchorSideRight.Control = ComboDateFormat AnchorSideRight.Side = asrBottom Left = 630 Height = 21 Top = 296 Width = 62 Anchors = [akTop, akRight] BorderSpacing.Top = 8 Caption = 'Small' OnChange = SaveSettings TabOrder = 11 end object CheckStampBold: TCheckBox AnchorSideLeft.Control = CheckStampItalics AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = CheckStampItalics AnchorSideRight.Control = CheckStampSmall Left = 517 Height = 21 Top = 296 Width = 55 BorderSpacing.Left = 50 Caption = 'Bold' OnChange = SaveSettings TabOrder = 12 end end object TabSync: TTabSheet Caption = 'Sync' ClientHeight = 459 ClientWidth = 722 object GroupBox4: TGroupBox AnchorSideLeft.Control = TabSync AnchorSideTop.Control = GroupBoxSync AnchorSideTop.Side = asrBottom AnchorSideRight.Control = TabSync AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = TabSync AnchorSideBottom.Side = asrBottom Left = 3 Height = 186 Top = 270 Width = 716 Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Left = 3 BorderSpacing.Top = 6 BorderSpacing.Right = 3 BorderSpacing.Bottom = 3 Caption = ' Options ' ClientHeight = 165 ClientWidth = 712 ParentColor = False TabOrder = 0 object Label3: TLabel Left = 16 Height = 19 Top = 16 Width = 472 Caption = 'When a conflict is detected between a local note and remote one :' end object RadioAlwaysAsk: TRadioButton AnchorSideLeft.Control = Label3 AnchorSideTop.Control = Label3 AnchorSideTop.Side = asrBottom Left = 16 Height = 21 Top = 50 Width = 214 BorderSpacing.Top = 15 Caption = 'Always Ask me what to do.' Checked = True TabOrder = 0 TabStop = True end object RadioUseLocal: TRadioButton AnchorSideLeft.Control = Label3 AnchorSideTop.Control = RadioAlwaysAsk AnchorSideTop.Side = asrBottom Left = 16 Height = 21 Top = 86 Width = 332 BorderSpacing.Top = 15 Caption = 'Use Local Note and Overwrite Server Note.' TabOrder = 1 end object RadioUseServer: TRadioButton AnchorSideLeft.Control = Label3 AnchorSideTop.Control = RadioUseLocal AnchorSideTop.Side = asrBottom Left = 16 Height = 21 Top = 122 Width = 319 BorderSpacing.Top = 15 Caption = 'Use Server Note and Rename Local Note.' TabOrder = 2 end end object Label12: TLabel Left = 14 Height = 1 Top = 49 Width = 1 end object GroupBoxSync: TGroupBox AnchorSideLeft.Control = TabSync AnchorSideTop.Control = LabelSyncType AnchorSideTop.Side = asrBottom AnchorSideRight.Control = TabSync AnchorSideRight.Side = asrBottom Left = 3 Height = 215 Top = 49 Width = 716 Anchors = [akTop, akLeft, akRight] BorderSpacing.Left = 3 BorderSpacing.Top = 15 BorderSpacing.Right = 3 Caption = ' Sync ' ClientHeight = 194 ClientWidth = 712 ParentColor = False TabOrder = 1 object Label4: TLabel AnchorSideLeft.Control = GroupBoxSync AnchorSideTop.Control = LabelSyncInfo2 AnchorSideTop.Side = asrBottom Left = 15 Height = 19 Top = 81 Width = 49 BorderSpacing.Left = 15 BorderSpacing.Top = 18 Caption = 'Repo : ' end object LabelSyncRepo: TLabel AnchorSideLeft.Control = Label4 AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Label4 Left = 65 Height = 19 Top = 81 Width = 105 BorderSpacing.Left = 1 Caption = 'not configured' end object SpeedSetupSync: TSpeedButton AnchorSideLeft.Control = EditUserName AnchorSideRight.Control = GroupBoxSync AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = GroupBoxSync AnchorSideBottom.Side = asrBottom Left = 548 Height = 32 Top = 152 Width = 154 Anchors = [akRight, akBottom] BorderSpacing.Right = 10 BorderSpacing.Bottom = 10 Caption = 'Setup' OnClick = SpeedSetupSyncClick end object CheckBoxAutoSync: TCheckBox AnchorSideLeft.Control = CheckSyncEnabled AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = SpeedSetupSync AnchorSideRight.Control = SpeedSetupSync AnchorSideBottom.Control = SpeedSetupSync AnchorSideBottom.Side = asrBottom Left = 205 Height = 21 Hint = 'Sync, if possible once an hour.' Top = 163 Width = 94 Anchors = [akLeft, akBottom] BorderSpacing.Left = 30 BorderSpacing.Right = 50 Caption = 'Auto Sync' OnChange = CheckBoxAutoSyncChange ParentShowHint = False ShowHint = True TabOrder = 0 end object LabelSyncInfo1: TLabel AnchorSideLeft.Control = GroupBoxSync AnchorSideTop.Control = GroupBoxSync Left = 15 Height = 19 Top = 15 Width = 108 BorderSpacing.Left = 15 BorderSpacing.Top = 15 Caption = 'LabelSyncInfo1' end object LabelSyncInfo2: TLabel AnchorSideLeft.Control = GroupBoxSync AnchorSideTop.Control = LabelSyncInfo1 AnchorSideTop.Side = asrBottom Left = 15 Height = 19 Top = 44 Width = 108 BorderSpacing.Left = 15 BorderSpacing.Top = 10 Caption = 'LabelSyncInfo2' end object LabelLabelToken: TLabel AnchorSideLeft.Control = EditUserName AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Label4 AnchorSideTop.Side = asrBottom AnchorSideBottom.Control = LabelUserName AnchorSideBottom.Side = asrCenter Left = 232 Height = 19 Top = 114 Width = 43 Anchors = [akLeft, akBottom] BorderSpacing.Left = 20 BorderSpacing.Top = 12 BorderSpacing.Right = 5 BorderSpacing.Bottom = 5 Caption = 'Token' end object LabelUserName: TLabel AnchorSideLeft.Control = GroupBoxSync AnchorSideTop.Control = Label4 AnchorSideTop.Side = asrBottom AnchorSideRight.Control = EditUserName AnchorSideBottom.Side = asrBottom Left = 15 Height = 19 Top = 115 Width = 33 BorderSpacing.Left = 15 BorderSpacing.Top = 15 BorderSpacing.Right = 5 BorderSpacing.Bottom = 4 Caption = 'User' end object EditUserName: TEdit AnchorSideLeft.Control = LabelUserName AnchorSideLeft.Side = asrBottom AnchorSideTop.Side = asrCenter AnchorSideRight.Control = GroupBoxSync AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = LabelUserName AnchorSideBottom.Side = asrCenter Left = 58 Height = 28 Top = 110 Width = 154 Anchors = [akLeft, akBottom] BorderSpacing.Left = 10 BorderSpacing.Right = 10 TabOrder = 1 Text = 'EditUserName' end object CheckSyncEnabled: TCheckBox AnchorSideLeft.Control = EditUserName AnchorSideTop.Control = SpeedSetupSync AnchorSideTop.Side = asrCenter AnchorSideBottom.Control = SpeedSetupSync AnchorSideBottom.Side = asrBottom Left = 58 Height = 21 Top = 163 Width = 117 Anchors = [akLeft, akBottom] Caption = 'Sync Enabled' OnChange = CheckSyncEnabledChange TabOrder = 2 end object SpeedTokenPaste: TSpeedButton AnchorSideLeft.Control = SpeedTokenCopy AnchorSideLeft.Side = asrBottom AnchorSideTop.Side = asrBottom AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = LabelUserName AnchorSideBottom.Side = asrCenter Left = 300 Height = 27 Hint = 'Paste Token' Top = 110 Width = 36 Anchors = [akLeft, akBottom] Glyph.Data = { 36040000424D3604000000000000360000002800000010000000100000000100 2000000000000004000064000000640000000000000000000000000000000000 00000000000000000000000000000000000000000000B77A3AFFB77A3AFFB77A 3AFFB77A3AFFB77A3AFFB77A3AFFB77A3AFFB77A3AFFB77A3AFF2193AFC21E8E AAFF1E8EAAFF1E8EAAFF1E8EAAFF1E8EAAFF1E8EAAFFBA7F41FFF4EBE0FFF4EB E0FFF4EBE0FFF4EBE0FFF4EBE0FFF4EBE0FFF4EBE0FFBA7F41FF1E90ADFF54D3 E8FF51D2E6FF4FD1E5FF4CCFE4FF49CEE3FF49CEE3FFBD8447FFF6EEE4FFF6EE E4FFF6EEE4FFF6EEE4FFF6EEE4FFF6EEE4FFF6EEE4FFBD8447FF1F92AFFF5AD6 EAFF57D5E9FF55D4E8FF52D2E7FF4FD1E6FF4DD0E5FFC0884EFFF7F1E9FFFBD4 A7FFFBD4A7FFFBD4A7FFFBD4A7FFFBD4A7FFF7F1E9FFC0884EFF1F94B2FF60D9 EDFF5DD8ECFF5BD7EAFF58D5E9FF55D4E8FF53D3E7FFC38D54FFF9F4EDFFF9F4 EDFFF9F4EDFFF9F4EDFFF9F4EDFFF9F4EDFFF9F4EDFFC38D54FF2097B4FF66DC EFFF63DBEEFF61DAEDFF5ED8ECFF5BD7EBFF59D6EAFFC7925BFFFAF6F2FFFBCB 95FFFBCB95FFFBCB95FFFBCB95FFFBCB95FFFAF6F2FFC7925BFF2099B7FF6CDF F2FF69DEF1FF67DDF0FF64DBEEFF61DAEDFF5FD9ECFFCA9761FFFCF9F6FFFCF9 F6FFFCF9F6FFFCF9F6FFFCF9F6FFFCF9F6FFFCF9F6FFCA9761FF219BBAFF72E2 F4FF6FE1F3FF6CDFF2FF6ADEF1FF67DDF0FF65DCEFFFCD9B68FFFDFCFBFFFBC1 80FFFBC180FFFBC180FFFBC180FFFDFCFBFFF1E4D6FFCE9D6BF9219DBCFF78E5 F7FF75E4F6FF72E2F5FF70E1F3FF6DE0F2FF6BDFF1FFD0A06EFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFF4E9DDFFD2A476F5D19E6C42229FBFFF7EE8 F9FF7BE7F8FF78E5F7FF76E4F6FF73E3F5FF71E1F4FFD3A575FFD3A575FFD3A5 75FFD3A575FFD3A575FFD3A575FFD4A777F9D3A374400000000022A1C2FF84EB FCFF81EAFBFF7EE8FAFF7CE7F9FF79E6F7FF77E4F6FF74E3F5FF71E2F4FF6FE1 F3FF6CDFF2FF22A1C2FF0000000000000000000000000000000023A4C4FF84EB FCFF84EBFCFF84EBFCFF82EAFBFF7FE9FAFF7DE7F9FF7AE6F8FF77E5F7FF75E4 F6FF72E2F4FF23A4C4FF0000000000000000000000000000000023A6C7FF84EB FCFF84EBFCFF2E9ED9FF24ABE2FF24ABE2FF24AAE2FF23AAE2FF2D9DD8FF7BE6 F8FF78E5F7FF23A6C7FF0000000000000000000000000000000024A8C9FF84EB FCFF84EBFCFF38A4D5FF3DD8FFFF3DD8FFFF3DD8FFFF3DD8FFFF38A4D5FF81E9 FBFF7EE8FAFF24A8C9FF000000000000000000000000000000002BAFD0C224AA CCFF24AACCFF4C9CC3FF98EAFFFF98EAFFFF98EAFFFF98EAFFFF4C9CC3FF24AA CCFF24AACCFF2BAFD0C200000000000000000000000000000000000000000000 000000000000417196D86290AEDF6290AEDF6290AEDF6290AEDF417196D80000 0000000000000000000000000000000000000000000000000000 } OnClick = SpeedTokenPasteClick ShowHint = True ParentShowHint = False end object SpeedTokenCopy: TSpeedButton AnchorSideLeft.Control = LabelLabelToken AnchorSideLeft.Side = asrBottom AnchorSideTop.Side = asrBottom AnchorSideRight.Control = SpeedTokenPaste AnchorSideBottom.Control = LabelUserName AnchorSideBottom.Side = asrCenter Left = 280 Height = 23 Hint = 'Copy Token' Top = 112 Width = 20 Anchors = [akLeft, akBottom] Glyph.Data = { 36040000424D3604000000000000360000002800000010000000100000000100 2000000000000004000064000000640000000000000000000000000000000000 000000000000000000000000000000000000D3A575FFD3A575FFD3A575FFD3A5 75FFD3A575FFD3A575FFD3A575FFD3A575FFD3A575FFD3A575FF000000000000 000000000000000000000000000000000000D3A575FFF8F2EBFFF7F1E9FFF7EF E7FFF6EEE5FFF6EDE4FFF5ECE2FFF4EBE0FFF4EADFFFD3A575FF000000000000 000000000000000000000000000000000000D3A575FFF9F3EDFFF8F2EBFFF7F1 E9FFF7F0E7FFF6EEE6FFF6EDE4FFF5ECE2FFF4EBE0FFD3A575FF000000000000 000000000000000000000000000000000000D3A575FFF9F4EFFFFBEAD7FFFBEA D7FFFBEAD7FFFBEAD7FFFBEAD7FFF6EDE4FFF5ECE2FFD3A575FFD3A575FFD3A5 75FFD3A575FFD3A575FFD3A575FFD3A575FFD3A575FFFAF6F1FFF9F4EFFFF9F3 EDFFF8F2EBFFF8F1EAFFF7F0E8FFF6EFE6FFF6EEE4FFD3A575FFD3A575FFF8F2 EBFFF7F1E9FFF7EFE7FFF6EEE5FFF6EDE4FFD3A575FFFBF7F3FFFBD4A7FFFBD4 A7FFFBD4A7FFFBD4A7FFFBD4A7FFF7F0E8FFF7EFE6FFD3A575FFD3A575FFF9F3 EDFFF8F2EBFFF7F1E9FFF7F0E7FFF6EEE6FFD3A575FFFBF8F5FFFBF7F3FFFAF6 F1FFFAF5EFFFF9F4EEFFF8F2ECFFF8F1EAFFF7F0E8FFD3A575FFD3A575FFF9F4 EFFFFBEAD7FFFBEAD7FFFBEAD7FFFBEAD7FFD3A575FFFCFAF7FFFBC180FFFBC1 80FFFBC180FFFBC180FFFBC180FFF9F3ECFFF8F2EAFFD3A575FFD3A575FFFAF6 F1FFF9F4EFFFF9F3EDFFF8F2EBFFF8F1EAFFD3A575FFFDFBF9FFFCFAF7FFFCF9 F5FFFBF7F3FFFAF6F2FFFAF5F0FFF9F4EEFFF9F3ECFFD3A575FFD3A575FFFBF7 F3FFFBD4A7FFFBD4A7FFFBD4A7FFFBD4A7FFD3A575FFFEFCFBFFFBC180FFFBC1 80FFFBC180FFFBC180FFFBC180FFFAF5F0FFF0E0CFFFD4A776F9D3A575FFFBF8 F5FFFBF7F3FFFAF6F1FFFAF5EFFFF9F4EEFFD3A575FFFEFDFDFFFEFCFBFFFDFB F9FFFCFAF7FFFCF9F6FFFBF8F4FFF2E4D5FFD4A97BF5D5A67442D3A575FFFCFA F7FFFBC180FFFBC180FFFBC180FFFBC180FFD3A575FFD3A575FFD3A575FFD3A5 75FFD3A575FFD3A575FFD3A575FFD4A676F9D3A3744000000000D3A575FFFDFB F9FFFCFAF7FFFCF9F5FFFBF7F3FFFAF6F2FFFAF5F0FFF9F4EEFFF9F3ECFFD3A5 75FF000000000000000000000000000000000000000000000000D3A575FFFEFC FBFFFBC180FFFBC180FFFBC180FFFBC180FFFBC180FFFAF5F0FFF0E0CFFFD4A7 76F9000000000000000000000000000000000000000000000000D3A575FFFEFD FDFFFEFCFBFFFDFBF9FFFCFAF7FFFCF9F6FFFBF8F4FFF2E4D5FFD4A97BF5D5A6 7442000000000000000000000000000000000000000000000000D3A575FFD3A5 75FFD3A575FFD3A575FFD3A575FFD3A575FFD3A575FFD4A676F9D3A374400000 0000000000000000000000000000000000000000000000000000 } OnClick = SpeedTokenCopyClick ShowHint = True ParentShowHint = False end object LabelToken: TLabel AnchorSideLeft.Control = SpeedTokenPaste AnchorSideLeft.Side = asrBottom AnchorSideBottom.Control = LabelUserName AnchorSideBottom.Side = asrCenter Left = 346 Height = 19 Top = 114 Width = 72 Anchors = [akLeft, akBottom] BorderSpacing.Left = 10 Caption = 'LabelToke' ParentShowHint = False ShowHint = True end end object ComboSyncType: TComboBox AnchorSideLeft.Control = LabelSyncType AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = LabelSyncType Left = 97 Height = 28 Top = 15 Width = 359 BorderSpacing.Left = 15 ItemHeight = 0 Items.Strings = ( 'File Sync - local or shared filesystem' 'Github - free Github account required' ) OnChange = ComboSyncTypeChange TabOrder = 2 Text = 'ComboSyncType' end object LabelSyncType: TLabel AnchorSideLeft.Control = TabSync AnchorSideTop.Control = TabSync Left = 10 Height = 19 Top = 15 Width = 72 BorderSpacing.Left = 10 BorderSpacing.Top = 15 Caption = 'Sync Type' end end object TabBackUp: TTabSheet Caption = 'BackUp' ClientHeight = 459 ClientWidth = 722 Enabled = False TabVisible = False object Panel1: TPanel AnchorSideLeft.Control = TabBackUp AnchorSideTop.Control = TabBackUp AnchorSideRight.Control = TabBackUp AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = TabBackUp AnchorSideBottom.Side = asrBottom Left = 0 Height = 459 Top = 0 Width = 722 Anchors = [akTop, akLeft, akRight, akBottom] TabOrder = 0 end end object TabRecover: TTabSheet BorderWidth = 1 Caption = 'Recover' ClientHeight = 459 ClientWidth = 722 OnResize = TabRecoverResize object Panel2: TPanel AnchorSideLeft.Control = TabRecover AnchorSideTop.Control = Panel3 AnchorSideTop.Side = asrBottom AnchorSideRight.Control = TabRecover AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = TabRecover AnchorSideBottom.Side = asrBottom Left = 1 Height = 193 Top = 265 Width = 720 Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Left = 1 BorderSpacing.Top = 9 BorderSpacing.Right = 1 BorderSpacing.Bottom = 1 BevelInner = bvLowered ClientHeight = 193 ClientWidth = 720 TabOrder = 0 object Label6: TLabel Left = 32 Height = 19 Top = 48 Width = 465 Caption = 'Backup files are made when you delete a note or the sync system' end object Label7: TLabel Left = 32 Height = 19 Top = 80 Width = 187 Caption = 'is about to overwrite one. ' end object Label8: TLabel Left = 32 Height = 19 Top = 112 Width = 425 Caption = 'They remain, forever, unless you do something about them.' end object ButtonShowBackUp: TButton AnchorSideRight.Control = Panel2 AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Panel2 AnchorSideBottom.Side = asrBottom Left = 602 Height = 40 Top = 144 Width = 109 Anchors = [akRight, akBottom] BorderSpacing.Right = 7 BorderSpacing.Bottom = 7 Caption = 'Show Me' OnClick = ButtonShowBackUpClick TabOrder = 0 end object Label11: TLabel Left = 32 Height = 19 Top = 19 Width = 96 Caption = 'Backup Files' Font.Style = [fsBold] ParentFont = False end end object Panel3: TPanel AnchorSideLeft.Control = TabRecover AnchorSideTop.Control = TabRecover AnchorSideRight.Control = TabRecover AnchorSideRight.Side = asrBottom Left = 0 Height = 256 Top = 0 Width = 722 Anchors = [akTop, akLeft, akRight] BevelInner = bvLowered ClientHeight = 256 ClientWidth = 722 TabOrder = 1 object Label9: TLabel Left = 33 Height = 19 Top = 32 Width = 386 Caption = 'A snaphot is a copy of your current note directory.' Font.Style = [fsBold] ParentFont = False end object LabelSnapDir: TLabel Left = 32 Height = 19 Top = 72 Width = 58 Caption = 'Snap dir' end object SpinDaysPerSnapshot: TSpinEdit Left = 32 Height = 28 Top = 112 Width = 76 MaxValue = 31 MinValue = 1 OnChange = SpinDaysPerSnapshotChange TabOrder = 0 Value = 7 end object SpinMaxSnapshots: TSpinEdit Left = 32 Height = 28 Top = 160 Width = 76 MaxValue = 10 MinValue = 10 OnChange = SaveSettings TabOrder = 1 Value = 20 end object CheckAutoSnapEnabled: TCheckBox Left = 344 Height = 21 Top = 117 Width = 161 Caption = 'Use auto snapshots' OnChange = CheckAutoSnapEnabledChange TabOrder = 2 end object Label5: TLabel Left = 131 Height = 19 Top = 122 Width = 130 Caption = 'Days per snapshot' end object Label16: TLabel Left = 131 Height = 19 Top = 160 Width = 225 Caption = 'Maximum number of snapshots' end object ButtonSnapRecover: TButton AnchorSideLeft.Control = ButtonManualSnap AnchorSideLeft.Side = asrBottom AnchorSideRight.Control = Panel3 AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Panel3 AnchorSideBottom.Side = asrBottom Left = 360 Height = 40 Hint = 'If you have previously taken a snapshot ...' Top = 206 Width = 353 Anchors = [akLeft, akRight, akBottom] BorderSpacing.Left = 7 BorderSpacing.Right = 7 BorderSpacing.Bottom = 8 Caption = 'Recover Lost Notes' OnClick = ButtonSnapRecoverClick ParentShowHint = False ShowHint = True TabOrder = 3 end object ButtonManualSnap: TButton AnchorSideLeft.Control = Panel3 AnchorSideBottom.Control = Panel3 AnchorSideBottom.Side = asrBottom Left = 9 Height = 40 Hint = 'Take a time stamped snapshot of notes and config' Top = 206 Width = 344 Anchors = [akLeft, akBottom] BorderSpacing.Left = 7 BorderSpacing.Bottom = 8 Caption = 'Take a Manual Snapshot' OnClick = ButtonManualSnapClick ParentShowHint = False ShowHint = True TabOrder = 4 end end end object TabSpell: TTabSheet Caption = 'Spell' ClientHeight = 459 ClientWidth = 722 OnResize = TabSpellResize object Label13: TLabel Left = 12 Height = 19 Top = 20 Width = 334 Caption = 'Spell Check requires the Hunspell Libraries and' end object Label14: TLabel Left = 12 Height = 19 Top = 52 Width = 278 Caption = 'an appropriate Hunspell Dictionary set.' end object LabelError: TLabel Left = 16 Height = 19 Top = 368 Width = 74 Caption = 'LabelError' end object LabelLibraryStatus: TLabel Left = 16 Height = 19 Top = 100 Width = 133 Caption = 'LabelLibraryStatus' end object LabelDicStatus: TLabel Left = 16 Height = 19 Top = 240 Width = 105 Caption = 'LabelDicStatus' end object LabelLibrary: TLabel Left = 16 Height = 19 Top = 132 Width = 88 Caption = 'LabelLibrary' end object LabelDic: TLabel Left = 16 Height = 19 Top = 272 Width = 60 Caption = 'LabelDic' end object ListBoxDic: TListBox AnchorSideLeft.Control = ButtonSetSpellLibrary AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = ButtonSetSpellLibrary AnchorSideRight.Control = TabSpell AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = ButtonSetDictionary AnchorSideBottom.Side = asrBottom Left = 171 Height = 180 Top = 158 Width = 544 Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Left = 12 BorderSpacing.Right = 7 ItemHeight = 0 OnClick = ListBoxDicClick ScrollWidth = 456 TabOrder = 0 TopIndex = -1 end object LabelDicPrompt: TLabel AnchorSideRight.Control = ListBoxDic AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = ListBoxDic Left = 601 Height = 19 Top = 132 Width = 114 Anchors = [akRight, akBottom] BorderSpacing.Bottom = 7 Caption = 'LabelDicPrompt' end object ButtonSetSpellLibrary: TButton AnchorSideTop.Control = LabelLibrary AnchorSideTop.Side = asrBottom Left = 16 Height = 40 Top = 158 Width = 143 BorderSpacing.Top = 7 Caption = 'Set Spell Library' OnClick = ButtonSetSpellLibraryClick TabOrder = 1 end object ButtonSetDictionary: TButton AnchorSideTop.Control = LabelDic AnchorSideTop.Side = asrBottom Left = 16 Height = 40 Top = 298 Width = 143 BorderSpacing.Top = 7 Caption = 'Set Dictionary' OnClick = ButtonSetDictionaryClick TabOrder = 2 end end end object Label15: TLabel AnchorSideBottom.Side = asrBottom Left = 24 Height = 19 Top = 502 Width = 56 Anchors = [akLeft, akBottom] BorderSpacing.Bottom = 7 Caption = 'Label15' end object SpeedButHide: TSpeedButton AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 630 Height = 40 Top = 490 Width = 96 Anchors = [akRight, akBottom] Caption = 'Close' OnClick = SpeedButHideClick end object SpeedButtTBMenu: TSpeedButton AnchorSideTop.Control = SpeedButHide AnchorSideRight.Control = SpeedButHide AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 514 Height = 40 Top = 490 Width = 116 Anchors = [akTop, akRight, akBottom] Caption = 'Menu' Glyph.Data = { 36090000424D3609000000000000360000002800000018000000180000000100 2000000000000009000064000000640000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000003232 3238333333050000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000000000002E2E2E163636 36F93C3C3CF0393939863737371C000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000000000003737377D8080 80F6DEDEDEFF727272FA3A3A3ADC000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000003434348D34343440555555033D3D3DEBD9D9 D9FFFFFFFFFF777777F536363672000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000003E3E3EEB464646F53B3B3BEB595959F2FFFF FFFFEEEEEEFF3A3A3AF630303010000000000000000000000000000000000000 000000000000000000004D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D 4DFF4D4D4DFF4D4D4DFF4D4D4DFF3E3E3EFFE8E8E8FFCDCDCDFFCECECEFFFFFF FFFF9E9E9EFC3E3E3EB100000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF474747FFEAEAEAFFFFFFFFFFFFFFFFFFFFFF FFFFACACACFC434343F5404040D0323232510000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF454545FFEDEDEDFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFCFCFCFFF383838F9323232420000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FFFFFFFFFFFFFFFFFF414141FFF0F0F0FFFFFFFFFFFFFFFFFFFFFF FFFFD8D8D8FF3E3E3EF43333334B000000000000000000000000000000000000 000000000000000000004D4D4DFFFAFAFAFFFAFAFAFFFAFAFAFFFAFAFAFFFAFA FAFFFAFAFAFFFAFAFAFFFAFAFAFF3F3F3FFFF2F2F2FFFFFFFFFFFFFFFFFFD9D9 D9FF3E3E3EF53434344E00000000000000000000000000000000000000000000 000000000000000000004D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D 4DFF4D4D4DFF4D4D4DFF4D4D4DFF383838FFF5F5F5FFFFFFFFFFDBDBDBFF3E3E 3EF6353535570000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFAFAFAFFFAFAFAFFFAFAFAFFFAFAFAFFFAFA FAFFFAFAFAFFFAFAFAFFFAFAFAFF3A3A3AFFF8F8F8FFE0E0E0FF424242F53636 365A000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FFFFFFFFFFFFFFFFFF383838FFDDDDDDFF424242FF3636365E0000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF363636FF494949FF454545FF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FFFFFFFFFFFFFFFFFFFFFFFFFF353535FFAEAEAEFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFDFDFDFFA9A9A9FFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FF000000FFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D 4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000 } OnClick = SpeedButtTBMenuClick PopupMenu = PMenuMain end object SpeedButHelp: TSpeedButton AnchorSideTop.Control = SpeedButHide AnchorSideRight.Control = SpeedButtTBMenu AnchorSideBottom.Control = SpeedButHide AnchorSideBottom.Side = asrBottom Left = 418 Height = 40 Top = 490 Width = 96 Anchors = [akTop, akRight, akBottom] Caption = 'Help' Glyph.Data = { 36090000424D3609000000000000360000002800000018000000180000000100 2000000000000009000064000000640000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000D45500FFD45500FFD45500FF000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000D45500FFD45500FFD45500FF000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000D45500FFD45500FFD45500FF000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000D4540088D4540088D4540088FF0000010000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000FF80 0002D45500FFD45500FFD45500FFDB4900070000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000D45500F2D45500FFD45500FFD65300250000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000D45500C2D45500FFD45500FFD55500AECC66000500000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000D355004BD45500FED45500FFD45500FFD35500B5D15D000B000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000D3560074D45500FED45500FFD45500FFD45500C8D55500120000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000D3560062D45500FBD45500FFD45500FFD35500C1CC66 0005000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000D656004AD55500F6D45500FFD45500FFD456 0065000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000D9590014D555003CD356005CD656003E0000 000000000000000000000000000000000000D4560095D45500FFD45500FFD555 00AE000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000D356007AD45500FFD45500FFD55500CCFF00 000100000000000000000000000000000000D554008BD45500FFD45500FFD455 00B3000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000D5550030D45500FFD45500FFD45500FFD456 007DFF0000010000000000000000D3570029D45500EDD45500FFD45500FFD356 0074000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000D45600A1D45500FFD45500FFD455 00FFD35500D3D455009FD45500B3D45500F8D45500FFD45500FFD45500DBD15D 000B000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000DB490007D35400A9D45500FFD455 00FFD45500FFD45500FFD45500FFD45500FFD45500FFD55500D2D15500210000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000D4560047D454 00A6D45500D9D55500EAD45500DCD45500B3D3550063DB490007000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000 } Visible = False OnClick = SpeedButHelpClick end object SelectDirectoryDialog1: TSelectDirectoryDialog Options = [ofShareAware, ofEnableSizing] Left = 408 end object OpenDialogLibrary: TOpenDialog Options = [ofPathMustExist, ofFileMustExist, ofNoDereferenceLinks, ofEnableSizing, ofViewDetail] Left = 480 end object OpenDialogDictionary: TOpenDialog Left = 656 Top = 104 end object FontDialog1: TFontDialog MinFontSize = 0 MaxFontSize = 0 Left = 552 end object PMenuMain: TPopupMenu Left = 120 Top = 480 end object TimerAutoSync: TTimer Enabled = False OnTimer = TimerAutoSyncTimer Left = 736 Top = 48 end object SelectSnapDir: TSelectDirectoryDialog Left = 640 end end tomboy-ng_0.34-1/source/settings.lrj0000644000175000017500000003614214145033507017274 0ustar dbannondbannon{"version":1,"strings":[ {"hash":223420702,"name":"tsett.caption","sourcebytes":[70,111,114,109,32,67,97,112,116,105,111,110],"value":"Form Caption"}, {"hash":4753907,"name":"tsett.tabbasic.caption","sourcebytes":[66,97,115,105,99],"value":"Basic"}, {"hash":250232021,"name":"tsett.buttonsetnotepath.hint","sourcebytes":[73,102,32,121,111,117,32,104,97,118,101,32,110,111,116,101,115,32,115,111,109,101,119,104,101,114,101,32,101,108,115,101],"value":"If you have notes somewhere else"}, {"hash":121012803,"name":"tsett.buttonsetnotepath.caption","sourcebytes":[83,101,116,32,80,97,116,104,32,116,111,32,78,111,116,101,32,70,105,108,101,115],"value":"Set Path to Note Files"}, {"hash":72385672,"name":"tsett.labelsettingpath.caption","sourcebytes":[76,97,98,101,108,83,101,116,116,105,110,103,80,97,116,104],"value":"LabelSettingPath"}, {"hash":222591720,"name":"tsett.labelnotespath.caption","sourcebytes":[76,97,98,101,108,78,111,116,101,115,80,97,116,104],"value":"LabelNotesPath"}, {"hash":258040074,"name":"tsett.label1.caption","sourcebytes":[83,101,116,116,105,110,103,115,32,119,105,108,108,32,98,101,32,115,97,118,101,100,32,105,110,32,58],"value":"Settings will be saved in :"}, {"hash":38840874,"name":"tsett.label2.caption","sourcebytes":[78,111,116,101,115,32,119,105,108,108,32,98,101,32,108,111,111,107,101,100,32,102,111,114,32,97,110,100,32,115,97,118,101,100,32,105,110,32,58],"value":"Notes will be looked for and saved in :"}, {"hash":166209411,"name":"tsett.buttdefaultnotedir.hint","sourcebytes":[87,105,108,108,32,119,111,114,107,32,102,111,114,32,109,97,110,121,32,110,101,119,32,117,115,101,114,115],"value":"Will work for many new users"}, {"hash":48435422,"name":"tsett.buttdefaultnotedir.caption","sourcebytes":[85,115,101,32,68,101,102,97,117,108,116,32,78,111,116,101,115,32,76,111,99,97,116,105,111,110],"value":"Use Default Notes Location"}, {"hash":140021374,"name":"tsett.checkautostart.caption","sourcebytes":[65,117,116,111,115,116,97,114,116,32,97,116,32,76,111,103,111,110],"value":"Autostart at Logon"}, {"hash":28987956,"name":"tsett.checkshowsearchatstart.caption","sourcebytes":[83,104,111,119,32,83,101,97,114,99,104,32,97,116,32,83,116,97,114,116],"value":"Show Search at Start"}, {"hash":204462302,"name":"tsett.checkshowsplash.hint","sourcebytes":[65,108,119,97,121,115,32,115,104,111,119,110,32,105,102,32,101,114,114,111,114,32,108,111,97,100,105,110,103,32,110,111,116,101,115,46],"value":"Always shown if error loading notes."}, {"hash":196767252,"name":"tsett.checkshowsplash.caption","sourcebytes":[83,104,111,119,32,83,112,108,97,115,104,32,97,116,32,83,116,97,114,116],"value":"Show Splash at Start"}, {"hash":146065017,"name":"tsett.checkshowtomdroid.caption","sourcebytes":[83,104,111,119,32,84,111,109,100,114,111,105,100,32,83,121,110,99,32,40,101,120,112,101,114,105,109,101,110,116,97,108,41],"value":"Show Tomdroid Sync (experimental)"}, {"hash":192901619,"name":"tsett.checknotifications.caption","sourcebytes":[83,104,111,119,32,78,111,116,105,102,105,99,97,116,105,111,110,115],"value":"Show Notifications"}, {"hash":5597891,"name":"tsett.tabdisplay.caption","sourcebytes":[78,111,116,101,115],"value":"Notes"}, {"hash":90566245,"name":"tsett.groupbox5.caption","sourcebytes":[70,111,110,116,32,83,105,122,101],"value":"Font Size"}, {"hash":18679,"name":"tsett.radiofontbig.caption","sourcebytes":[66,105,103],"value":"Big"}, {"hash":87797949,"name":"tsett.radiofontmedium.caption","sourcebytes":[77,101,100,105,117,109],"value":"Medium"}, {"hash":5912620,"name":"tsett.radiofontsmall.caption","sourcebytes":[83,109,97,108,108],"value":"Small"}, {"hash":326613,"name":"tsett.radiofonthuge.caption","sourcebytes":[72,117,103,101],"value":"Huge"}, {"hash":36234723,"name":"tsett.checkshowintlinks.caption","sourcebytes":[83,104,111,119,32,73,110,116,101,114,110,97,108,32,76,105,110,107,115],"value":"Show Internal Links"}, {"hash":133237667,"name":"tsett.checkshowextlinks.caption","sourcebytes":[83,104,111,119,32,69,120,116,101,114,110,97,108,32,32,76,105,110,107,115],"value":"Show External Links"}, {"hash":224827470,"name":"tsett.checkmanynotebooks.hint","sourcebytes":[84,104,105,115,32,109,97,121,32,97,100,118,101,114,115,108,121,32,97,102,102,101,99,116,32,116,114,97,100,105,116,105,111,110,97,108,32,84,111,109,98,111,121,44,32,116,97,107,101,32,99,97,114,101,46],"value":"This may adversly affect traditional Tomboy, take care."}, {"hash":107781534,"name":"tsett.checkmanynotebooks.caption","sourcebytes":[65,108,108,111,119,32,97,32,78,111,116,101,32,116,111,32,98,101,32,105,110,32,77,117,108,116,105,112,108,101,32,78,111,116,101,98,111,111,107,115,46],"value":"Allow a Note to be in Multiple Notebooks."}, {"hash":132194532,"name":"tsett.buttonfont.caption","sourcebytes":[85,115,117,97,108,32,70,111,110,116],"value":"Usual Font"}, {"hash":190850740,"name":"tsett.buttonfixedfont.caption","sourcebytes":[70,105,120,101,100,32,70,111,110,116],"value":"Fixed Font"}, {"hash":169650899,"name":"tsett.buttonsetcolours.caption","sourcebytes":[83,101,116,32,67,111,108,111,117,114,115],"value":"Set Colours"}, {"hash":2213269,"name":"tsett.label10.caption","sourcebytes":[72,101,108,112,32,78,111,116,101,115,32,76,97,110,103,117,97,103,101],"value":"Help Notes Language"}, {"hash":141148457,"name":"tsett.checkuseundo.hint","sourcebytes":[67,108,111,115,101,32,97,110,100,32,114,101,111,112,101,110,32,97,32,110,111,116,101,32,116,111,32,116,97,107,101,32,101,102,102,101,99,116,46,32,85,115,101,32,67,116,114,108,45,90,32,67,116,114,108,45,89],"value":"Close and reopen a note to take effect. Use Ctrl-Z Ctrl-Y"}, {"hash":173353,"name":"tsett.checkuseundo.caption","sourcebytes":[85,115,101,32,85,110,100,111,32,82,101,100,111,32,40,109,97,121,32,115,108,111,119,32,101,100,105,116,105,110,103,41],"value":"Use Undo Redo (may slow editing)"}, {"hash":20422100,"name":"tsett.label17.caption","sourcebytes":[68,97,116,101,32,83,116,97,109,112,32,70,111,114,109,97,116],"value":"Date Stamp Format"}, {"hash":11022323,"name":"tsett.checkstampitalics.caption","sourcebytes":[73,116,97,108,105,99,115],"value":"Italics"}, {"hash":5912620,"name":"tsett.checkstampsmall.caption","sourcebytes":[83,109,97,108,108],"value":"Small"}, {"hash":300580,"name":"tsett.checkstampbold.caption","sourcebytes":[66,111,108,100],"value":"Bold"}, {"hash":372803,"name":"tsett.tabsync.caption","sourcebytes":[83,121,110,99],"value":"Sync"}, {"hash":182977360,"name":"tsett.groupbox4.caption","sourcebytes":[32,32,79,112,116,105,111,110,115,32,32],"value":" Options "}, {"hash":201511066,"name":"tsett.label3.caption","sourcebytes":[87,104,101,110,32,97,32,99,111,110,102,108,105,99,116,32,105,115,32,100,101,116,101,99,116,101,100,32,98,101,116,119,101,101,110,32,97,32,108,111,99,97,108,32,110,111,116,101,32,97,110,100,32,114,101,109,111,116,101,32,111,110,101,32,58],"value":"When a conflict is detected between a local note and remote one :"}, {"hash":209241694,"name":"tsett.radioalwaysask.caption","sourcebytes":[65,108,119,97,121,115,32,65,115,107,32,109,101,32,119,104,97,116,32,116,111,32,100,111,46],"value":"Always Ask me what to do."}, {"hash":72224622,"name":"tsett.radiouselocal.caption","sourcebytes":[85,115,101,32,76,111,99,97,108,32,78,111,116,101,32,97,110,100,32,79,118,101,114,119,114,105,116,101,32,83,101,114,118,101,114,32,78,111,116,101,46],"value":"Use Local Note and Overwrite Server Note."}, {"hash":58056046,"name":"tsett.radiouseserver.caption","sourcebytes":[85,115,101,32,83,101,114,118,101,114,32,78,111,116,101,32,97,110,100,32,82,101,110,97,109,101,32,76,111,99,97,108,32,78,111,116,101,46],"value":"Use Server Note and Rename Local Note."}, {"hash":95438592,"name":"tsett.groupboxsync.caption","sourcebytes":[32,32,83,121,110,99,32,32],"value":" Sync "}, {"hash":147264400,"name":"tsett.label4.caption","sourcebytes":[82,101,112,111,32,58,32],"value":"Repo : "}, {"hash":177761188,"name":"tsett.labelsyncrepo.caption","sourcebytes":[110,111,116,32,99,111,110,102,105,103,117,114,101,100],"value":"not configured"}, {"hash":5884864,"name":"tsett.speedsetupsync.caption","sourcebytes":[83,101,116,117,112],"value":"Setup"}, {"hash":157051598,"name":"tsett.checkboxautosync.hint","sourcebytes":[83,121,110,99,44,32,105,102,32,112,111,115,115,105,98,108,101,32,111,110,99,101,32,97,110,32,104,111,117,114,46],"value":"Sync, if possible once an hour."}, {"hash":185985155,"name":"tsett.checkboxautosync.caption","sourcebytes":[65,117,116,111,32,83,121,110,99],"value":"Auto Sync"}, {"hash":66344129,"name":"tsett.labelsyncinfo1.caption","sourcebytes":[76,97,98,101,108,83,121,110,99,73,110,102,111,49],"value":"LabelSyncInfo1"}, {"hash":66344130,"name":"tsett.labelsyncinfo2.caption","sourcebytes":[76,97,98,101,108,83,121,110,99,73,110,102,111,50],"value":"LabelSyncInfo2"}, {"hash":5988798,"name":"tsett.labellabeltoken.caption","sourcebytes":[84,111,107,101,110],"value":"Token"}, {"hash":379330,"name":"tsett.labelusername.caption","sourcebytes":[85,115,101,114],"value":"User"}, {"hash":226381813,"name":"tsett.editusername.text","sourcebytes":[69,100,105,116,85,115,101,114,78,97,109,101],"value":"EditUserName"}, {"hash":267900916,"name":"tsett.checksyncenabled.caption","sourcebytes":[83,121,110,99,32,69,110,97,98,108,101,100],"value":"Sync Enabled"}, {"hash":118352670,"name":"tsett.speedtokenpaste.hint","sourcebytes":[80,97,115,116,101,32,84,111,107,101,110],"value":"Paste Token"}, {"hash":190842830,"name":"tsett.speedtokencopy.hint","sourcebytes":[67,111,112,121,32,84,111,107,101,110],"value":"Copy Token"}, {"hash":146933861,"name":"tsett.labeltoken.caption","sourcebytes":[76,97,98,101,108,84,111,107,101],"value":"LabelToke"}, {"hash":103494789,"name":"tsett.combosynctype.text","sourcebytes":[67,111,109,98,111,83,121,110,99,84,121,112,101],"value":"ComboSyncType"}, {"hash":72743781,"name":"tsett.labelsynctype.caption","sourcebytes":[83,121,110,99,32,84,121,112,101],"value":"Sync Type"}, {"hash":75997376,"name":"tsett.tabbackup.caption","sourcebytes":[66,97,99,107,85,112],"value":"BackUp"}, {"hash":146435218,"name":"tsett.tabrecover.caption","sourcebytes":[82,101,99,111,118,101,114],"value":"Recover"}, {"hash":33245741,"name":"tsett.label6.caption","sourcebytes":[66,97,99,107,117,112,32,102,105,108,101,115,32,97,114,101,32,109,97,100,101,32,119,104,101,110,32,121,111,117,32,100,101,108,101,116,101,32,97,32,110,111,116,101,32,111,114,32,116,104,101,32,115,121,110,99,32,115,121,115,116,101,109],"value":"Backup files are made when you delete a note or the sync system"}, {"hash":170155600,"name":"tsett.label7.caption","sourcebytes":[105,115,32,97,98,111,117,116,32,116,111,32,111,118,101,114,119,114,105,116,101,32,111,110,101,46,32],"value":"is about to overwrite one. "}, {"hash":61900782,"name":"tsett.label8.caption","sourcebytes":[84,104,101,121,32,114,101,109,97,105,110,44,32,102,111,114,101,118,101,114,44,32,117,110,108,101,115,115,32,121,111,117,32,100,111,32,115,111,109,101,116,104,105,110,103,32,97,98,111,117,116,32,116,104,101,109,46],"value":"They remain, forever, unless you do something about them."}, {"hash":167155045,"name":"tsett.buttonshowbackup.caption","sourcebytes":[83,104,111,119,32,77,101],"value":"Show Me"}, {"hash":113991683,"name":"tsett.label11.caption","sourcebytes":[66,97,99,107,117,112,32,70,105,108,101,115],"value":"Backup Files"}, {"hash":14368846,"name":"tsett.label9.caption","sourcebytes":[65,32,115,110,97,112,104,111,116,32,105,115,32,97,32,99,111,112,121,32,111,102,32,121,111,117,114,32,99,117,114,114,101,110,116,32,110,111,116,101,32,100,105,114,101,99,116,111,114,121,46],"value":"A snaphot is a copy of your current note directory."}, {"hash":75657378,"name":"tsett.labelsnapdir.caption","sourcebytes":[83,110,97,112,32,100,105,114],"value":"Snap dir"}, {"hash":16909939,"name":"tsett.checkautosnapenabled.caption","sourcebytes":[85,115,101,32,97,117,116,111,32,115,110,97,112,115,104,111,116,115],"value":"Use auto snapshots"}, {"hash":60902068,"name":"tsett.label5.caption","sourcebytes":[68,97,121,115,32,112,101,114,32,115,110,97,112,115,104,111,116],"value":"Days per snapshot"}, {"hash":99028035,"name":"tsett.label16.caption","sourcebytes":[77,97,120,105,109,117,109,32,110,117,109,98,101,114,32,111,102,32,115,110,97,112,115,104,111,116,115],"value":"Maximum number of snapshots"}, {"hash":7809598,"name":"tsett.buttonsnaprecover.hint","sourcebytes":[73,102,32,121,111,117,32,104,97,118,101,32,112,114,101,118,105,111,117,115,108,121,32,116,97,107,101,110,32,97,32,115,110,97,112,115,104,111,116,32,46,46,46],"value":"If you have previously taken a snapshot ..."}, {"hash":262535843,"name":"tsett.buttonsnaprecover.caption","sourcebytes":[82,101,99,111,118,101,114,32,76,111,115,116,32,78,111,116,101,115],"value":"Recover Lost Notes"}, {"hash":47647895,"name":"tsett.buttonmanualsnap.hint","sourcebytes":[84,97,107,101,32,97,32,116,105,109,101,32,115,116,97,109,112,101,100,32,115,110,97,112,115,104,111,116,32,111,102,32,110,111,116,101,115,32,97,110,100,32,99,111,110,102,105,103],"value":"Take a time stamped snapshot of notes and config"}, {"hash":106332564,"name":"tsett.buttonmanualsnap.caption","sourcebytes":[84,97,107,101,32,97,32,77,97,110,117,97,108,32,83,110,97,112,115,104,111,116],"value":"Take a Manual Snapshot"}, {"hash":5925932,"name":"tsett.tabspell.caption","sourcebytes":[83,112,101,108,108],"value":"Spell"}, {"hash":180692596,"name":"tsett.label13.caption","sourcebytes":[83,112,101,108,108,32,67,104,101,99,107,32,114,101,113,117,105,114,101,115,32,116,104,101,32,72,117,110,115,112,101,108,108,32,76,105,98,114,97,114,105,101,115,32,97,110,100],"value":"Spell Check requires the Hunspell Libraries and"}, {"hash":214004590,"name":"tsett.label14.caption","sourcebytes":[97,110,32,97,112,112,114,111,112,114,105,97,116,101,32,72,117,110,115,112,101,108,108,32,68,105,99,116,105,111,110,97,114,121,32,115,101,116,46],"value":"an appropriate Hunspell Dictionary set."}, {"hash":201965794,"name":"tsett.labelerror.caption","sourcebytes":[76,97,98,101,108,69,114,114,111,114],"value":"LabelError"}, {"hash":158633795,"name":"tsett.labellibrarystatus.caption","sourcebytes":[76,97,98,101,108,76,105,98,114,97,114,121,83,116,97,116,117,115],"value":"LabelLibraryStatus"}, {"hash":254182419,"name":"tsett.labeldicstatus.caption","sourcebytes":[76,97,98,101,108,68,105,99,83,116,97,116,117,115],"value":"LabelDicStatus"}, {"hash":131990665,"name":"tsett.labellibrary.caption","sourcebytes":[76,97,98,101,108,76,105,98,114,97,114,121],"value":"LabelLibrary"}, {"hash":126619603,"name":"tsett.labeldic.caption","sourcebytes":[76,97,98,101,108,68,105,99],"value":"LabelDic"}, {"hash":267742116,"name":"tsett.labeldicprompt.caption","sourcebytes":[76,97,98,101,108,68,105,99,80,114,111,109,112,116],"value":"LabelDicPrompt"}, {"hash":147480761,"name":"tsett.buttonsetspelllibrary.caption","sourcebytes":[83,101,116,32,83,112,101,108,108,32,76,105,98,114,97,114,121],"value":"Set Spell Library"}, {"hash":111338153,"name":"tsett.buttonsetdictionary.caption","sourcebytes":[83,101,116,32,68,105,99,116,105,111,110,97,114,121],"value":"Set Dictionary"}, {"hash":41467669,"name":"tsett.label15.caption","sourcebytes":[76,97,98,101,108,49,53],"value":"Label15"}, {"hash":4863637,"name":"tsett.speedbuthide.caption","sourcebytes":[67,108,111,115,101],"value":"Close"}, {"hash":343125,"name":"tsett.speedbutttbmenu.caption","sourcebytes":[77,101,110,117],"value":"Menu"}, {"hash":322608,"name":"tsett.speedbuthelp.caption","sourcebytes":[72,101,108,112],"value":"Help"} ]} tomboy-ng_0.34-1/source/notebook.lfm0000644000175000017500000001261414145033507017241 0ustar dbannondbannonobject NoteBookPick: TNoteBookPick Left = 861 Height = 436 Top = 322 Width = 579 Anchors = [] Caption = 'NoteBookPick' ClientHeight = 436 ClientWidth = 579 OnShow = FormShow LCLVersion = '2.3.0.0' object Panel1: TPanel AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom Left = 0 Height = 72 Top = 0 Width = 579 Anchors = [akTop, akLeft, akRight] ClientHeight = 72 ClientWidth = 579 TabOrder = 0 object Label1: TLabel AnchorSideLeft.Control = Panel1 Left = 9 Height = 19 Top = 52 Width = 51 Anchors = [akLeft] BorderSpacing.Left = 8 Caption = 'Label1' Font.Style = [fsBold] ParentFont = False end object Label3: TLabel AnchorSideLeft.Control = Panel1 Left = 9 Height = 19 Top = 20 Width = 47 Anchors = [akLeft] BorderSpacing.Left = 8 Caption = 'Label3' end end object ButtonOK: TButton AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 448 Height = 61 Top = 375 Width = 131 Anchors = [akLeft, akRight, akBottom] Caption = 'OK' OnClick = ButtonOKClick TabOrder = 1 end object Button1: TButton AnchorSideRight.Control = ButtonOK AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 312 Height = 61 Top = 375 Width = 136 Anchors = [akLeft, akRight, akBottom] Caption = 'Cancel' ModalResult = 2 TabOrder = 2 end object Label2: TLabel AnchorSideLeft.Control = Owner AnchorSideTop.Control = PageControl1 AnchorSideTop.Side = asrBottom AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 7 Height = 19 Top = 388 Width = 47 BorderSpacing.Left = 7 BorderSpacing.Top = 13 Caption = 'Label2' end object PageControl1: TPageControl AnchorSideLeft.Control = Owner AnchorSideTop.Control = Panel1 AnchorSideTop.Side = asrBottom AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = ButtonOK Left = 0 Height = 303 Top = 72 Width = 579 ActivePage = TabNewNoteBook Anchors = [akTop, akLeft, akRight, akBottom] TabIndex = 1 TabOrder = 3 object TabExisting: TTabSheet Caption = 'Existing Note Books' ClientHeight = 274 ClientWidth = 575 object CheckListBox1: TCheckListBox AnchorSideLeft.Control = TabExisting AnchorSideTop.Control = TabExisting AnchorSideRight.Control = TabExisting AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = TabExisting AnchorSideBottom.Side = asrBottom Left = 0 Height = 274 Top = 0 Width = 575 Anchors = [akTop, akLeft, akRight, akBottom] ItemHeight = 0 OnItemClick = CheckListBox1ItemClick TabOrder = 0 TopIndex = -1 end end object TabNewNoteBook: TTabSheet Caption = 'New Note Book' ClientHeight = 274 ClientWidth = 575 OnShow = TabNewNoteBookShow object EditNewNotebook: TEdit Left = 24 Height = 28 Top = 56 Width = 248 OnKeyDown = EditNewNotebookKeyDown TabOrder = 0 end object Label4: TLabel Left = 26 Height = 19 Top = 32 Width = 202 Caption = 'Name of the New Notebook' end object Label5: TLabel Left = 29 Height = 19 Top = 104 Width = 472 Caption = 'Press OK and we will make the Note Book AND add this note to it.' end end object TabChangeName: TTabSheet Caption = 'Change Notebook Name' ClientHeight = 274 ClientWidth = 575 object Label6: TLabel Left = 15 Height = 19 Top = 17 Width = 103 Caption = 'Existing Name' end object Label7: TLabel Left = 17 Height = 19 Top = 41 Width = 47 Caption = 'Label7' end object Label8: TLabel Left = 16 Height = 19 Top = 77 Width = 80 Caption = 'New Name' end object EditNewNotebookName: TEdit Left = 17 Height = 28 Top = 96 Width = 271 OnEditingDone = EditNewNotebookNameEditingDone TabOrder = 0 end object Label9: TLabel Left = 18 Height = 19 Top = 153 Width = 506 Caption = 'If you sync and are not absolutely sure its up to date, Cancel now !' Font.Style = [fsBold] ParentFont = False end end object TabSetNotes: TTabSheet Caption = 'Set Notes' ClientHeight = 274 ClientWidth = 575 object CheckListAddNotes: TCheckListBox AnchorSideLeft.Control = TabSetNotes AnchorSideTop.Control = TabSetNotes AnchorSideRight.Control = TabSetNotes AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = TabSetNotes AnchorSideBottom.Side = asrBottom Left = 0 Height = 274 Top = 0 Width = 575 Anchors = [akTop, akLeft, akRight, akBottom] ItemHeight = 0 TabOrder = 0 TopIndex = -1 end end end end tomboy-ng_0.34-1/source/tbundo.pas0000644000175000017500000005035314145033507016723 0ustar dbannondbannonunit tbundo; { Copyright (C) 2021 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ A FPC/Lazarus Unit to providing a Text Only undo/redo facility to KMemo. Intended for use in tomboy-ng, it may well be useful in other Lazarus applications that use KMemo, a component of KControls. See also tomboy-ng - https://github.com/tomboy-notes/tomboy-ng KControls - https://github.com/kryslt/KControls } { A unit to provide storage for undo / redo of the text in the tb-ng kmemo. AvailChanges represents the number of changes we have in the data structure. It starts at zero and goes up to MaxChanges, once MaxChanges is reached, it stays there, overwriting oldest entries. It goes down if we undo, undo ... and then add a new change. AvailRedos is usually zero, is only incremented during an Undo session. As soon as that session is terminated (by a new change) we zonk this var. NextChange is an index that points to the next data location to store a change. It starts at zero and is incremented up to MaxChanges -1 after that, rolls around to zero. Undo and Redo play with this var too. Actions RecordInitial Captures the relevent kmemo content before any changes are made. Stored in a pair of 'regional' variables that get overwritten all the time. Not every write to the vars results in a write to the data structure (some efficency to be gained here ...). Add* Stores data at location pointed to by NextChange, inc NextChange and AvailChanges (observing respective Max). If AvailRedos is not zero, zero it, end of a undo session. UnDo We can only do this if AvailChanges is greater than zero. Sets Current to data in previous location. inc AvailRedos and dec AvailChanges and NextChange. ReDo We can only do this if AvailRedos is greater than zero. Sets Current to data in NextChange location (we must have backed over it already). dec AvailRedos and inc AvailChanges and NextChange. Refinement ? If, in AddKeyPress, we are just adding a single char and its prev StartSelIndex is only one less than this one, can we add that char to previous NewData ? No, cannot tell after the first one. Maybe add a flag saying this is a single char at a time entry and count the char in there already ???? ToDo : read above..... In the Unit using KMemo : We must intercept every key press, cut and paste, delete, backspace key. Because by time we get to OnKeyPress, selected text has already been removed, we must record any selection in the OnKeyDown event. But the OnKeyDown event does not give us the plain text char typed by that key. So, we hook into all three, OnKeyDown, OnKeyPress, OnKeyUp (the latter just for delete and backspace). We capture the initial state in OnKeyDown, the actual key and final state in OnKeyPress (or onKeyUp for Delete and Backspace). Paste and Cut are more strait forward, we watch for a Ctrl-V or Ctrl-X and record any currently selected content and in the case of Ctrl-V the clipboard content. Easy. Capturing addition or removal of markup is similar to text change, we capture initial state in RecordInitial and then call AddMarkup after the change. If the app has a menu that offers Undo/Redo, might be best to enable/disable them when user activates the menu, not on each keypress. } {$mode ObjFPC}{$H+} {x$DEFINE DEBUG_UNDO} // Warning, debug uses writeln, don't use on Windows ! interface uses Classes, SysUtils, KMemo, KControls; type TChangeRec = record StartSelIndex : integer; // Zero based index where activity starts ExistLen : integer; NewLen : integer; ExistData : string; // The content that was initially there and deleted. NewData : string; // The content that was initially added. end; const MaxChange = 25; // ToDo : set this to, eg, 100, when tested OK type TChangeStructure = array[0..MaxChange-1] of TChangeRec; { TUndo_Redo } TUndo_Redo = class private TheKMemo : TKMemo; // A ref to the KMemo we are managing. Set in create() CurrentCR : TChangeRec; // Only valid after a call to Undo or Redo AvailChanges : integer; // Number of usable changes we have in the structure AvailReDos : integer; // Number of changes we have just undone, we can redo this many NextChange : integer; // An index to the next place to put a change, may, or may not be empty ChangeStructure : TChangeStructure; Overwritten : string; // For split actions, eg, a keypress, stores (RTF) selected content OverwrittenLen : integer; // Length of plain, displayed text matching Overwritten procedure CopyChange(const SelStart, ELen, NLen: integer; const ExistData, NewData: string; var CRec: TChangeRec); procedure CopyChange(const FromCRec: TChangeRec; var ToCRec : TChangeRec); // Returns an RTF version of current selection, '' if nothing selected. function GetSelectedRTF(): string; // Adds a Change to man data structure, either data may be empty/0. // ELen, ExistDate represent existing content to be overwritten // NLen, NewData is content being introduced by this change. procedure AddChange(const SelStart, ELen, NLen: integer; const ExistData, NewData: string); procedure AddChange(CR : TChangeRec); // Pushes the indicated content into KMemo1, may be an Undo or Redo, accepts // both plain text or RTF. procedure InsertIntoKMemo(loc: integer; St: string); Public // Public : Hooked into the KMemo1KeyDown or just before a // markup change. It pre loads OverwrittenLen and // Overwritten with selected content (or content near cursor // for Delete or Backspace. Key is only significent if its // Delete or Backspace. Its does no harm if called without // the followup (AddMarkup, AddKeyPress or AddKeyUp). procedure RecordInitial(const Key: word); // Public. Call immediatly after a Markup related change. // Depends on the Overwritten and OverwrittenLen // having been recorded before the change by RecordInitial() procedure AddMarkup({MarkUp: TChangeMarkUp}); // Public : Called from KMemo1 onKeyPress event, assumes privare var, // Overwritten has been initialised with anything being overwritten. procedure AddKeyPress(Key: char); // Public : Called from KMemo1 onKeyUp event, handles // only delete and backspace keys. procedure AddKeyUp(Key: Word; Shift: TShiftState); // Public : Called before a paste happens, captures incoming // content and the existing selected content, all as RFT. // Atomic, does not depend on Overwritten. procedure AddPasteOrCut(CutOnly: boolean=false); // Public: Called when a primary paste (ie middle mouse, three // finger tap on Linux or Windows) or some other 'insert' happens. // We should have already checked that buffer contains some text. procedure AddTextInsert(const SelIndex : integer; const Content : string); function CanUnDo() : boolean; function CanRedo() : boolean; // Public : Does Undo, rets True if another Undo is possible // Always safe to call, may do nothing. function UnDo : boolean; // Public : Does Redo, rets True if another Redo is possible // Always safe to call, may do nothing. function ReDo : boolean; constructor Create(KM: TKMemo); // Public : For debug purposes only, don't leave for release. {$IFDEF DEBUG_UNDO} procedure Report();{$endif} end; implementation uses LCLType; // First, a pivate helper function. // Returns Clipboard contents as either RTF or Text, '' if unavailable function ClipboardContents(var Content : string; var TSize : integer) : boolean; var AStream: TMemoryStream; begin Result := true; AStream := TMemoryStream.Create; try // We use kcontrols tool, ClipBoardLoadStreamAs() here to ensure we get exactly the same result. if ClipBoardLoadStreamAs(cRichText, AStream, Content) and (AStream.Size > 0) then begin TSize := Content.Length; // Grab it before overwriting, thats bytes, not char, UTF8 issue ?? AStream.Seek(0, soFromBeginning); setlength(Content, AStream.Size); AStream.ReadBuffer(Pointer(Content)^, AStream.Size); end else TSize := Content.Length; // even if above fails, we probably have text. finally AStream.Free; end; end; { ------------ TUndo_Redo -----------} procedure TUndo_Redo.RecordInitial(const Key : word); begin // We may arrive here under a number of conditions - // 1. A simple key press, 'normal' key, nothing selected // 2. A simple Delete, nothing selected, char UNDER cursor goes away. // 3. A simple Backspace, nothing selected, char to left of cursor goes away. // 4. Any one of the above, but with something selected. What ever is selected // goes away and is replaced with nothing or the key if its 1. above. // 5. New - Also from a markup change, called just before the markup is applied. Overwritten := GetSelectedRTF(); OverwrittenLen := TheKMemo.RealSelLength; if OverwrittenLen = 0 then begin // OK, nothing selected then. // VK_Back nor VK_Delete will go on to trigger a KeyPress event, we call that from KeyUp event. if (Key = VK_Delete) and (TheKmemo.text.Length > TheKmemo.Blocks.RealSelStart) then begin // Must be delete char under cursor TheKmemo.SelLength := 1; Overwritten := TheKmemo.Blocks.SelText; // Note this is plain text, not RTF TheKmemo.SelLength := 0; OverwrittenLen := 1; end; if (Key = VK_Back) and (TheKMemo.RealSelStart > 0) then begin TheKmemo.SelStart := TheKmemo.RealSelStart - 1; TheKmemo.SelLength := 1; Overwritten := TheKmemo.Blocks.SelText; // Note this is plain text, not RTF TheKmemo.SelStart := TheKmemo.RealSelStart + 1; TheKmemo.SelLength := 0; OverwrittenLen := 1; end; end; end; function TUndo_Redo.GetSelectedRTF() : string; var AStream : TMemoryStream; begin result := ''; if TheKMemo.Blocks.RealSelLength > 0 then begin AStream := TMemoryStream.Create; try TheKMemo.SaveToRTFStream(AStream, True); if AStream.Size > 0 then begin AStream.Seek(0, soBeginning); SetLength(Result, AStream.Size); AStream.ReadBuffer(Pointer(Result)^, AStream.Size); end; finally AStream.Free; end; end; end; procedure TUndo_Redo.AddPasteOrCut(CutOnly: boolean); var CR : TChangeRec; begin CR.StartSelIndex := TheKmemo.blocks.RealSelStart; if CutOnly then begin CR.NewData := ''; CR.NewLen := 0; end else ClipboardContents(CR.NewData, CR.NewLen); // wot, not checking return value ? brave .... CR.ExistLen := TheKMemo.RealSelLength; CR.ExistData := GetSelectedRTF(); AddChange(CR); end; procedure TUndo_Redo.AddTextInsert(const SelIndex: integer; const Content: string); // ToDo : Inconsistent, other public methods find their own data .... begin AddChange(SelIndex, 0, Content.Length, '', Content); end; procedure TUndo_Redo.AddKeyPress(Key: char); begin AddChange(TheKMemo.CaretPos-1, OverwrittenLen, 1, Overwritten, Key); // -1 `cos its already happened end; procedure TUndo_Redo.AddKeyUp(Key: Word; Shift: TShiftState); begin if Key = VK_Delete then begin // Maybe delete char under cursor or a selected block if TheKmemo.text.Length > TheKmemo.Blocks.RealSelStart then begin AddChange(TheKmemo.blocks.RealSelStart, OverwrittenLen, 0, Overwritten, ''); end; end; if Key = VK_Back then begin if TheKMemo.RealSelStart >= 0 then AddChange(TheKmemo.blocks.RealSelStart, OverwrittenLen, 0, Overwritten, ''); end; end; function TUndo_Redo.CanUnDo(): boolean; begin Result := (AvailChanges > 0); {$IFDEF DEBUG_UNDO} writeln('Can Undo ' + booltostr(result, True)); {$endif} end; function TUndo_Redo.CanRedo(): boolean; begin Result := (AvailReDos > 0); {$IFDEF DEBUG_UNDO} writeln('Can Redo ' + booltostr(result, True)); {$endif} end; // -------------- Recording Change Methods ---------------------- procedure TUndo_Redo.AddMarkup(); var CR : TChangeRec; begin CR.StartSelIndex := TheKmemo.blocks.RealSelStart; // assume this has not moved ?? CR.ExistLen := OverwrittenLen; CR.ExistData := Overwritten; CR.NewLen := OverwrittenLen; CR.NewData := GetSelectedRTF(); AddChange(CR); end; procedure TUndo_Redo.AddChange(const SelStart, ELen, NLen : integer; const ExistData, NewData: string{; const MarkUp : TChangeMarkup}); begin {$IFDEF DEBUG_UNDO} writeln('AddChange at ' + inttostr(SelStart) + ' replace [' + ExistData + '] (' + inttostr(ELen) + ') with [' + NewData + '] (' + inttostr(NLen) + ')'); {$ENDIF} CopyChange(SelStart, ELen, NLen, ExistData, NewData, ChangeStructure[NextChange]); inc(NextChange); if NextChange = MaxChange then NextChange := 0; if AvailChanges < MaxChange then inc(AvailChanges); AvailReDos := 0; // Once we make a non undo/redo change, no more redos available end; procedure TUndo_Redo.AddChange(CR: TChangeRec); begin AddChange(CR.StartSelIndex, CR.ExistLen, CR.NewLen, CR.ExistData, CR.NewData); end; // --------- Do and Undo methods ------------ procedure TUndo_Redo.InsertIntoKMemo(loc : integer; St : string); var AStream: TMemoryStream; begin if copy(St, 1, 11) = '{\rtf1\ansi' then begin AStream := TMemoryStream.Create; try AStream.Write(St[1], St.length); AStream.Seek(0, soFromBeginning); TheKMemo.LoadFromRTFStream(AStream, Loc); TheKMemo.SelStart := loc; // ToDo : should restore cursor to end of any new text, but how long is that .... ? finally AStream.Free; end; end else begin TheKMemo.ActiveBlocks.InsertPlainText(Loc, St); TheKMemo.SelStart := loc + length(St); end; TheKMemo.SelLength := 0; // So nothing is accidently selected end; function TUndo_Redo.UnDo: boolean; var Target : integer; begin if not CanUnDo() then exit(False); Target := NextChange; if Target > 0 then dec(Target) else Target := MaxChange -1; CopyChange(ChangeStructure[Target], CurrentCR); inc(AvailReDos); dec(AvailChanges); if NextChange > 0 then dec(NextChange) else NextChange := MaxChange-1; result := (AvailChanges > 0); // can we call UnDo again ? with CurrentCR do begin {$IFDEF DEBUG_UNDO} writeln('Undo at ' + inttostr(StartSelIndex) + ' replace [' + NewData + '] with [' + ExistData + ']'); {$ENDIF} Thekmemo.Blocks.LockUpdate; try if NewData <> '' then begin Thekmemo.SelStart := StartSelIndex; Thekmemo.SelLength := NewLen; TheKmemo.Blocks.ClearSelection; end; // Insert Replace at Loc if ExistData <> '' then InsertIntoKMemo(StartSelIndex, ExistData); finally Thekmemo.Blocks.UnLockUpdate; end; end; {$IFDEF DEBUG_UNDO} Report(); {$endif} end; function TUndo_Redo.ReDo: boolean; // A redo uses the data currently pointed to by NextChange begin if not CanReDo then exit(False); CopyChange(ChangeStructure[NextChange], CurrentCR); dec(AvailReDos); // one less ReDos available inc(AvailChanges); // cos we can go back there if we so choose. inc(NextChange); // Point to next one if NextChange = MaxChange then NextChange := 0; result := (AvailReDos > 0); // can we call ReDo again ? with CurrentCR do begin {$IFDEF DEBUG_UNDO} writeln('Redo at ' + inttostr(StartSelIndex) + ' replace [' + ExistData + '] with [' + NewData + ']'); {$ENDIF} try Thekmemo.Blocks.LockUpdate; if ExistData <> '' then begin Thekmemo.SelStart := StartSelIndex; Thekmemo.SelLength := ExistLen; TheKmemo.Blocks.ClearSelection; end; if NewData <> '' then InsertIntoKMemo(StartSelIndex, NewData); finally Thekmemo.Blocks.UnLockUpdate; end; end; {$IFDEF DEBUG_UNDO} Report(); {$ENDIF} end; // ------------- House Keeping ------------------ procedure TUndo_Redo.CopyChange(const SelStart, ELen, NLen: integer; const ExistData, NewData: string; var CRec: TChangeRec); begin CRec.ExistData:= ExistData; CRec.NewData:= NewData; CRec.StartSelIndex:= SelStart; CRec.ExistLen := ELen; CRec.NewLen := NLen; end; procedure TUndo_Redo.CopyChange(const FromCRec: TChangeRec; var ToCRec: TChangeRec); begin CopyChange(FromCRec.StartSelIndex, FromCRec.ExistLen, FromCRec.NewLen, FromCRec.ExistData, FromCRec.NewData, ToCRec); end; {$IFDEF DEBUG_UNDO} procedure TUndo_Redo.Report(); // This is a Debug method, it has no place in a release ! var I : integer = 0; //MarkUpSt : string; begin //exit; writeln('---------- Undo Report ---------'); writeln('NextChange=' + inttostr(NextChange) + ' AvailChanges=' + inttostr(AvailChanges) + ' AvailReDos=' + inttostr(AvailReDos)); for I := 0 to MaxChange -1 do // ToDo : this is unnecessary, remove after testing if ChangeStructure[i].StartSelIndex >= 0 then begin writeln('Slot:' + inttostr(I) + ' Index:' + inttostr(ChangeStructure[i].StartSelIndex) + ' [' + ChangeStructure[i].ExistData + '] - [' + ChangeStructure[i].NewData + ']'{ + 'MarkUp=' + MarkUpSt}); end; writeln('Current : ' + inttostr(CurrentCR.StartSelIndex) + ' [' + CurrentCR.ExistData + '] - [' + CurrentCR.NewData + ']'); //writeln('Content [' + TheKMemo.Text + ']'); writeln('--------------------------------'); end; {$endif} constructor TUndo_Redo.Create(KM : TKMemo); var I : integer; begin TheKMemo := KM; for I := 0 to MaxChange-1 do // ToDo : maybe this is unnecessary, remove after testing ChangeStructure[i].StartSelIndex:= -1; end; end. tomboy-ng_0.34-1/source/Tomboy_NG.ico0000644000175000017500000002267614145033507017263 0ustar dbannondbannon00 %(0` $ddo o o+p{  to)o o  po oKy   ~oGop     rooo\|    oXooq    sooon   oloo+s %**#uo)oo  9VGJHGM/ o~oo9v  -I?:53.*$)!wo7o o  3'$##%%$$#%#&- po oIy  +2,-/137679:~:x;s;l8j<{&zoFop  LT_hfU?& $.9< qo os 3_XVXRt}iR::FD=;A, usL PX[Z]__]d{PILH@@<:9wg  3WW]^bdffdb^i\TTSMLJB>633*  LRX[]aaeiijfggb```\YYURMJC>;72..  3QNRWaagdhjjlnmjljdaba^XVQLFA=55-&%% DILPWZ^ecijnnpvsnrolifa`ZUPLIB>83+)"!'  /@BJOQW\]fkgkssrquqronlfc_]WRNHB@55-+$!!!/ 7:?ENNUZ]^eiiomvsuuttpnlhc^^TSLKA?93.+&! S"249AELPRY]adjjnnrqkjjjrnjhd\ZUQNICC:50)!2*&.8>?EJNVY]cbiikhe\VQVbkomjh_[[TQHE?74)&`a814>?BLQRW]`ba`_UOSZNPJ|Fmylhdd`ZWSRJF>=)<@A^m_TS`}pc`a]_[S>]ztlg\^?hς==Rr`D}Y]qcaa[\ZXKEztlg_\v ~6||}Hhv[LRd}dZY[ZYXUAhyrmg^[q/~ymHwX[q~mVWYUVVRFHyske^[gu5,8.[`Y||}cSfy||SNTSUSUL=lzrkd_W^†#=2 7+_Wmlljjjunvx{gT[JOOP>Jwrld^VZsa@5B7@3rvyOC8o}xrkc^WSbE8#G:`TNGb}xqjc\WQV~NOA~PBu󹹹 ~pid[UNNdTGVH]THqf08pZV]a3fLVH55tomboy-ng_0.34-1/source/transfileand.pas0000644000175000017500000012005514145033507020077 0ustar dbannondbannonunit transfileand; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ A unit that does the file transfer side of a very limited one to one Tomdroid Sync This version uses File sync (with a locally mounted android file system) not SSH. HISTORY 2020/12/29 Forked from transandroid 2020/01/13 Ready for testing, aware of two issues - 1. An error in older version of Android MTP, a deleted note can appear to remain in the sync dir but be unreadable until phone is rebooted. Msg appears std out. Seen often in Android 5.1.1, not at all in 8.0.0 2. When a note is deleted on one Android device, it will be restored by another. I need to add an entry in each current Android Local Manifest noting that it is a deleted file. 3. All this and related code does not work in Windows but its it is exposed to the compiler. Some ifdef's are in order here ... 2021/01/17 Added a method to convert the HTML Entities that Tomdroid sends us back to UTF8 2021/01/19 Restructed layout to allow ifdef to compile stubs when not Linux The Android File Sync Process (and the OneToOne one too) Create() Calls CheckRemoteDir that does much of the initial testing including setting RemoteAddress, testing for a server ID. CheckRemoteDir expects to find a gio 'Location' that it can use to build a 'path' to the tomboy-ng.serverid file. Alternativly, it looks in the TB_ONETOONE env var. Sync.SetTransport - Just returns the Sync Status already established by Create. Sync.TestTransport (parent) In repoUse mode - Reads Local Manifest (if exists), calls Trans.TestTransport, compares localServerID (from config and local manifest). If serverID problem, consult user, rets SyncMismatch In RepoNew mode, we ignore any local manifest and both local and remote serverIDs. A fresh start. Trans.TestTransport (here, for android file) Just writes a server ID if necessary. StartSync (A Sync Method, not here) It calls functions that build both meta data lists, acts on what it finds. Note that because of how the file based Tomdroid sync works, we set action to either RepoUse or RepoJoin, not RepoNew ! Join here is effectivly a combination of Join and New. A Join overwrites an existing ServerID with a new one. Tomdroid seems to need to be stopped after each (internal) sync to be sure of reliable notice of deleted notes. Otherwise, it sometimes seems to not notice that a previously synced note has now dissapeared from its sync dir (as a result of -ng syncing there) and therefore does not remove that note from its dbase when syncing. The "Remote Manifest" does not enter play here, we write one out because thats what Sync does but its ignored. Data normally obtained from a remote manifest is read directly from the 'remote' (but mounted on a local FS) sync files them selves. So, only status file we are interested in It would seem worth considering converting this to use libmtp, (same project, one echo of other) https://github.com/libmtp/libmtp https://sourceforge.net/projects/libmtp/ No formal docs but pretty clear examples in C available. Possibly buildable for windows but looks difficult, both building and installing for end user. } {$mode objfpc}{$H+} interface uses Classes, SysUtils, process, trans, SyncUtils, LazFileUtils; type { TAndSync } { TAndFileTrans } TAndFileTrans = Class(TTomboyTrans) private OneToOne : string; // a dir, if present, use it to sync to instead of expected Tomdroid gvfs one CheckRemoteDirResult : TSyncAvailable; // Searches for any UTF8 char (more than 1 char long) and replaces it with the // appropriate HTML Entity. Use on a note being sent to Tomdroid. eg Δ becomes Ɗ // NO - it turns out Tomdroid does not like us doing this so we'll send it UTF8 // and let Tomdroid deal with it itself. So far, seems OK ........... procedure AddHTMLNumericCode(var St: string); // Converts a note from local time plus offset to UTC with zero offset before // sending it to Tomdroid. Gets its input from std NotesDir and returns a // FullFileName to to a temp file that has been converted. Temp file is overwritten. function ChangeNoteDateUTC(const ID: string): string; // May return SyncNoRemoteDir, SyncReady, SyncNoServerID // Sets the RemoteDir to either the GVFS mountpoint plus phone/tomdroid // or to the TB_ONETOONE env var (if present). Tests for a the dir // and the presence of the serverID. function CheckRemoteDir: TSyncAvailable; // Copies any file from the mtp: location to ConfigDir + remote.note. // It does not, however, need to be a note. Gets overwritten all the time. function OS_DownLoadFile(FN: string): boolean; { Used in Tomdroid but not OneToOne mode. We rely on gio to get us a list of notes present in remoote dir. I experienced erratic behaviour when doing a findfirst(). } function GetNewNotesGIO(const NoteMeta: TNoteInfoList; const GetLCD: boolean) : boolean; // Will use RemoteAddress and append the FName to it. Will check its gone. // Cannot remove directories, ret false. OneToOne safe. function OS_DeleteFile(const FName: string): boolean; // Returns True if passed file (a full filename without path) exists // in the remote directory. If isDirectory, will test a compounded dir // but it must not have a leading seperator. It is OneToOne Safe. } function OS_FileExists(aName: string; isDirectory: boolean=false): boolean; // Assumes RemoteAddress now holds the basic gio Location, // just the first part. It will try and find a dir below // that that itself, contains 'tomdroid'. False if fail. function FindTomdroidDirectory(): boolean; // Fills out the passed stringlist (that must have been created) with // files and directories found in RemoteDir + aDir. Does not test that it has // found anything, just that the process completed. Is NOT OneToOne safe. function OS_ListDirectory(var List: TstringList; const aDir: string=''): boolean; // Attempts to find the gio location, searches for exactly one 'mtp://' // entry in gio mount -l output. Sets RemoteAddress to only that first term, // eg mtp://%5Busb%3A001,119%5D/ or mtp://Android_Android_ba0da805/ or // mtp://SAMSUNG_SAMSUNG_Android_52004dfb47a785e5/ always with trailing delim. function OS_Location(): boolean; procedure InsertNoteBookTags(const FullSourceFile, FullDestFile, TagString: string); // Looks for a tomboy.serverid file on remote FS, reads if found and makes sure // it is a GUID (but does not check that it is the right one). We copy it down // and read it locally as older Android's mtp seems unwilling to let me read it // in place. In OneToOne, we just read it. Implies that OneToOne is not mtp: ! function ReadServerID(): boolean; // Looks for any HTML Entities in passed string, changes then to UTF8 codepoint. // eg Ώ becomes the Omega char. Used when bringing a note back from Tomdroid function RemoveHTMLNumericCode(var St: string): boolean; // Writes a file called tomboy.serverid into remote dir, contains an ID function StampServerID(const ID: string): boolean; // Uploads the nominated file to MTPDIR using gio commands. // we may be able to do this directly with GVFS calls one day .... // But if in OneToOne mode, just uses copyFile( function OS_UploadFile(FullFileName: string; ID: string=''): boolean; public { has something like mtp://%5Busb%3A001,031%5D/Phone/tomdroid/ It is set by CheckRemoteDir, use as gio Location, append filename. } // RemoteAddress : string; // TAndFileTrans : will stamp a new serverid (if doing a join). function TestTransport(const WriteNewServerID : boolean = False) : TSyncAvailable; override; // In transFileAnd, just returns the already established status. function SetTransport() : TSyncAvailable; override; function GetRemoteNotes(const NoteMeta : TNoteInfoList; const GetLCD : boolean) : boolean; override; // TomdroidFile : we pull a file down locally to 'remote.note' but we could // speed things up a bit by making it go straight to destination. But what // about putting tags back into a note before overwriting orig ? function DownloadNotes(const DownLoads : TNoteInfoList) : boolean; override; function DeleteNote(const ID : string; const ExistRev : integer) : boolean; override; function UploadNotes(const Uploads : TStringList) : boolean; override; // TAndFileTrans : does nothing, Tomdroid model does not use remote manifest. function DoRemoteManifest(const RemoteManifest : string; MetaData : TNoteInfoList = nil) : boolean; override; // TransFileAnd : Pulls remote file down to 'remote.note and ret a full path to note, // '' if it was not found. OneOnOne friendly. function DownLoadNote(const ID : string; const RevNo : Integer) : string; Override; // Calls CheckRemoteDir that does much of the initial testing // including setting RemoteAddress, testing for a server ID. constructor Create(); end; implementation uses {users, } // for getUserID() laz2_DOM, laz2_XMLRead, FileUtil, LazLogger, forms, LazUTF8, tb_utils; { TAndSync } // ======================== Public Methods ============================= constructor TAndFileTrans.Create(); begin inherited.create; DebugMode := Application.HasOption('s', 'debug-sync'); CheckRemoteDirResult := CheckRemoteDir(); end; function TAndFileTrans.TestTransport(const WriteNewServerID : boolean = False): TSyncAvailable; var GUID : TGUID; //T1, T2, T3, T4 : DWord; begin { We have already checked the sync dir and established if, or if not we have a serverid there. So, it seems all we do here is make a new server id if necessary (ie if WriteNewServerID is true or ANewrepo is true). } if RemoteAddress = '' then exit(SyncNoRemoteRepo); ErrorString := ''; if WriteNewServerID and ANewRepo then begin CreateGUID(GUID); ServerID := copy(GUIDToString(GUID), 2, 36); // it arrives here wrapped in {} StampServerID(ServerID); end; // ToDo : should call readServerID() here to be sure ..... Result := SyncReady; end; function TAndFileTrans.SetTransport(): TSyncAvailable; begin Result := CheckRemoteDirResult; // CheckRemoteDir is called in Create, but later we need to know result. // serverID and RemoteDir will have been set if possible end; function TAndFileTrans.GetRemoteNotes(const NoteMeta: TNoteInfoList; const GetLCD : boolean): boolean; var NoteInfo : PNoteInfo; Info : TSearchRec; St : string; begin // by nature of how we get remote note date, always get LCD if NoteMeta = Nil then begin ErrorString := 'Passed an uncreated list to GetNewNotes()'; exit(False); end; if OneToOne = '' then exit( GetNewNotesGIO(NoteMeta, GetLCD)); // ie Tomdroid mode if FindFirst(RemoteAddress + '*.note', faAnyFile, Info)=0 then begin repeat St := GetNoteLastChangeSt(RemoteAddress + Info.Name, ErrorString); if St = '' then debugln('ERROR, TransFileAnd.GetDroidMetaData failed to find LCD in ' + RemoteAddress + Info.Name) else begin new(NoteInfo); NoteInfo^.Action:=SyUnset; NoteInfo^.ID := extractFileNameOnly(info.Name); NoteInfo^.Rev := -1; NoteInfo^.LastChange := St; NoteInfo^.LastChangeGMT := TB_GetGMTFromStr(St); NoteMeta.Add(NoteInfo); end; until FindNext(Info) <> 0; end; result := True; end; function TAndFileTrans.DeleteNote(const ID: string; const ExistRev : integer ): boolean; begin // MTP: seems to allow us to delete notes from there. But should we do it via GIO ??? //if FileExistsUTF8(RemoteAddress + ID + '.note') then begin if OS_FileExists(ID + '.note') then begin OS_DeleteFile(ID + '.note') // DeleteFileUTF8(RemoteAddress + ID + '.note') end else begin debugln('ERROR TransFileAnd.DeleteNote cannot find note to delete ' + RemoteAddress + ID + '.note'); exit(False); end; //if FileExistsUTF8(RemoteAddress + ID + '.note') then begin if OS_FileExists(ID + '.note') then begin debugln('ERROR TransFileAnd.DeleteNote Failed to delete note ' + RemoteAddress + ID + '.note'); exit(False); end else if debugmode then debugln('========= Deleted ' + RemoteAddress + ID + '.note'); result := True; end; function TAndFileTrans.UploadNotes(const Uploads: TStringList): boolean; var Index : integer; begin // OK, seems Tomdroid likes its date strings in UTC with zero offset, (not 'zulu' time) // messes with sync. So, before uploading a file, we'll // stuff about with its date strings. ChangeNoteDateUTC() makes a temp, edited copy and ret its full path. for Index := 0 to Uploads.Count -1 do begin if DebugMode then debugln('TransFileAnd.UploadNotes ' + Uploads.Strings[Index] + '.note'); if OS_FileExists(Uploads.Strings[Index] + '.note') then OS_DeleteFile(Uploads.Strings[Index] + '.note'); if FileExistsUTF8(NotesDir + Uploads.Strings[Index] + '.note') then OS_UploadFile(ChangeNoteDateUTC(Uploads.Strings[Index]{, True}), Uploads.Strings[Index]) else debugln('ERROR TransFileAnd.UploadNotes Failed to find ' + NotesDir + Uploads.Strings[Index] + '.note'); end; result := True; // unless, of course, we failed some how. Hmm... end; function TAndFileTrans.DoRemoteManifest(const RemoteManifest: string; MetaData: TNoteInfoList): boolean; begin // The Tomdroid sync model does not use a remote manifest. result := True; end; function TAndFileTrans.DownloadNotes(const DownLoads: TNoteInfoList): boolean; var I : integer; TempName : string; begin if not DirectoryExists(NotesDir + 'Backup') then if not ForceDirectory(NotesDir + 'Backup') then begin ErrorString := 'Failed to create Backup directory.'; exit(False); end; for I := 0 to DownLoads.Count-1 do begin if DownLoads.Items[I]^.Action = SyDownLoad then begin if FileExists(NotesDir + Downloads.Items[I]^.ID + '.note') then // First make a Backup copy if not CopyFile(NotesDir + Downloads.Items[I]^.ID + '.note', NotesDir + 'Backup' + PathDelim + Downloads.Items[I]^.ID + '.note') then begin ErrorString := 'Failed to copy file to Backup ' + NotesDir + Downloads.Items[I]^.ID + '.note'; exit(False); end; // OK, now pull down the file. // copyfile(RemoteAddress + Downloads.Items[I]^.ID + '.note', self.NotesDir + Downloads.Items[I]^.ID + '.note', false); //copyFile(DownloadNote(Downloads.Items[I]^.ID + '.note', -1), NotesDir + Downloads.Items[I]^.ID + '.note'); TempName := DownloadNote(Downloads.Items[I]^.ID + '.note', -1); copyfile(TempName, NotesDir + Downloads.Items[I]^.ID + '.note'); if not FileExists(NotesDir + Downloads.Items[I]^.ID + '.note') then debugln('ERROR, did not download ' + Downloads.Items[I]^.ID); end; end; result := True; end; function TAndFileTrans.DownLoadNote(const ID: string; const RevNo: Integer): string; var St : string; //AProcess: TProcess; //List : TStringList = nil; Extension : string = ''; InFile, OutFile: TextFile; InString : string; begin //debugln('===================== Called TAndFileSync.DownLoadNote( ========'); if not ID.EndsWith('.note') then Extension := '.note'; St := RemoteAddress + ID + Extension; if OneToOne = '' then if OS_DownLoadFile(ID + Extension) then St := ConfigDir + 'remote.note' else St := ''; if FileExistsUTF8(St) then begin // St, by this stage, should always be a local note, so no GioFileExists() AssignFile(InFile, St); AssignFile(OutFile, St + '-decoded'); try try Reset(InFile); Rewrite(OutFile); while not eof(InFile) do begin readln(InFile, InString); while RemoveHTMLNumericCode(InString) do; // eg Ώ becomes omega writeln(OutFile, InString); end; finally CloseFile(OutFile); CloseFile(InFile); end; except on E: EInOutError do begin debugln('ERROR TAndFileTrans.DownLoadNote - File handling error : ' + E.Message); ErrorString := 'ERROR TAndFileTrans.DownLoadNote - File handling error : ' + E.Message; exit(''); end; end; DeleteFile(St); CopyFile(St + '-decoded', St); exit(St); end; debugln('TransFileAnd.DownloadNote failed to find ' + St); Result := ''; end; // ======================= Private Methods that are OS Agnostic ================ function TAndFileTrans.FindTomdroidDirectory() : boolean; var List : TStringList; St : string; begin List := TStringList.Create; try if OS_ListDirectory(List, '') then begin // Remember, at this stage, RemoteAddress has just basic, first part. for St in List do if St <> '' then if OS_FileExists(appendPathDelim(St) + 'tomdroid', True) then begin RemoteAddress := RemoteAddress + appendPathDelim(St) + 'tomdroid' + PathDelim; exit(True); end else debugln('Tried ' + RemoteAddress + appendPathDelim(St) + 'tomdroid'); end else debugln('TAndFileSync.GioFindDirectory - ERROR, GioListDirectory returned false.'); finally List.free; end; debugln('TAndFileSync.GioFindDirectory - ERROR, could not find ' + RemoteAddress + '*/tomdroid' ); debugln('Please install Tomdroid and set it to sync to a "SD Card" directory called "tomdroid"'); result := False; end; function TAndFileTrans.StampServerID(const ID : string) : boolean; // Called by TestTransport if we require a new ServerID. var OutFile: TextFile; begin Result := False; if debugmode then debugln('TAndFileSync.StampServerID stamp at ' + RemoteAddress + 'tomboy.serverid'); AssignFile(OutFile, ConfigDir + 'tomboy.serverid'); try Rewrite(OutFile); writeln(OutFile, ID); Result := True; finally CloseFile(OutFile); end; if Debugmode then debugln('TAndFileSync.StampServerID - Local config is ' + ConfigDir); OS_UploadFile(ConfigDir + 'tomboy.serverid'); deletefile(ConfigDir + 'tomboy.serverid'); end; function TAndFileTrans.ReadServerID() : boolean; var FFN : string; //AProcess: TProcess; //List : TStringList = nil; InFile: TextFile; begin ServerID := ''; if OneToOne = '' then begin // ie Tomdroid mode if not OS_DownLoadFile('tomboy.serverid') then exit(false); FFN := Configdir + 'remote.note'; // I know ! Its not a note, sorry ! end else FFN := RemoteAddress + 'tomboy.serverid'; // As usual, if its OneToOne we assume not mtp: AssignFile(InFile, FFN); try Reset(InFile); readln(InFile, ServerID); // This causes a disk full error on xpedia ??? finally close(InFile); end; if not IDLooksOK(ServerID) then begin Debugln('TAndFileSync.ReadServerID unable to read tomboy.serverid, we got [' + ServerID + ']'); exit(False); end; Result := True; end; function TAndFileTrans.CheckRemoteDir : TSyncAvailable; begin // Assume : the user will create a dir called 'tomdroid' // Assume : we don't know the remainder of the token mtp:..... // Assume : we don't know the top level name presented by the device, 'phone', Internal Storage', 'tablet' .... // Assume : the above may be in spanish. So, unicode, spaces etc // Hmm, GetEnvironmentVariable('UID') fails ? No idea .... OneToOne := GetEnvironmentVariable('TB_ONETOONE'); if OneToOne = '' then begin // some duplicate code here but keep it simple .... OS_Location(); // Sets basic Location and Devices top level dir. //debugln('MTPDir after GioLocation() ' + RemoteAddress ); if RemoteAddress = '' then begin debugln('TAndFileSync.CheckRemoteDir ERROR - Have you connected Device to Computer ?'); exit(SyncNoRemoteDir); end; if not FindTomdroidDirectory() then exit(SyncNoRemoteDir); // else RemoteAddress now points to valid tomdroid dir. end else begin // OK, its OneToOne mode then ! RemoteAddress := appendPathDelim(OneToOne); if not DirectoryExistsUTF8(RemoteAddress) then begin debugln('Failed to find OnetoOne Dir : ' + RemoteAddress); exit(SyncNoRemoteDir); end; end; // OK, if to here we have a dir that we can work in, we should test that we can write to it. // If to here, we know we have a real dir in RemoteDir, maybe we should also test for writing ? Result := SyncNoRemoteRepo; if OS_FileExists('tomboy.serverid') then if ReadServerID() then Result := SyncReady; if Debugmode then begin debugln('TAndFileSync.CheckRemoteDir RemoteAddress = ' + RemoteAddress); debugln('TAndFileSync.CheckRemoteDir the ServerID = ' + ServerID); end; end; // Puts back the tag string into a temp note downloaded from dev and puts it in note dir, overwrites procedure TAndFileTrans.InsertNoteBookTags(const FullSourceFile, FullDestFile, TagString : string); // ToDo : can we make this work ? var InFile, OutFile: TextFile; InString : string; begin AssignFile(InFile, FullSourceFile); AssignFile(OutFile, FullDestFile); try try Reset(InFile); Rewrite(OutFile); while not eof(InFile) do begin readln(InFile, InString); if (Pos('', InString) > 0) then begin writeln(OutFile, InString); writeln(OutFile, TagString); end else writeln(OutFile, InString); end; finally CloseFile(OutFile); CloseFile(InFile); end; except on E: EInOutError do debugln('File handling error occurred. Details: ' + E.Message); end; end; procedure TAndFileTrans.AddHTMLNumericCode(var St : string); // Seems we are not using this method. var Len, Blar: Integer; ACodePoint: String = ''; AUnicode: Cardinal; Index : integer = 0; begin if St = '' then exit; repeat Len := UTF8CodepointSize(PChar(St) + Index); if Len = 1 then begin inc(Index); continue; // its only 1 byte, keep looking ... end; ACodePoint := copy(St, Index+1, Len); // Index is zero based AUnicode:=UTF8CodepointToUnicode(pchar(ACodePoint), Blar); ACodePoint := '&#' + AUnicode.ToString() + ';'; delete(St, Index+1, Len); // delete the utf8 insert(ACodePoint, St, Index+1); inc(Index, ACodePoint.length); // jump past new chars until Index >= St.Length; end; function TAndFileTrans.ChangeNoteDateUTC(const ID : string{; AlsoEncodeEntity : boolean}) : string; var InFile, OutFile: TextFile; NoteDateSt, InString : string; // FirstLine : boolean = True; begin NoteDateSt := GetNoteLastChangeSt(NotesDir + ID + '.note', ErrorString); // debugln('Upload note date was ' + NoteDateSt); NoteDateSt := ConvertDateStrAbsolute(NoteDateSt); // debugln('Upload note date is ' + NoteDateSt); AssignFile(InFile, NotesDir + ID + '.note'); AssignFile(OutFile, ConfigDir + 'remote.note'); try try Reset(InFile); Rewrite(OutFile); while not eof(InFile) do begin readln(InFile, InString); // if (not FirstLine) and AlsoEncodeEntity then // AddHTMLNumericCode(InString) // eg Δ becomes Ɗ // else FirstLine := False; if (Pos('', InString) > 0) or (Pos('', InString) > 0) then begin if (Pos('', InString) > 0) then writeln(OutFile, ' ' + NoteDateSt + '') else writeln(OutFile, ' ' + NoteDateSt + ''); end else writeln(OutFile, InString); end; finally CloseFile(OutFile); CloseFile(InFile); end; except on E: EInOutError do debugln('File handling error occurred. Details: ' + E.Message); end; Result := ConfigDir + 'remote.note'; end; function TAndFileTrans.RemoveHTMLNumericCode(var St : string) : boolean; var Target : integer = 1; Buff : string = ''; begin result := false; repeat Target := Pos('&#', St, Target); if Target = 0 then exit(False); // None left, lets get out of here. if Target + 3 > St.length then exit(false); // No room .... inc(Target, 2); if (St[Target] in ['0'..'9']) then begin // Looks like we have one ! while St[Target] in ['0'..'9'] do begin Buff := Buff + St[Target]; delete(St, Target, 1); if Target > St.Length then break; end; if St[Target] = ';' then delete(St, Target, 1); Dec(Target, 2); // Back to start of Entity delete(St, Target, 2); insert(UnicodeToUTF8(Buff.ToInteger), St, Target); // In LazUTF8 exit(True); end; // Oh, well, how sad, try again ? until Target > St.length; end; function TAndFileTrans.GetNewNotesGIO(const NoteMeta: TNoteInfoList; const GetLCD : boolean): boolean; var NoteInfo : PNoteInfo; //Info : TSearchRec; St, LocalTempNote, DateSt : string; // AProcess: TProcess; List : TStringList = nil; begin // by nature of how we get remote note date, always get LCD if NoteMeta = Nil then begin ErrorString := 'Passed an uncreated list to GetNewNotes()'; exit(False); end; (* AProcess := TProcess.Create(nil); AProcess.Executable:= 'gio'; AProcess.Parameters.Add('list'); AProcess.Parameters.Add(RemoteAddress); AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes]; try AProcess.Execute; Result := (AProcess.ExitStatus = 0); except on E: EProcess do ErrorString := 'TransFileSync.GetNewNotes EProcess Error during LIST'; end; if not Result then ErrorString := 'TransFileSync.GetNewNotes something bad happened when LISTing ' + RemoteAddress; if Debugmode and (ErrorString <> '') then debugln('ERROR - ' + ErrorString); List := TStringList.Create; List.LoadFromStream(AProcess.Output); *) List := TStringList.Create; if not OS_ListDirectory(List, '') then begin ErrorString := 'TransFileSync.GetNewNotesGIO Error during LIST ' + RemoteAddress; debugln(ErrorString); List.free; exit(false); end; //debugln('========= Processing remote files ==========='); for St in List do if (St <> '') and St.EndsWith('.note') then begin LocalTempNote := DownLoadNote(extractFileNameOnly(St), -1); DateSt := GetNoteLastChangeSt(LocalTempNote, ErrorString); if DateSt <> '' then begin new(NoteInfo); NoteInfo^.Action:=SyUnset; NoteInfo^.ID := extractFileNameOnly(St); NoteInfo^.Rev := -1; NoteInfo^.LastChange := St; NoteInfo^.LastChangeGMT := TB_GetGMTFromStr(DateSt); NoteMeta.Add(NoteInfo); end else debugln('ERROR, TransFileAnd.GetNewNotesGIO failed to find LCD in ' + St + ' - ' + LocalTempNote); end; List.Free; // AProcess.Free; result := true; end; // ==================== Private Methods that are OS Specific ================ // Move into an inc file at some stage {$ifdef LINUX } function TAndFileTrans.OS_UploadFile(FullFileName: string; ID : string = ''): boolean; var AProcess: TProcess; List : TStringList = nil; NewName : string; begin if ID = '' then NewName := extractFileName(FullFileName) else NewName := ID + '.note'; if OneToOne <> '' then // ie OneToOne mode exit(CopyFile(FullFileName, RemoteAddress + NewName)); AProcess := TProcess.Create(nil); AProcess.Executable:= 'gio'; AProcess.Parameters.Add('copy'); AProcess.Parameters.Add(FullFileName); AProcess.Parameters.Add(RemoteAddress + NewName); AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes]; //debugln('CL = ' + 'gio ' + 'copy ' + FullFileName + ' ' + RemoteAddress + NewName); try AProcess.Execute; Result := (AProcess.ExitStatus = 0); except on E: EProcess do ErrorString := 'TransFileSync.Upload EProcess Error during upload'; end; if not Result then ErrorString := 'TransFileSync.Upload something bad happened when uploading ' + FullFileName; if Debugmode and (ErrorString <> '') then debugln('ERROR - ' + ErrorString); List := TStringList.Create; List.LoadFromStream(AProcess.Output); List.Free; AProcess.Free; end; function TAndFileTrans.OS_ListDirectory(var List : TstringList; const aDir : string = '') : boolean; var AProcess: TProcess; begin AProcess := TProcess.Create(nil); AProcess.Executable:= 'gio'; AProcess.Parameters.Add('list'); AProcess.Parameters.Add(RemoteAddress + aDir); AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes]; try try AProcess.Execute; if (AProcess.ExitStatus <> 0) then begin debugln('TAndFileSync.GioListDirectory ERROR, could not list ' + RemoteAddress + aDir); end; //List := TStringList.Create; List.LoadFromStream(AProcess.Output); // debugln('TAndFileSync.GioListDirectory looking at ' + RemoteAddress + aDir); if List.Count < 1 then begin debugln('TAndFileSync.GioListDirectory built an empty list when looking at ' + RemoteAddress + aDir); exit(false); end; // else debugln('TAndFileSync.GioListDirectory List = [' + List.Text + ']'); except on E: EProcess do begin debugln('TransFileSync.GetNewNotes EProcess Error during LIST ' + RemoteAddress + aDir); exit(false); end; end; finally Aprocess.Free; end; result := True; end; function TAndFileTrans.OS_DownLoadFile(FN : string): boolean; var AProcess: TProcess; List : TStringList = nil; begin //if not FileExistsUTF8(RemoteAddress + FN) then exit(false); if not OS_FileExists(FN) then exit(false); DeleteFileUTF8(ConfigDir + 'remote.note'); AProcess := TProcess.Create(nil); AProcess.Executable:= 'gio'; AProcess.Parameters.Add('copy'); AProcess.Parameters.Add(RemoteAddress + FN); AProcess.Parameters.Add(ConfigDir + 'remote.note'); AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes]; try try AProcess.Execute; if AProcess.ExitStatus <> 0 then begin ErrorString := 'TransFileSync.DownLoadFile something bad happened when LISTing ' + RemoteAddress; debugln('--------------------------------------------------------------------------'); debugln('TAndFileSync.DownLoadFile WARNING failed to download to temp file'); debugln('gio copy ' + RemoteAddress + FN + ' ' + ConfigDir + 'remote.note'); debugln('A problem with mtp in your phone can happen when you delete a note in Tomdroid'); debugln('and its sync process fails to remove the file from the mtp view of the sync'); debugln('dir. While it does no harm, a phone reboot will suppress this message.'); debugln('-------------------------------------------------------------------------'); exit(False); end; except on E: EProcess do ErrorString := 'TransFileSync.DownLoadSpecificNote EProcess Error during LIST'; end; List := TStringList.Create; List.LoadFromStream(AProcess.Output); finally if List <> nil then List.free; AProcess.Free; end; Result := true; end; function TAndFileTrans.OS_DeleteFile(const FName : string) : boolean; var AProcess: TProcess; List : TStringList = nil; begin if OneToOne <> '' then exit(DeleteFileUTF8(RemoteAddress + FName)); AProcess := TProcess.Create(nil); AProcess.Executable:= 'gio'; AProcess.Parameters.Add('remove'); AProcess.Parameters.Add(RemoteAddress + FName); AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes]; try try AProcess.Execute; List := TStringList.Create; // Hmm, can I do this if we had an error ? List.LoadFromStream(AProcess.Output); if (AProcess.ExitStatus <> 0) then begin // That is, the was not there to start with ? debugln('TransFileSync.OS_DeleteFile ERROR could not delete ' + RemoteAddress + FName); exit(False); end; except on E: EProcess do begin debugln('TransFileSync.GioFileExits EXCEPTION when asking about ' + RemoteAddress + FName); exit(False); end; end; finally if List <> nil then List.free; AProcess.Free; end; Result := not OS_FileExists(FName); end; const MTPSTART='mtp://'; function TAndFileTrans.OS_Location() : boolean; var AProcess: TProcess; List : TStringList = nil; St : string = ''; begin RemoteAddress := ''; AProcess := TProcess.Create(nil); AProcess.Executable:= 'gio'; AProcess.Parameters.Add('mount'); AProcess.Parameters.Add('-l'); AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes]; try try AProcess.Execute; List := TStringList.Create; List.LoadFromStream(AProcess.Output); if (AProcess.ExitStatus <> 0) or (List.Count < 1) then begin debugln('TransFileSync.GioLocation ERROR '); // That is ?? exit(False); end; for St in List do begin if pos(MTPSTART, St) > 0 then begin RemoteAddress := appendPathDelim(copy(St, Pos(MTPSTART, St), 1000)); break; end; end; except on E: EProcess do begin debugln('TransFileSync.GioLocation EXCEPTION'); exit(False); end; end; finally if List <> nil then List.free; AProcess.Free; end; Result := length(RemoteAddress) > length(MTPSTART); if Result then RemoteAddress := appendPathDelim(RemoteAddress) else RemoteAddress := ''; end; function TAndFileTrans.OS_FileExists(aName : string; isDirectory : boolean = false) : boolean; // aName (directory) could be like Phone, Phone/tomdroid, Phone/tomdroid/, tomdroid, tomdroid/ ...... var AProcess: TProcess; List : TStringList = nil; begin if OneToOne <> '' then if isDirectory then exit(DirectoryExistsUTF8(RemoteAddress + aName)) else exit(FileExistsUTF8(RemoteAddress + aName)); AProcess := TProcess.Create(nil); AProcess.Executable:= 'gio'; AProcess.Parameters.Add('info'); AProcess.Parameters.Add(RemoteAddress + aName); AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes]; try try AProcess.Execute; List := TStringList.Create; // Hmm, can I do this if we had an error ? List.LoadFromStream(AProcess.Output); if (AProcess.ExitStatus <> 0) or (List.Count < 4) then begin // That is, the file does not exist. // debugln('TransFileSync.GioFileExits ERROR when asking about ' + RemoteAddress + AName); exit(False); end; if IsDirectory and (aName <> '') then begin // better check if its compounded if aName[aName.Length] = PathDelim then // trailing / has to go. aName := aName.Remove(aName.Length-1); while pos('/', aName) > 0 do aName := aName.Remove(0, pos('/', aName)); // Any leading terms also have to go end; if not List[0].EndsWith(aName) then exit(false); // if its last text in line, then file not found follows if isDirectory then begin if List[2].endswith('directory') then exit(true); // its a directory end else if List[2].endswith('regular') then exit(true); // its a regular file. except on E: EProcess do begin debugln('TransFileSync.GioFileExits EXCEPTION when asking about ' + RemoteAddress + AName); exit(False); end; end; finally if List <> nil then List.free; AProcess.Free; end; Result := false; end; {$else} // these stubs will be used if not compiling under linux. Best moved to an inc // file if we start implementing something here. function TAndFileTrans.OS_UploadFile(FullFileName: string; ID : string = ''): boolean; begin Result := false; end; function TAndFileTrans.OS_DownLoadFile(FN : string): boolean; begin Result := false; end; function TAndFileTrans.OS_DeleteFile(const FName : string) : boolean; begin Result := false; end; function TAndFileTrans.OS_FileExists(aName : string; isDirectory : boolean = false) : boolean; begin Result := false; end; function TAndFileTrans.OS_ListDirectory(var List : TstringList; const aDir : string) : boolean; begin Result := false; end; function TAndFileTrans.OS_Location() : boolean; begin Result := false; end; {$endif} end. tomboy-ng_0.34-1/source/index.lrj0000644000175000017500000000110614145033507016533 0ustar dbannondbannon{"version":1,"strings":[ {"hash":231754757,"name":"tformindex.caption","sourcebytes":[72,101,97,100,105,110,103,32,105,110,32,116,104,105,115,32,78,111,116,101],"value":"Heading in this Note"}, {"hash":59365493,"name":"tformindex.panel1.caption","sourcebytes":[83,105,110,103,108,101,32,108,105,110,101,115,44,32,97,108,108,32,72,117,103,101,44,32,76,97,114,103,101,32,66,111,108,100,32,111,114,32,76,97,114,103,101],"value":"Single lines, all Huge, Large Bold or Large"}, {"hash":86477809,"name":"tformindex.label1.caption","sourcebytes":[76,97,98,101,108,49],"value":"Label1"} ]} tomboy-ng_0.34-1/source/searchunit.lrj0000644000175000017500000000520014145033507017570 0ustar dbannondbannon{"version":1,"strings":[ {"hash":234232728,"name":"tsearchform.caption","sourcebytes":[116,111,109,98,111,121,45,110,103,95,83,101,97,114,99,104],"value":"tomboy-ng_Search"}, {"hash":164106259,"name":"tsearchform.buttonrefresh.hint","sourcebytes":[85,112,100,97,116,101,32,83,101,97,114,99,104,32,82,101,115,117,108,116,115],"value":"Update Search Results"}, {"hash":146640072,"name":"tsearchform.buttonrefresh.caption","sourcebytes":[82,101,102,114,101,115,104],"value":"Refresh"}, {"hash":90721265,"name":"tsearchform.panel1.caption","sourcebytes":[80,97,110,101,108,49],"value":"Panel1"}, {"hash":115878035,"name":"tsearchform.buttonclearfilters.caption","sourcebytes":[67,108,101,97,114,32,70,105,108,116,101,114,115],"value":"Clear Filters"}, {"hash":78352483,"name":"tsearchform.listboxnotebooks.hint","sourcebytes":[82,105,103,104,116,32,67,108,105,99,107,32,116,111,32,109,97,110,97,103,101,32,78,111,116,101,98,111,111,107,115],"value":"Right Click to manage Notebooks"}, {"hash":179900739,"name":"tsearchform.panel2.caption","sourcebytes":[78,111,116,101,98,111,111,107,115],"value":"Notebooks"}, {"hash":343125,"name":"tsearchform.buttonmenu.caption","sourcebytes":[77,101,110,117],"value":"Menu"}, {"hash":219680245,"name":"tsearchform.checkcasesensitive.caption","sourcebytes":[67,97,115,101,32,83,101,110,115,105,116,105,118,101],"value":"Case Sensitive"}, {"hash":204553672,"name":"tsearchform.checkautorefresh.caption","sourcebytes":[65,117,116,111,32,82,101,102,114,101,115,104],"value":"Auto Refresh"}, {"hash":89337013,"name":"tsearchform.menueditnotebooktemplate.caption","sourcebytes":[69,100,105,116,32,78,111,116,101,98,111,111,107,32,84,101,109,112,108,97,116,101],"value":"Edit Notebook Template"}, {"hash":73518027,"name":"tsearchform.menudeletenotebook.caption","sourcebytes":[68,101,108,101,116,101,32,78,111,116,101,98,111,111,107],"value":"Delete Notebook"}, {"hash":36354507,"name":"tsearchform.menurenamenotebook.caption","sourcebytes":[82,101,110,97,109,101,32,78,111,116,101,66,111,111,107],"value":"Rename NoteBook"}, {"hash":173784437,"name":"tsearchform.menunewnotefromtemplate.caption","sourcebytes":[67,114,101,97,116,101,32,78,101,119,32,78,111,116,101,32,102,114,111,109,32,84,101,109,112,108,97,116,101],"value":"Create New Note from Template"}, {"hash":71709771,"name":"tsearchform.menuitemmanagenbook.caption","sourcebytes":[77,97,110,97,103,101,32,78,111,116,101,115,32,105,110,32,78,111,116,101,32,66,111,111,107],"value":"Manage Notes in Note Book"}, {"hash":101027563,"name":"tsearchform.menucreatenotebook.caption","sourcebytes":[67,114,101,97,116,101,32,110,101,119,32,78,111,116,101,32,66,111,111,107],"value":"Create new Note Book"} ]} tomboy-ng_0.34-1/source/transandroid.pas0000644000175000017500000007165114145033507020124 0ustar dbannondbannonunit transandroid; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ A unit that does the file transfer side of a very limited one to one Tomdroid Sync HISTORY 2018/10/28 Improve error checking on SetServerID(), needs to be applied to all similar methods. 2018/11/20 Try Finally around SetsrverID() stuff to stop memory leak. Check if that still handles a bad password ??? Sync.SetTransport - Selects a Trans layer, adjusts config dir, Ping device ? That would indicate its there. Sync.TestTransport In repoUse mode - Reads Local Manifest (if exists), calls Trans.TestTransport, compares localServerID (from config and local manifest). If serverID problem, consult user, rets SyncMismatch In RepoNew mode, we ignore any local manifest and both local and remote serverIDs. A fresh start. Trans.TestTransport (here, for android) If not JoinRepo, grabs the devices serverID. If JoinRepo, generates a new ServerID and puts it on device. Checks for remote (Tomdroid made) directory. If there is no remote serverID present, one is immedialy made (Thats not really as it should be !) We should now have a valid Trans.ServerID, either the existing one or a new one. Note that because of how the file based Tomdroid sync works, we set action to either RepoUse or RepoJoin, not RepoNew ! Join here is effectivly a combination of Join and New. A Join overwrites an existing ServerID with a new one. Tomdroid seems to need to be stopped after each (internal) sync to be sure of reliable notice of deleted notes. Otherwise, it sometimes seems to not notice that a previously synced note has now dissapeared from its sync dir (as a result of -ng syncing there) and therefore does not remove that note from its dbase when syncing. } {$mode objfpc}{$H+} interface uses Classes, SysUtils, process, trans, SyncUtils; type { TAndSync } TAndSync = Class(TTomboyTrans) private function ChangeNoteDateUTC(const ID: string): string; function CheckRemoteDir: TSyncAvailable; function DownLoad(const ID, FullNoteName: string): boolean; function GetDroidMetaData(AStringList: TStringList): boolean; function GetNoteLastChange(const FullFileName: string): string; procedure InsertNoteBookTags(const FullSourceFile, FullDestFile, TagString: string); function RemoteFileExists(const ID: string): boolean; function RunFSSync(): boolean; // May return SyncReady, SyncNoRemoteRepo (if unable to find a remote ServerID), SyncNetworkError function SetServerID(): TSyncAvailable; function Ping(const Count : integer): boolean; function StampServerID(const ID: string): boolean; // Reads the (filesync) remote Manifest for synced note details. It gets ID, RevNo // and, if its there the LastChangeDate. If LCD is not in manifest and GetLCD // is True, gets it from the file. function UpLoad(const ID: string): boolean; public //RemoteDir : string; // where the remote filesync repo lives. function TestTransport(const WriteNewServerID : boolean = False) : TSyncAvailable; override; function SetTransport() : TSyncAvailable; override; function GetRemoteNotes(const NoteMeta : TNoteInfoList; const GetLCD : boolean) : boolean; override; function DownloadNotes(const DownLoads : TNoteInfoList) : boolean; override; { ToDo : transandroid version - deletes the indicated note from remote device returns False if the note was not found there to be deleted. Other error are possible.} function DeleteNote(const ID : string; const ExistRev : integer) : boolean; override; function UploadNotes(const Uploads : TStringList) : boolean; override; function DoRemoteManifest(const RemoteManifest : string; MetaData : TNoteInfoList = nil) : boolean; override; function DownLoadNote(const ID : string; const RevNo : Integer) : string; Override; // function SetRemoteRepo(ManFile : string = '') : boolean; override; end; implementation uses laz2_DOM, laz2_XMLRead, LazFileUtils, FileUtil, LazLogger, tb_utils{, searchUnit}; const // Must become config things eventually. //Password = 'admin'; DevDir = '/storage/emulated/0/tomdroid/'; { TAndSync } function TAndSync.Ping(const Count : integer) : boolean; // Ping returns 0 or one or more packets came back, 1 if none, 2 for other error var AProcess: TProcess; List : TStringList = nil; begin AProcess := TProcess.Create(nil); AProcess.Executable:= 'ping'; AProcess.Parameters.Add('-qc' + inttostr(Count)); AProcess.Parameters.Add(RemoteAddress); AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes]; try AProcess.Execute; Result := (AProcess.ExitStatus = 0); // says at least one packet got back except on E: EProcess do ErrorString := 'EProcess Error during Ping'; end; if not Result then ErrorString := 'Not able to ping device, check its awake and IP is correct. '; List := TStringList.Create; List.LoadFromStream(AProcess.Output); // just to clear it away. List.Free; AProcess.Free; end; function TAndSync.StampServerID(const ID : string) : boolean; var AProcess: TProcess; List : TStringList = nil; begin result := true; AProcess := TProcess.Create(nil); AProcess.Executable:= 'sshpass'; AProcess.Parameters.Add('-p'); AProcess.Parameters.Add(Password); AProcess.Parameters.Add('ssh'); AProcess.Parameters.Add('-p2222'); // AProcess.Parameters.Add('-o'); // AProcess.Parameters.Add('StrictHostKeyChecking=no'); AProcess.Parameters.Add('root@' + self.RemoteAddress); AProcess.Parameters.Add('echo "' + ID + '" > tomboy.serverid'); AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes]; try try AProcess.Execute; List := TStringList.Create; List.LoadFromStream(AProcess.Output); except on E: EProcess do ErrorString := 'EProcess Error ' + E.Message; on E: EExternal do ErrorString := 'Some process error ' + E.Message; end; if debugmode then debugln('StampServerID [' + ID + '] [' + List.Text + ']'); Result := (AProcess.ExitStatus = 0); finally FreeandNil(List); AProcess.Free; end; end; function TAndSync.RunFSSync() : boolean; var AProcess: TProcess; List : TStringList = nil; begin Result := True; AProcess := TProcess.Create(nil); AProcess.Executable:= 'sshpass'; AProcess.Parameters.Add('-p'); AProcess.Parameters.Add(Password); AProcess.Parameters.Add('ssh'); AProcess.Parameters.Add('-p2222'); AProcess.Parameters.Add('-o'); AProcess.Parameters.Add('StrictHostKeyChecking=no'); // probably first ssh call to device ! AProcess.Parameters.Add('root@' + self.RemoteAddress); AProcess.Parameters.Add('sync'); AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes]; try try AProcess.Execute; List := TStringList.Create; List.LoadFromStream(AProcess.Output); // Output should be empty, StdErr contains ssh prompts if Length(List.Text) <> 0 then begin result := False; debugln('Tomdroid Sync, error when sending FSSync :'); debugln('[' + List.Text + ']'); end; except on E: EProcess do begin ErrorString := 'EProcess Error ' + E.Message; debugln('RunFSSync ' + ErrorString); Result := False; end end; finally FreeandNil(List); AProcess.Free; end; end; // May return SyncNetworkError, SyncNoRemoteDir, SyncReady function TAndSync.CheckRemoteDir : TSyncAvailable; var AProcess: TProcess; List : TStringList = nil; begin AProcess := TProcess.Create(nil); AProcess.Executable:= 'sshpass'; AProcess.Parameters.Add('-p'); AProcess.Parameters.Add(Password); AProcess.Parameters.Add('ssh'); AProcess.Parameters.Add('-p2222'); AProcess.Parameters.Add('-o'); AProcess.Parameters.Add('StrictHostKeyChecking=no'); // probably first ssh call to device ! AProcess.Parameters.Add('root@' + self.RemoteAddress); AProcess.Parameters.Add('ls'); AProcess.Parameters.Add('-d'); AProcess.Parameters.Add(DevDir); AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes]; // CL (eg) sshpass -p admin ssh -p2222 -o StrictHostKeyChecking=no root@192.168.1.174 ls /storage/emulated/0/tomdroid/ try try AProcess.Execute; //if debugmode then debugln('SetServerID - Executed'); List := TStringList.Create; List.LoadFromStream(AProcess.Output); //if debugmode then debugln('SetServerID - Loadfromstream'); if length(List.Text) = 0 then begin if debugmode then debugln('CheckRemoteDir - Length was zero'); List.LoadFromStream(AProcess.Stderr); if length(List.Text) = 0 then ErrorString := 'Unable to connect, unknown error' else if pos('Connection refused', List.Text) > 0 then ErrorString := 'Unable to connect, is ssh server running ?' else if pos('Permission denied', List.Text) > 0 then ErrorString := 'Unable to connect, check password' else ErrorString := List.Text; if Debugmode then debugln('CheckRemoteDir returning SyncNetworkError ' + ErrorString); exit(SyncNetworkError); end; except on E: EProcess do begin ErrorString := 'EProcess Error ' + E.Message; debugln('SetServerID ' + ErrorString); Result := SyncNetworkError; exit; end end; if pos('No such file or directory', List.Text) > 0 then exit(SyncNoRemoteDir); // no ID present, uninitialized ? finally FreeandNil(List); AProcess.Free; end; Result := SyncReady; end; function TAndSync.SetServerID() : TSyncAvailable; var AProcess: TProcess; List : TStringList = nil; begin ServerID := ''; AProcess := TProcess.Create(nil); AProcess.Executable:= 'sshpass'; AProcess.Parameters.Add('-p'); AProcess.Parameters.Add(Password); AProcess.Parameters.Add('ssh'); AProcess.Parameters.Add('-p2222'); AProcess.Parameters.Add('-o'); AProcess.Parameters.Add('StrictHostKeyChecking=no'); AProcess.Parameters.Add('root@' + self.RemoteAddress); AProcess.Parameters.Add('cat tomboy.serverid'); AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes]; // CL (eg) sshpass -p admin ssh -p2222 root@192.168.1.174 cat tomboy.serverid try try AProcess.Execute; //if debugmode then debugln('SetServerID - Executed'); List := TStringList.Create; List.LoadFromStream(AProcess.Output); //if debugmode then debugln('SetServerID - Loadfromstream'); if length(List.Text) = 0 then begin if debugmode then debugln('SetServerID - Length was zero'); List.LoadFromStream(AProcess.Stderr); if length(List.Text) = 0 then ErrorString := 'Unable to connect, unknown error' else if pos('Connection refused', List.Text) > 0 then ErrorString := 'Unable to connect, is ssh server running ?' else if pos('Permission denied', List.Text) > 0 then ErrorString := 'Unable to connect, check password' else ErrorString := List.Text; exit(SyncNetworkError); end; except on E: EProcess do begin ErrorString := 'EProcess Error ' + E.Message; debugln('SetServerID ' + ErrorString); Result := SyncNetworkError; exit(); end end; if pos('No such file or directory', List.Text) > 0 then exit(SyncNoRemoteRepo); // no ID present, uninitialized ? if List.Count > 0 then ServerID := copy(List.Strings[List.Count-1], 1, 36); // Thats, perhaps, a serverID if debugmode then debugln('SetServerID [' + ServerID + ']' + List.Text); finally FreeandNil(List); AProcess.Free; end; if not IDLooksOK(ServerID) then begin Debugln('SetServerID unable to read tomboy.serverid, we got [' + List.Text + ']'); exit(SyncNoRemoteRepo); // No really NoRemoteRepo but a currupted ID ? end; Result := SyncReady; end; function TAndSync.TestTransport(const WriteNewServerID : boolean = False): TSyncAvailable; // OK, droping TestTransportEarly and merging most back here. var GUID : TGUID; T1, T2, T3, T4 : DWord; begin { ssh in, read serverID file, its in tomboy.serverid makes sure the expected Sync Dir exists } ErrorString := ''; T1 := GetTickCount64(); Result := CheckRemoteDir(); if Result <> SyncReady then exit; RunFSSync(); if ANewRepo then Result := SyncNoRemoteRepo else Result := SetServerID(); T2 := GetTickCount64(); T3 := T2; T4 := T2; if Result <> SyncReady then begin if Result = SyncNoRemoteRepo then begin T3 := GetTickCount64(); CreateGUID(GUID); ServerID := copy(GUIDToString(GUID), 2, 36); // it arrives here wrapped in {} if WriteNewServerID and StampServerID(ServerID) then Result := SyncReady else Result := SyncReady; T3 := GetTickCount64(); if DebugMode then debugln('Made a new serverID ' + ServerID ); end else begin debugln(ErrorString); exit; end; end; if debugmode then debugln('TestTransport ID=' + ServerID + ' SetServerID took ' + inttostr(T2 - T1) + 'mS and StampID took ' + inttostr(T4 - T3)); end; function TAndSync.SetTransport(): TSyncAvailable; var T1, T2 : QWord; begin T1 := GetTickCount64(); if not Ping(1) then if not Ping(2) then if not Ping(5) then begin debugln('Failed to ping ' + RemoteAddress); exit(SyncNetworkError); end; T2 := GetTickCount64(); if debugmode then debugln('SetTransport Ping took ' + inttostr(T2 - T1)); result := SyncReady; end; function TAndSync.GetDroidMetaData(AStringList : TStringList) : boolean; var AProcess: TProcess; begin AProcess := TProcess.Create(nil); AProcess.Executable:= 'sshpass'; AProcess.Parameters.Add('-p'); AProcess.Parameters.Add(Password); AProcess.Parameters.Add('ssh'); AProcess.Parameters.Add('-p2222'); AProcess.Parameters.Add('root@' + self.RemoteAddress); AProcess.Parameters.Add('cd ' + DevDir + '; grep -H "" *.note'); AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes]; try AProcess.Execute; AStringList.LoadFromStream(AProcess.Output); // AStringList.SaveToFile('output.txt'); Result := (AProcess.ExitStatus = 0); except on E: EProcess do ErrorString := 'EProcess Error ' + E.Message; end; if not Result then ErrorString := 'something bad happened'; AProcess.Free; end; function TAndSync.GetRemoteNotes(const NoteMeta: TNoteInfoList; const GetLCD : boolean): boolean; var StList: TStringList = nil; I : integer; NoteInfo : PNoteInfo; begin // by nature of how we get remote note date, always get LCD if NoteMeta = Nil then begin ErrorString := 'Passed an uncreated list to GetNewNotes()'; exit(False); end; StList := TStringList.Create; GetDroidMetaData(StList); if StList.Count > 0 then begin for I := 0 to StList.Count -1 do begin // if Debugmode then debugln('RET - [' + StList.Strings[I] + ']'); new(NoteInfo); NoteInfo^.Action:=SyUnset; NoteInfo^.ID := copy(StList.Strings[I], 1, 36); NoteInfo^.Rev := -1; NoteInfo^.LastChange := copy(StList.Strings[I], pos('>', StList.Strings[I])+1, 33); NoteInfo^.LastChangeGMT := TB_GetGMTFromStr(NoteInfo^.LastChange); NoteMeta.Add(NoteInfo); end; end; freeandNil(StList); result := True; end; function TAndSync.GetNoteLastChange(const FullFileName : string) : string; begin Result := GetNoteLastChangeSt(FullFileName, ErrorString); // syncutils function end; // Puts back the tag string into a temp note downloaded from dev and puts it in note dir, overwrites procedure TAndSync.InsertNoteBookTags(const FullSourceFile, FullDestFile, TagString : string); var InFile, OutFile: TextFile; InString : string; begin AssignFile(InFile, FullSourceFile); AssignFile(OutFile, FullDestFile); try try Reset(InFile); Rewrite(OutFile); while not eof(InFile) do begin readln(InFile, InString); if (Pos('', InString) > 0) then begin writeln(OutFile, InString); writeln(outFile, TagString); end else writeln(OutFile, InString); end; finally CloseFile(OutFile); CloseFile(InFile); end; except on E: EInOutError do debugln('File handling error occurred. Details: ' + E.Message); end; end; function TAndSync.DownloadNotes(const DownLoads: TNoteInfoList): boolean; var I : integer; begin if not DirectoryExists(NotesDir + 'Backup') then if not ForceDirectory(NotesDir + 'Backup') then begin ErrorString := 'Failed to create Backup directory.'; exit(False); end; for I := 0 to DownLoads.Count-1 do begin if DownLoads.Items[I]^.Action = SyDownLoad then begin if FileExists(NotesDir + Downloads.Items[I]^.ID + '.note') then // First make a Backup copy if not CopyFile(NotesDir + Downloads.Items[I]^.ID + '.note', NotesDir + 'Backup' + PathDelim + Downloads.Items[I]^.ID + '.note') then begin ErrorString := 'Failed to copy file to Backup ' + NotesDir + Downloads.Items[I]^.ID + '.note'; exit(False); end; // OK, now pull down the file. if not DownLoad(Downloads.Items[I]^.ID, NotesDir + Downloads.Items[I]^.ID + '.note') then begin Debugln('ERROR - in TAndSync.DownloadNotes ' + ErrorString); exit(false); end; end; end; result := True; {var // trash this, turned out completely unnecessary ! I : integer; NoteBookTags, DownloadTo : string; begin if not DirectoryExists(NotesDir + 'Backup') then if not ForceDirectory(NotesDir + 'Backup') then begin ErrorString := 'Failed to create Backup directory.'; exit(False); end; for I := 0 to DownLoads.Count-1 do begin if DownLoads.Items[I]^.Action = SyDownLoad then begin DownLoadTo := NotesDir + Downloads.Items[I]^.ID + '.note'; if FileExists(NotesDir + Downloads.Items[I]^.ID + '.note') then begin NoteBookTags := SearchForm.NoteLister.NotebookTags(Downloads.Items[I]^.ID + '.note'); if NoteBookTags <> '' then begin DownLoadTo := ConfigDir + 'downFromDroid.note'; if debugmode then debugln('Note has tags, download to '+ DownloadTo); end; // First make a Backup copy if not CopyFile(NotesDir + Downloads.Items[I]^.ID + '.note', NotesDir + 'Backup' + PathDelim + Downloads.Items[I]^.ID + '.note') then begin ErrorString := 'Failed to copy file to Backup ' + NotesDir + Downloads.Items[I]^.ID + '.note'; debugln('Failed to copy [' + NotesDir + Downloads.Items[I]^.ID + '.note]'); debugln('to [' + NotesDir + 'Backup' + PathDelim + Downloads.Items[I]^.ID + '.note]'); exit(False); end; end; // OK, now pull down the file. if not DownLoad(Downloads.Items[I]^.ID, DownLoadTo) then begin Debugln('ERROR - in TAndSync.DownloadNotes ' + ErrorString); exit(false); end; if NoteBookTags <> '' then InsertNoteBookTags(DownLoadTo, NotesDir + Downloads.Items[I]^.ID + '.note', NoteBookTags); end; end; result := True; } end; function TAndSync.RemoteFileExists(const ID: string): boolean; var AProcess: TProcess; List : TStringList = nil; begin AProcess := TProcess.Create(nil); AProcess.Executable:= 'sshpass'; AProcess.Parameters.Add('-p'); AProcess.Parameters.Add(Password); AProcess.Parameters.Add('ssh'); AProcess.Parameters.Add('-p2222'); AProcess.Parameters.Add('-o'); AProcess.Parameters.Add('StrictHostKeyChecking=no'); // probably first ssh call to device ! AProcess.Parameters.Add('root@' + RemoteAddress); AProcess.Parameters.Add('ls'); AProcess.Parameters.Add(DevDir + ID + '.note'); AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes]; { If we found the indicated file, its name will appear in stdout. There will still be something in stderr, ssh prompts etc. If we have NOT found it, then - * Stdout is empty. * The name will appear in stderror * The phrase "No such file or directory" will appear in stderr } Result := False; try try AProcess.Execute; List := TStringList.Create; List.LoadFromStream(AProcess.Output); if length(List.text) > 0 then if pos(ID, List.Text) > 0 then Result := True; except on E: EProcess do begin ErrorString := 'EProcess Error ' + E.Message; debugln('RemoteFileExists ' + ErrorString); Result := False; end end; finally FreeandNil(List); AProcess.Free; end; end; function TAndSync.DeleteNote(const ID: string; const ExistRev : integer ): boolean; var AProcess: TProcess; List : TStringList = nil; begin AProcess := TProcess.Create(nil); AProcess.Executable:= 'sshpass'; AProcess.Parameters.Add('-p'); AProcess.Parameters.Add(Password); AProcess.Parameters.Add('ssh'); AProcess.Parameters.Add('-p2222'); AProcess.Parameters.Add('-o'); AProcess.Parameters.Add('StrictHostKeyChecking=no'); // probably first ssh call to device ! AProcess.Parameters.Add('root@' + self.RemoteAddress); AProcess.Parameters.Add('rm'); AProcess.Parameters.Add(DevDir + ID + '.note'); AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes]; try try result := True; // hope for the best AProcess.Execute; List := TStringList.Create; List.LoadFromStream(AProcess.Output); if length(List.Text) = 0 then begin // thats good List.LoadFromStream(AProcess.Stderr); if length(List.Text) <> 0 then // thats bad if pos('No such file or directory', List.Text) > 0 then exit(False); end; except on E: EProcess do begin ErrorString := 'EProcess Error ' + E.Message; debugln('ERROR in DeleteNote ' + ErrorString); Result := False; end end; if Debugmode then debugln('Transandroid DeleteNote removed ' + ID +' from device'); finally FreeandNil(List); AProcess.Free; end; end; function TAndSync.UploadNotes(const Uploads: TStringList): boolean; var Index : integer; begin for Index := 0 to Uploads.Count -1 do begin if DebugMode then debugln('Uploading ' + Uploads.Strings[Index] + '.note'); if not UpLoad(Uploads.Strings[Index]) then begin debugln('ERROR in TAndSync.UploadNotes' + ErrorString); exit(False); end; end; RunFSSync(); result := True; end; function TAndSync.DoRemoteManifest(const RemoteManifest: string; MetaData: TNoteInfoList): boolean; begin // The Tomdroid sync model does not use a remote manifest. result := True; end; function TAndSync.ChangeNoteDateUTC(const ID : string) : string; var InFile, OutFile: TextFile; NoteDateSt, InString : string; begin NoteDateSt := GetNoteLastChangeSt(NotesDir + ID + '.note', ErrorString); // debugln('Upload note date was ' + NoteDateSt); NoteDateSt := ConvertDateStrAbsolute(NoteDateSt); // debugln('Upload note date is ' + NoteDateSt); AssignFile(InFile, NotesDir + ID + '.note'); AssignFile(OutFile, ConfigDir + 'remote.note'); try try Reset(InFile); Rewrite(OutFile); while not eof(InFile) do begin readln(InFile, InString); if (Pos('', InString) > 0) or (Pos('', InString) > 0) then begin if (Pos('', InString) > 0) then writeln(OutFile, ' ' + NoteDateSt + '') else writeln(OutFile, ' ' + NoteDateSt + ''); end else writeln(OutFile, InString); end; finally CloseFile(OutFile); CloseFile(InFile); end; except on E: EInOutError do debugln('File handling error occurred. Details: ' + E.Message); end; Result := ConfigDir + 'remote.note'; end; function TAndSync.UpLoad(const ID : string ) : boolean; var AProcess: TProcess; List : TStringList = nil; begin // OK, seems Tomdroid, likes its date strings in UTC with zero offset, // messes with sync (I suspect). So, before uploading a file, we'll // stuff about with its date strings..... AProcess := TProcess.Create(nil); AProcess.Executable:= 'sshpass'; AProcess.Parameters.Add('-p'); AProcess.Parameters.Add(Password); AProcess.Parameters.Add('scp'); AProcess.Parameters.Add('-P2222'); AProcess.Parameters.Add(ChangeNoteDateUTC(ID)); // AProcess.Parameters.Add(NotesDir + ID + '.note'); AProcess.Parameters.Add('root@' + RemoteAddress + ':' + DevDir + ID + '.note'); AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes]; try AProcess.Execute; Result := (AProcess.ExitStatus = 0); except on E: EProcess do ErrorString := 'EProcess Error during upload'; end; if not Result then ErrorString := 'something bad happened when uploading ' + ID; List := TStringList.Create; List.LoadFromStream(AProcess.Output); List.Free; AProcess.Free; end; function TAndSync.DownLoad(const ID, FullNoteName : string ) : boolean; var AProcess: TProcess; List : TStringList = nil; begin AProcess := TProcess.Create(nil); AProcess.Executable:= 'sshpass'; AProcess.Parameters.Add('-p'); AProcess.Parameters.Add(Password); AProcess.Parameters.Add('scp'); AProcess.Parameters.Add('-P2222'); AProcess.Parameters.Add('root@' + RemoteAddress + ':' + DevDir + ID + '.note'); AProcess.Parameters.Add(FullNoteName); AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes]; try AProcess.Execute; Result := (AProcess.ExitStatus = 0); except on E: EProcess do ErrorString := 'EProcess Error during download'; end; if not Result then begin ErrorString := 'something bad happened when downloading ' + ID; debugln('Failed to download [' + RemoteAddress + ':' + DevDir + ID + '.note]'); debugln(' to [' + FullNoteName + ']'); end; List := TStringList.Create; List.LoadFromStream(AProcess.Output); List.Free; AProcess.Free; end; function TAndSync.DownLoadNote(const ID: string; const RevNo: Integer): string; // Here we will pull down the indicated note and return its fullname. In 'droid // mode, this is only used to get note title and then only when its a new note // on remote device. If this proves too slow, we could capture all this data // in the same way we get LCD. Please consider. begin if DebugMode then debugln('Download to Temp ' + ID); if DownLoad(ID, self.ConfigDir + 'remote.note') then Result := ConfigDir + 'remote.note' else Result := ''; end; end. tomboy-ng_0.34-1/source/notenormal.pas0000644000175000017500000002502114145033507017600 0ustar dbannondbannonunit notenormal; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ } { A unit to 'normalise' a Tomboy Note, that is ensure tags remain with the para they relate to. Makes the xml a lot prettier and, more importantly, heaps easier t parse when exporting. One day, may incorporate into the tomboy-ng saving engine. Needed by the POT and CommonMark exporters. It recieves a TStringList containing a note (probably directly loaded from disk). HISTORY : 2021/08/19 Bug in RemoveRedundentTags that sometimes ate character after tag pair 2021/09/21 Added code to convert blocks of monospace to to now have each para wrapped. } {$mode objfpc}{$H+} interface uses Classes, SysUtils; type { TNoteNormaliser } // Will tidy up the location of tags to keep para or sentences together // As well as making for pretty to look xml, its far easier to parse, when converting to, eg markdown // Open a note into a string list, create NoteNormaliser and pass the string list to NormaliseList. TNoteNormaliser = class private procedure MoveTagDown(const StL: TStringList; const StIndex, TagSize: integer); function MoveTagLeft(var St: string): boolean; function MoveTagRight(var St: string): boolean; procedure MoveTagUp(const StL: TStringList; const StIndex: integer; var TagSize: integer); function OffTagAtStart(St: string): integer; function OnTagAtEnd(St: string): integer; function RemoveRedundentTag(var St: string): boolean; { Re-align monospaced lines. Acts on blocks only, does not alter in line mono. Looks for blocks wrapped in a single set of monospace tags, converts to a pair of tags per line (or more correctly, paragraph).} function TidyMonospace(StL: TStringList): boolean; public procedure NormaliseList(STL: TStringList); end; implementation uses lazlogger; // ---------------------- N O R M A L I S I N G ------------------------------------ // Deals with 'off' tags that need to be moved up to the para they apply to. procedure TNoteNormaliser.MoveTagUp(const StL : TStringList; const StIndex : integer; var TagSize : integer); var Tag : string; begin // we have to detect when our line starts with or and // terminate processing of this string, they are not text markup. Tag := copy(StL.strings[StIndex], 1, TagSize); if (Tag = '') or (Tag = '') then begin TagSize := 0; exit; end; StL.Insert(StIndex, copy(StL.Strings[StIndex], TagSize+1, length(StL.Strings[StIndex]))); StL.Delete(StIndex+1); StL.Insert(StIndex-1, StL.strings[StIndex-1]+Tag); StL.Delete(StIndex); end; function TNoteNormaliser.MoveTagRight(var St: string): boolean; var Index, TagStart, StartAt : integer; begin Index := Pos('> ', St); if Index = 0 then exit(False); StartAt := 1; repeat Index := St.IndexOf('> ', StartAt); if Index < 0 then exit(False); TagStart := Index; while St[TagStart] <> '<' do dec(TagStart); if St[TagStart+1] = '/' then begin // Not interested, an 'off' tag StartAt := Index+1; continue; end else break; until false; delete(St, Index+2, 1); insert(' ', St, TagStart); result := True; end; { Will move a tag to the left if it has a space there, ret T if it moved one.} function TNoteNormaliser.MoveTagLeft(var St: string): boolean; var Index : integer; begin Index := Pos(' ', Index)+2); // 2 ? IndexOf rets a zero based and we want to go one past Result := true; end; function TNoteNormaliser.OnTagAtEnd(St : string) : integer; var I, L : integer; begin if St = '' then exit(0); L := length(st); if St[L] <> '>' then exit(0); i := 1; while St[L-i] <> '<' do begin // march backwards until we find start of tag inc(i); if i > L then begin debugln('ERROR : Overrun looking for tag start'); exit(-1); end; end; if St[L-i+1] = '/' then exit(0); // not our problems, tags at the end should be 'off' tags. result := i+1; end; // Looks for an 'off' tag at the start of a line, they belong further up the list, 0 says none found function TNoteNormaliser.OffTagAtStart(St : string) : integer; var I : integer = 2; L : integer; begin if (St = '') or (St[1] <> '<') or (St[2] <> '/') then // Hmm, a single unescaed < on a line will crash exit(0); L := length(St); while St[i] <> '>' do begin inc(i); if i > L then begin debugln('ERROR : overrun looking for tag end, line =[' + st + ']'); exit(-1); end; end; result := i; end; // Deals with 'on' tags that need to be moved down to the paras that they apply to procedure TNoteNormaliser.MoveTagDown(const StL : TStringList; const StIndex, TagSize : integer); var Tag : string; begin Tag := copy(StL.strings[StIndex], length(StL.strings[StIndex])-TagSize+1, TagSize); StL.Insert(StIndex, copy(StL.strings[StIndex], 1, length(StL.strings[StIndex])-TagSize)); StL.Delete(StIndex+1); StL.Insert(StIndex+1, Tag+StL.Strings[StIndex+1]); StL.Delete(StIndex+2); end; // When there is an off tag and and complementry on tag (or visa versa) with nothing // between they are redundent and we remove them right here and now. No excuses ! // Rets True if it made a change, repeat until it finds nothing to do. function TNoteNormaliser.RemoveRedundentTag(var St : string) : boolean; var OffTag : integer = 0; // String Helpers are zero based ! Tag1, Tag2 : string; // might get, eg monospace for a fixed spacing tag // Ret T if it finds TagSt starting at Offset (and it removed it) function Removed(const OffSet : integer; TagSt : string; replace : boolean) : boolean; begin if OffSet < 0 then exit(False); if St.Substring(OffSet, length(TagSt)) = TagSt then begin //St := St.Remove(OffSet, length(Tag1 + Tag2) +1); St := St.Remove(OffSet, length(TagSt)); if Replace then St := St.Insert(OffSet, ' '); exit(True); end else Result := False; end; begin //if pos('Column Mode', St) > 0 then //writeln('---- ' + St); while(true) do begin OffTag := st.IndexOf('= 0 then begin Tag1 := St.Substring(OffTag, st.IndexOf('>', OffTag) - OffTag +1); // ie thats full tag Tag2 := Tag1.Remove(Tag1.IndexOf('/', 1), 1); // we target Tag1Tag2 or reversed, with and without a space between if Removed(OffTag, Tag1+Tag2, False) then exit(True); if Removed(OffTag, Tag1+' '+Tag2, True) then exit(True); if Removed(OffTag-length(Tag2), Tag2+Tag1, False) then exit(True); // ERROR HERE if Removed(OffTag-length(Tag2), Tag2+' ' + Tag1, True) then exit(True); // If still here, that offtag was not associated with an immediate on tag. inc(OffTag); continue; end else exit(False); // no more offtags left to consider or maybe on offtags at all end { Loop: Find next offtag, exit false if we cannot find one try and find a matching ontag with nothing between. If above fails, goto LOOP: I don't think so. } end; function TNoteNormaliser.TidyMonospace(StL : TStringList) : boolean; var Start, i, OffSet : integer; St : string; function ConvertMono : boolean; begin St := StL[Start]; StL.Delete(Start); StL.Insert(Start, St + ''); // First one inc(Start); while Start <= i do begin St := StL[Start]; StL.Delete(Start); if Start = i then StL.Insert(Start, '' + St) // Last one else StL.Insert(Start, '' + St + ''); inc(Start); end; Result := True; end; begin i := 0; Result := False; while i < STL.Count do begin if (copy(STL[i], 1, 11) = '') and (pos('', Stl[i]) < 1) then begin Start := i; inc(i); continue; end; Offset := pos('', Stl[i]); // OK, looking for an end tag. if (OffSet > 0) and (pos('', Stl[i]) < 1) then begin // Possible but is it at end of line ? St := Stl[i]; while St[St.Length] in [#10, #13, ' '] do delete(St, St.Length, 1); if St.Length = Offset + 11 then exit(ConvertMono); // returns true end; inc(i); end; end; procedure TNoteNormaliser.NormaliseList(STL : TStringList); var TagSize, StIndex : integer; TempSt : string; begin StIndex := 0; while StIndex < StL.Count do begin repeat TagSize := OnTagAtEnd(StL.Strings[StIndex]); if TagSize > 0 then MoveTagDown(StL, StIndex, TagSize); until TagSize < 1; // WARNING, that includes error code, -1 TempSt := StL.Strings[StIndex]; while MoveTagLeft(TempSt) do; while MoveTagRight(TempSt) do; if TempSt <> StL.Strings[StIndex] then begin StL.Insert(StIndex, TempSt); StL.Delete(StIndex + 1); end; inc(StIndex); end; StIndex := StL.Count -1; // start at bottom and work up while StIndex > 0 do begin // we don't care about the first line. repeat TagSize := OffTagAtStart(StL.strings[StIndex]); if TagSize > 0 then MoveTagUp(StL, StIndex, TagSize); until TagSize < 1; dec(StIndex); end; StIndex := StL.Count -1; // remove any trailing spaces. while StIndex > 0 do begin TempSt := Stl[StIndex]; if TempSt.endswith(' ') then Stl[StIndex] := TempSt.TrimRight; dec(StIndex); end; StIndex := 0; // Redundent, sequencial tags. while StIndex < StL.Count do begin TempSt := STL[StIndex]; if RemoveRedundentTag(TempSt) then begin while RemoveRedundentTag(TempSt) do; // in case more than one in line StL.Insert(StIndex, TempSt); StL.Delete(StIndex + 1); end; inc(StIndex); end; TidyMonospace(StL); end; end. tomboy-ng_0.34-1/source/backupview.lrj0000644000175000017500000000357614145033507017601 0ustar dbannondbannon{"version":1,"strings":[ {"hash":34251059,"name":"tformbackupview.caption","sourcebytes":[86,105,101,119,44,32,114,101,99,111,118,101,114,32,111,114,32,100,101,108,101,116,101,32,66,97,99,107,117,112,32,70,105,108,101,115],"value":"View, recover or delete Backup Files"}, {"hash":10435829,"name":"tformbackupview.buttonopen.hint","sourcebytes":[79,112,101,110,32,97,110,100,32,118,105,101,119,32,116,104,101,32,119,104,111,108,101,32,110,111,116,101],"value":"Open and view the whole note"}, {"hash":380871,"name":"tformbackupview.buttonopen.caption","sourcebytes":[86,105,101,119],"value":"View"}, {"hash":19305231,"name":"tformbackupview.buttonrecover.hint","sourcebytes":[82,101,115,116,111,114,101,32,116,104,105,115,32,110,111,116,101,32,116,111,32,109,97,105,110,32,114,101,112,111],"value":"Restore this note to main repo"}, {"hash":146435218,"name":"tformbackupview.buttonrecover.caption","sourcebytes":[82,101,99,111,118,101,114],"value":"Recover"}, {"hash":120709198,"name":"tformbackupview.buttondelete.hint","sourcebytes":[82,101,97,108,108,121,44,32,116,111,116,97,108,108,121,32,100,101,108,101,116,101,32,116,104,105,115,32,110,111,116,101,46],"value":"Really, totally delete this note."}, {"hash":78392485,"name":"tformbackupview.buttondelete.caption","sourcebytes":[68,101,108,101,116,101],"value":"Delete"}, {"hash":205911214,"name":"tformbackupview.buttonok.hint","sourcebytes":[77,121,32,119,111,114,107,32,104,101,114,101,32,105,115,32,100,111,110,101,46],"value":"My work here is done."}, {"hash":4863637,"name":"tformbackupview.buttonok.caption","sourcebytes":[67,108,111,115,101],"value":"Close"}, {"hash":60010147,"name":"tformbackupview.listbox1.hint","sourcebytes":[85,115,101,32,67,116,114,108,32,111,114,32,83,104,105,102,116,32,116,111,32,115,101,108,101,99,116,32,109,117,108,116,105,112,108,101,32,101,110,116,114,105,101,115],"value":"Use Ctrl or Shift to select multiple entries"} ]} tomboy-ng_0.34-1/source/mainunit.pas0000644000175000017500000007224614145033507017261 0ustar dbannondbannonunit Mainunit; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ The Main unit for the application, it displayes the small splash screen (if enabled), manages some of the command line switches, runs the IPC server to communicate with other instances, starts single note mode. Makes some decisions about Windows Dark Theme. } {$mode objfpc}{$H+} { HISTORY 2018/05/12 Extensive changes - MainUnit is now just that. This is not the same unit that used this name previously! 2018/05/19 Control if we allow opening window to be dismissed and show TrayIcon and MainMenu. 2018/05/20 Alterations to way we startup, wrt mainform status report. 2018/05/20 Set the recent menu items caption to be 'empty' in case user looks before having set a notes directory. 2018/06/02 Added a cli switch to debug sync 2018/06/19 Got some stuff for singlenotemode() - almost working. 2018/06/22 As above but maybe working now ? DRB 2018/07/04 Display number of notes found and a warning if indexing error occurred. 2018/07/11 Added --version and --no-splash to options, this form now has a main menu and does not respond to clicks anywhere with the popup menu, seems GTK does not like sharing menus (eg between here and the trayIcon) in gtk3 ! So, in interests of uniformity, everyone gets a Main Menu and no Popup. 2018/11/01 Now include --debug-log in list of INTERAL switches. 2018/12/02 Now support Alt-[Left, Right] to turn off or on Bullets. 2018/12/03 Added show splash screen to settings, -g or an indexing error will force show 2019/03/19 Added a checkbox to hide screen on future startups 2019/03/19 Added setting option to show search box at startup 2019/04/07 Restructured Main and Popup menus. Untested Win/Mac. 2019/04/13 Mv numb notes to tick line, QT5, drop CheckStatus() 2019/05/06 Support saving pos and open on startup in note. 2019/05/14 Display strings all (?) moved to resourcestrings 2019/06/11 Moved an ifdef 2019/07/21 Added a TitleColour for dark theme 2019/08/20 Linux only, looks for (translated) help files in config dir first. 2019/09/6 Button to download Help Notes in non-English 2019/09/21 Restructured model for non-english help notes, names in menus ! 2019/10/13 Prevent Dismiss if desktop is Enlightenment, in OnCreateForm() 2019/11/05 Don't treat %f as a command line file name, its an artifact 2019/11/08 Tidy up building GTK3 and Qt5 versions, cleaner About 2019/11/20 Don't assign PopupMenu to TrayIcon on (KDE and Qt5) 2019/12/08 New "second instance" model. 2019/12/11 Heavily restructured Startup, Main Menu everywhere ! 2019/12/20 Added option --delay-start for when desktop is slow to determine its (dark) colours 2020/03/30 Allow user to set display colours. 2020/04/10 Make help files non modal 2020/04/12 Force sensible sizes for help notes. 2020/04/28 Added randomize to create, need it for getlocaltime in settings. 2020/05/16 Don't prevent closing of splash screen. 2020/05/23 Don't poke SingleNoteFileName in during create, get it from Mainunit in OnCreate() 2020/05/26 Improved tabbing 2020/06/11 remove unused closeASAP, open splash if bad note. 2020/07/09 New help notes location. A lot moved out of here. 2020/11/07 Fix multiple About Boxes (via SysTray) issue. Untested on Win/Mac 2020/11/18 Changed other two buttons to BitBtn so qt5 looks uniform. 2021/01/04 Pointed Tomdroid menu to tomdroidFile. 2021/01/23 We now test for a SysTray, show warning and Help is not there. 2021/04/01 Removed "have config", we always have config, if we cannot save it, user knows.... 2021/05/11 On Gnome Linux, test for libappindicator3 and appindicator shell plugin 2021/05/15 On Gnome, if plugin is present but disabled, offer to enable it for user. 2021/05/19 If libappindicator is not present, check for libayatana-appindicator, but only if lcl is patched ! 2021/07/13 Don't do full SysTray check on Gnome with Qt, AccessViolation, just guess. 2021/11/09 Dont consider libayatana unless compiled with > 2.0.12 CommandLine Switches --delay-start --debug-log=some.log --dark-theme Windows only, over rides the registery setting. --gnome3 ignored -g --debug-sync Turn on Verbose mode during sync --debug-index Verbose mode when reading the notes directory. --debug-spell Verbose mode when setting up speller --config-dir= Directory to keep config and sync manifest in. -o note_fullfilename --open= Opens, in standalone mode, a note. Don't start the SimpleIPC conversation. --help -h Shows and exits (not implemented) something to divert debug msg to a file ?? something to do more debugging ? --no-splash Do not show the small opening status/splash window on startup --save-exit (Single note only) after import, save and exit. --version Print version no and exit. } interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Menus, ExtCtrls, StdCtrls, LCLTranslator, DefaultTranslator, Buttons, simpleipc, LCLType {$ifdef LINUX}, x, xlib, process {$endif} // Relate to testing for SysTray {$IFDEF LCLGTK3}, LazGdk3, LazGLib2 {$ENDIF} // we need declare a GTK3 function that has not yet made it to bindings ; // These are choices for main and main popup menus. // type TMenuTarget = (mtSep=1, mtNewNote, mtSearch, mtAbout=10, mtSync, mtSettings, mtHelp, mtQuit, mtTomdroid, mtRecent); // These are the possible kinds of main menu items // type TMenuKind = (mkFileMenu, mkRecentMenu, mkHelpMenu); type { TMainForm } TMainForm = class(TForm) ApplicationProperties1: TApplicationProperties; ButtSysTrayHelp: TBitBtn; BitBtnHide: TBitBtn; BitBtnQuit: TBitBtn; ButtMenu: TBitBtn; CheckBoxDontShow: TCheckBox; ImageSpellCross: TImage; ImageSpellTick: TImage; ImageNotesDirCross: TImage; ImageSyncCross: TImage; ImageNotesDirTick: TImage; ImageSyncTick: TImage; LabelBadNoteAdvice: TLabel; LabelError: TLabel; Label3: TLabel; Label4: TLabel; Label5: TLabel; LabelNotesFound: TLabel; TrayIcon: TTrayIcon; procedure BitBtnHideClick(Sender: TObject); procedure BitBtnQuitClick(Sender: TObject); procedure ButtMenuClick(Sender: TObject); procedure ButtonCloseClick(Sender: TObject); procedure ButtonConfigClick(Sender: TObject); procedure ButtonDismissClick(Sender: TObject); procedure ButtSysTrayHelpClick(Sender: TObject); procedure CheckBoxDontShowChange(Sender: TObject); procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormResize(Sender: TObject); procedure FormShow(Sender: TObject); procedure LabelErrorClick(Sender: TObject); procedure TrayIconClick(Sender: TObject); procedure TrayMenuTomdroidClick(Sender: TObject); private AboutFrm : TForm; //HelpList : TStringList; CommsServer : TSimpleIPCServer; // Start SimpleIPC server listening for some other second instance. procedure StartIPCServer(); procedure CommMessageReceived(Sender: TObject); procedure TestDarkThemeInUse(); {$ifdef LINUX} function CheckGnomeExtras(): boolean; // Test for traditional SysTray, if not successful we call look for the // the things that can be added to a Gnome Desktop to make it work. function CheckForSysTray(): boolean; {$endif} public UseTrayMenu : boolean; PopupMenuSearch : TPopupMenu; PopupMenuTray : TPopupMenu; MainTBMenu : TPopupMenu; // Called by the Sett unit when it knows the true config path. // procedure SetAltHelpPath(ConfigPath: string); procedure ShowAbout(); // Ret path to where help notes are, either default English or Non-English // function ActualHelpNotesPath() : string; // This procedure responds to ALL recent note menu clicks ! procedure RecentMenuClicked(Sender: TObject); { Displays the indicated help note, eg recover.note, in Read Only, Single Note Mode First tries the AltHelpPath, then HelpPath} //procedure ShowHelpNote(HelpNoteName: string); { Updates status data on MainForm, tick list } procedure UpdateNotesFound(Numb: integer); { Opens a note in single note mode. Pass a full file name, a bool that closes whole app on exit and one that indicates ReadOnly mode. } procedure SingleNoteMode(FullFileName: string; const CloseOnExit, ViewerMode : boolean); { Shortcut to SingleNoteMode(Fullfilename, True, False) } procedure SingleNoteMode(FullFileName: string); end; // This here temp, it returns the singlenotefilename from CLI Unit. function SingleNoteFileName() : string; // See https://github.com/salvadorbs/AsuiteComps/blob/beab429e63a120d9e2e25c55b64dc092e1c271e9/library/platform/unix/Hotkeys.Manager.Platform.pas#L93 {$IFDEF LCLGTK3} // function gdk_x11_window_get_xid(AX11Window: PGdkWindow): guint32; cdecl; external; function gdk_x11_display_get_xdisplay(AX11Display: PGdkDisplay): PDisplay; cdecl; external; {$ENDIF} var MainForm: TMainForm; implementation {$R *.lfm} { TMainForm } uses LazLogger, LazFileUtils, LazUTF8, settings, ResourceStr, SearchUnit, {$ifdef LCLGTK2} gtk2, gdk2, // required to fix a bug that clears clipboard contents at close. {$endif} {$ifdef LINUX} {$ifdef LCLGTK2} gtk2extra, {$endif} // Relate to testing for SysTray {$ifdef LCLQT5} qt5, {$endif} // Relate to testing for SysTray Clipbrd, {$endif} // Stop linux clearing clipboard on app exit. Editbox, // Used only in SingleNoteMode Note_Lister, cli, tb_utils, {$ifdef LINUX}LCLVersion, {$endif} TomdroidFile {$ifdef windows}, registry{$endif}; function SingleNoteFileName() : string; begin result := SingleNoteName; // Thats the global in CLI Unit end; procedure TMainForm.SingleNoteMode(FullFileName: string); begin SingleNoteMode(FullFileName, True, False); end; procedure TMainForm.SingleNoteMode(FullFileName : string; const CloseOnExit, ViewerMode : boolean); var EBox : TEditBoxForm; begin if DirectoryExistsUTF8(ExtractFilePath(FullFileName)) or (ExtractFilePath(FullFileName) = '') then begin try try EBox := TEditBoxForm.Create(Application); //EBox.SingleNoteFileName := SingleNoteFileName(); // Thats the global from CLI Unit, via a local helper function EBox.NoteTitle:= ''; EBox.NoteFileName := FullFileName; Ebox.TemplateIs := ''; EBox.Dirty := False; if ViewerMode then EBox.SetReadOnly(False); EBox.ShowModal; except on E: Exception do begin debugln('!!! EXCEPTION - ' + E.Message); showmessage(E.Message); end; end; finally try FreeandNil(EBox); except on E: Exception do debugln('!!! EXCEPTION - What ? no FreeAndNil ?' + E.Message); end; end; end else begin DebugLn('Sorry, cannot find that directory [' + ExtractFilePath(FullFileName) + ']'); showmessage('Sorry, cannot find that directory [' + ExtractFilePath(FullFileName) + ']'); end; if CloseOnExit then Close; // we also use singlenotemode internally in several places end; // ----------------------------------------------------------------- // S T A R T U P T H I N G S // ----------------------------------------------------------------- procedure TMainForm.FormCreate(Sender: TObject); begin AboutFrm := Nil; Randomize; // used by sett.getlocaltime() //HelpList := Nil; UseTrayMenu := true; if SingleNoteFileName() = '' then StartIPCServer() // Don't bother to check if we are client, cannot be if we are here. else UseTrayMenu := False; {$ifdef LCLCARBON} UseTrayMenu := false; {$endif} if UseTrayMenu then begin PopupMenuTray := TPopupMenu.Create(Self); TrayIcon.PopUpMenu := PopupMenuTray; // SearchForm will populate it when ready TrayIcon.Show; end; LabelBadNoteAdvice.Caption := ''; end; procedure TMainForm.FormDestroy(Sender: TObject); begin freeandnil(CommsServer); // freeandnil(HelpNotes); //if HelpList <> Nil then writeln('Help List has ' + inttostr(HelpList.Count)); // freeandnil(HelpList); end; procedure TMainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction); var {$ifdef LCLGTK2} c: PGtkClipboard; t: string; {$endif} // OutFile : TextFile; AForm : TForm; begin //debugln('TMainForm.FormClose - at user request'); // ToDo : remove this {$ifdef LCLGTK2} c := gtk_clipboard_get(GDK_SELECTION_CLIPBOARD); t := Clipboard.AsText; gtk_clipboard_set_text(c, PChar(t), Length(t)); gtk_clipboard_store(c); {$endif} Sett.AreClosing:=True; if assigned(SearchForm.NoteLister) then begin AForm := SearchForm.NoteLister.FindFirstOpenNote(); while AForm <> Nil do begin AForm.close; AForm := SearchForm.NoteLister.FindNextOpenNote(); end; end; end; procedure TMainForm.CommMessageReceived(Sender : TObject); Var S : String; begin // debugln('Here in Main.CommMessageRecieved, a message was received'); CommsServer .ReadMessage; S := CommsServer .StringMessage; case S of 'SHOWSEARCH' : begin SearchForm.Show; SearchForm.MoveWindowHere(SearchForm.Caption); end; end; end; procedure TMainForm.StartIPCServer(); begin CommsServer := TSimpleIPCServer.Create(Nil); CommsServer.ServerID:='tomboy-ng'; CommsServer.OnMessageQueued:=@CommMessageReceived; CommsServer.Global:=True; // anyone can connect CommsServer.StartServer({$ifdef WINDOWS}False{$else}True{$endif}); // start listening, threaded end; resourcestring rsFailedToIndex = 'Failed to index one or more notes.'; {$ifdef LINUX} function TMainForm.CheckGnomeExtras() : boolean; var {$ifndef LCLQT5}H : TLibHandle;{$endif} MayBeNotGnome : boolean = false; PlugInName : string = ''; // holds name if CheckPlugIn found it. function CheckPlugIn(EnabledOnly : boolean) : boolean; var AProcess: TProcess; List : TStringList = nil; begin result := false; AProcess := TProcess.Create(nil); AProcess.Executable:= 'gnome-extensions'; AProcess.Parameters.Add('list'); if EnabledOnly then AProcess.Parameters.Add('--enabled'); //AProcess.Parameters.Add(PlugInName); AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes]; try try // Next line raise an exception if gnome-extensions is not installed, it is handled. // ExitStatus for List is always zero so don't bother checking AProcess.Execute; List := TStringList.Create; List.LoadFromStream(AProcess.Output); //debugln(List.Text); if FindInStringList(List, 'ubuntu-appindicators@ubuntu.com') > -1 then // Ubuntu, Debian PlugInName := 'ubuntu-appindicators@ubuntu.com'; if FindInStringList(List, 'appindicatorsupport@rgcjonas.gmail.com') > -1 then // fedora PlugInName := 'appindicatorsupport@rgcjonas.gmail.com'; except on E: EProcess do MayBeNotGnome := True; // Says that gnome-extensions is not installed. end; finally freeandnil(List); freeandnil(AProcess); end; result := (PlugInName <> ''); end; function EnablePlugIn() : boolean; var AProcess: TProcess; begin result := false; AProcess := TProcess.Create(nil); AProcess.Executable:= 'gnome-extensions'; AProcess.Parameters.Add('enable'); AProcess.Parameters.Add(PlugInName); //AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes]; try // We know we have gnome-extensions command and a valid extension name AProcess.Execute; finally freeandnil(AProcess); end; result := CheckPlugIn(True); end; begin // Ayatana is supported instead of Cannonical's appindicator in Laz Trunk post 22/05/2021, r65122 // Does no harm to check here but if its not in Lazarus, its won't be used when needed. result := false; {$ifndef LCLQT5} // It appears QT5 can talk direct to gnome-shell-extension-appindicator ?? H := LoadLibrary('libappindicator3.so.1'); {$if (lcl_fullversion>2001200)} // 2.0.12 - Release Versions of Lazarus before 2.2.0 did not know about libayatana if '' <> getEnvironmentVariable('LAZUSEAPPIND') then debugln('Can use libayatana-appindicator3.so.1'); if H = NilHandle then // Enable this if only if UnityWSCtrl has been patched to use ayatana H := LoadLibrary('libayatana-appindicator3.so.1'); // see https://bugs.freepascal.org/view.php?id=38909 {$endif} if H = NilHandle then begin debugln('Failed to Find an AppIndicator Library, SysTray may not work.'); exit(False); // nothing to see here folks. end; unloadLibrary(H); {$endif} Result := CheckPlugIn(True); if not Result then if MaybeNotGnome then debugln('SysTray not detected, not Gnome Desktop') // We also issue that message on a system that supports libappindicator3 without // needing (or installed) gnome-shell-extension-appindicator, eg U20.04 Mate // Plasma can use just libappindicator3 or Ayatana by itself. else if CheckPlugIn(False) then begin // Ah, its there but not enabled debugln('SysTray Plugin for Gnome detected but not enabled'); // Offer to enable it for user ?? if IDYES = Application.MessageBox('Enable gnome-shell-extension-appindictor ?', 'The SysTray extension is installed but not enabled', MB_ICONQUESTION + MB_YESNO) then Result := EnablePlugIn(); if Result then showmessage('Enabled, please restart tomboy-ng') else showmessage('Sorry, failed to enable plugin'); end else debugln('SysTray Plugin for Gnome not present'); end; function TMainForm.CheckForSysTray() : boolean; var A : TAtom; XDisplay: PDisplay; ForceAppInd : string; begin Result := False; // Don't test for SysTray under GTK3, will never be there. One or other AppIndicator // is your only chance. And XInternAtom() function SegVs on Gnome DTs so don't try it. // Ayatana is supported instead of Cannonical's appindicator in Laz Trunk // post 22/05/2021, r65122 and in Lazarus 2.2.0. Important in Bullseye, not Ubuntu < 21.10 {$IFnDEF LCLGTK3} // Interestingly, by testing we seem to ensure it does work on U2004, even though the test fails ! {$ifdef LCLGTK2}XDisplay := gdk_display; {$endif} {$ifdef LCLQT5} // If using Gnome and QT5, cannot safely test for a SysTray, we'll guess.... if pos('GNOME', upcase(GetEnvironmentVariable('XDG_CURRENT_DESKTOP'))) > 0 then exit(CheckGnomeExtras()); XDisplay := QX11Info_display; {$endif} A := XInternAtom(XDisplay, '_NET_SYSTEM_TRAY_S0', False); result := (XGetSelectionOwner(XDisplay, A) <> 0); ForceAppInd := GetEnvironmentVariable('LAZUSEAPPIND'); if ForceAppInd <> '' then debugln('Tradition Systray Available = ' + booltostr(result, True)); // if ForceAppInd = 'YES' then // result := false; {$ENDIF} // if we are false here, its probably because its a recent Gnome Desktop or GTK3, no SysTray. // However, if libappindicator3 or Ayatana is installed and the Gnome Shell Extension, // appindicators is installed and enabled, it will 'probably' be OK. if result = false then Result := CheckGnomeExtras(); // Thats libappindicator3 and an installed and enabled gnome-shell-extension-appindicator end; {$endif} procedure TMainForm.FormShow(Sender: TObject); var NoteID, NoteTitle : string; {$ifndef LCLGTK2}Lab : TLabel; {$endif} begin TestDarkThemeInUse(); {$ifndef LCLGTK2} // GTK2 seems only one we can be sure is auto colours ! // We honour --dark-theme for most and if we can guess its dark we'll // act accordingly. color := Sett.AltColour; font.color := Sett.TextColour; // These do not work for Windows, so for just bullseye, just temp.... ButtMenu.Color := Sett.AltColour; BitBtnQuit.Color := Sett.AltColour; BitBtnHide.Color := Sett.AltColour; for Lab in [Label5, LabelNotesFound, Label3, Label4, LabelBadNoteAdvice, LabelError] do TLabel(Lab).Font.Color:= Sett.TextColour; CheckBoxDontShow.Font.color := Sett.TextColour; {$endif} if SingleNoteFileName() <> '' then begin // That reads the global in CLI Unit SingleNoteMode(SingleNoteFileName); exit; end; LabelBadNoteAdvice.Caption:= ''; ButtSysTrayHelp.Visible := False; {$ifdef LINUX} if not CheckForSysTray() then begin LabelBadNoteAdvice.Caption := rsWARNNOSSYSTRAY; ButtSysTrayHelp.Visible := True; end; {$endif} if SearchForm.NoteLister.XMLError then begin LabelError.Caption := rsFailedToIndex; LabelBadNoteAdvice.Caption:= rsBadNotesFound1; end else begin LabelError.Caption := ''; if Application.HasOption('no-splash') or (not Sett.CheckShowSplash.Checked) then ButtonDismissClick(Self); end; (* if Application.HasOption('no-splash') or (not Sett.CheckShowSplash.Checked) then begin {if AllowDismiss then} ButtonDismissClick(Self); end; *) Left := 10; Top := 40; CheckBoxDontShow.checked := not Sett.CheckShowSplash.Checked; if Sett.CheckShowSearchAtStart.Checked then SearchForm.Show; if SearchForm.NoteLister.FindFirstOOSNote(NoteTitle, NoteID) then repeat SearchForm.OpenNote(NoteTitle, Sett.NoteDirectory + NoteID); until SearchForm.NoteLister.FindNextOOSNote(NoteTitle, NoteID) = false; FormResize(self); // Qt5 apparently does not call FormResize at startup. end; procedure TMainForm.LabelErrorClick(Sender: TObject); begin if LabelError.Caption <> '' then showmessage(rsBadNotesFound1 + #10#13 + rsBadNotesFound2); end; procedure TMainForm.UpdateNotesFound(Numb : integer); begin LabelNotesFound.Caption := rsFound + ' ' + inttostr(Numb) + ' ' + rsNotes; // ImageConfigCross.Left := ImageConfigTick.Left; // ImageConfigTick.Visible := Sett.HaveConfig; // ImageConfigCross.Visible := not ImageConfigTick.Visible; ImageNotesDirCross.Left := ImageNotesDirTick.Left; ImageNotesDirTick.Visible := Numb > 0; ImageNotesDirCross.Visible := not ImageNotesDirTick.Visible; ImageSpellCross.Left := ImageSpellTick.Left; ImageSpellTick.Visible := Sett.SpellConfig; ImageSpellCross.Visible := not ImageSpellTick.Visible; ImageSyncCross.Left := ImageSyncTick.Left; ImageSyncTick.Visible := Sett.ValidSync; ImageSyncCross.Visible := not ImageSyncTick.Visible; end; procedure TMainForm.ButtonDismissClick(Sender: TObject); begin {$ifdef LCLCOCOA} // ToDo : is this still necessary ? Or can Cocoa hide like other systems ? width := 0; height := 0; {$else} hide(); {$endif} end; procedure TMainForm.ButtSysTrayHelpClick(Sender: TObject); begin SearchForm.ShowHelpNote('systray.note'); end; procedure TMainForm.CheckBoxDontShowChange(Sender: TObject); var OldMask : boolean; begin if Visible then begin Sett.CheckShowSplash.Checked := not Sett.CheckShowSplash.Checked; OldMask := Sett.MaskSettingsChanged; Sett.MaskSettingsChanged := False; Sett.SaveSettings(Sender); Sett.MaskSettingsChanged := OldMask; end; end; procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if ssCtrl in Shift then begin if key = ord('N') then begin SearchForm.OpenNote(''); // MMNewNoteClick(self); OK as long as Notes dir is set Key := 0; exit(); end; end; end; procedure TMainForm.FormResize(Sender: TObject); begin ButtMenu.Width := (Width div 3); BitBtnHide.Width := (Width div 3); end; // Attempt to detect we are in a dark theme, sets relevent colours. procedure TMainForm.TestDarkThemeInUse(); {$ifdef WINDOWS} function WinDarkTheme : boolean; // we also need to test in High Contrast mode, its not a colour theme. var RegValue : integer; Registry : TRegistry; begin Registry := TRegistry.Create; try Registry.RootKey := HKEY_CURRENT_USER; if Registry.OpenKeyReadOnly('\Software\Microsoft\Windows\CurrentVersion\Themes\Personalize') then begin try RegValue := Registry.ReadInteger('AppsUseLightTheme'); except on E: ERegistryException do exit(True); // If Key present but not AppsUseLightTheme, default to Dark end; exit(RegValue = 0); end else exit(false); finally Registry.Free; end; end; {$else} var Col : string; {$endif} begin if Application.HasOption('dark-theme') then // Manual override always wins ! Sett.DarkTheme := True else begin Sett.DarkTheme := false; {$ifdef WINDOWS} Sett.DarkTheme := WinDarkTheme(); {$else} // if char 3, 5 and 7 are all 'A' or above, we are not in a DarkTheme Col := hexstr(qword(GetRGBColorResolvingParent()), 8); Sett.DarkTheme := (Col[3] < 'A') and (Col[5] < 'A') and (Col[7] < 'A'); {$endif} end; Sett.SetColours; end; { ------------- M E N U M E T H O D S ----------------} procedure TMainForm.ButtonConfigClick(Sender: TObject); begin Sett.Show(); end; procedure TMainForm.ButtonCloseClick(Sender: TObject); begin end; procedure TMainForm.ButtMenuClick(Sender: TObject); begin MainTBMenu.popup(Left + 40, Top + 40); end; procedure TMainForm.BitBtnQuitClick(Sender: TObject); begin MainForm.Close; end; procedure TMainForm.BitBtnHideClick(Sender: TObject); begin {$ifdef LCLCOCOA} // ToDo : is this still necessary ? Or can Cocoa hide like other systems ? width := 0; height := 0; {$else} hide(); {$endif} end; procedure TMainForm.TrayIconClick(Sender: TObject); begin PopupMenuTray.PopUp(); end; procedure TMainForm.TrayMenuTomdroidClick(Sender: TObject); begin if FormTomdroidFile.Visible then FormTomdroidFile.BringToFront else FormTomdroidFile.ShowModal; end; procedure TMainForm.RecentMenuClicked(Sender: TObject); begin if TMenuItem(Sender).Caption <> SearchForm.MenuEmpty then SearchForm.OpenNote(TMenuItem(Sender).Caption); end; RESOURCESTRING rsAbout1 = 'This is tomboy-ng, a rewrite of Tomboy Notes using Lazarus'; rsAbout2 = 'and FPC. While its ready for production'; rsAbout3 = 'use, you still need to be careful and have good backups.'; rsAboutVer = 'Version'; rsAboutBDate = 'Build date'; rsAboutCPU = 'TargetCPU'; rsAboutOperatingSystem = 'OS'; procedure TMainForm.ShowAbout(); var Stg : string; begin if AboutFrm <> Nil then begin AboutFrm.Show; AboutFrm.EnsureVisible(); exit; end; Stg := rsAbout1 + #10 + rsAbout2 + #10 + rsAbout3 + #10 + rsAboutVer + ' ' + Version_String; // version is in cli unit. {$ifdef LCLCOCOA} Stg := Stg + ', 64bit Cocoa'; {$endif} {$ifdef LCLQT5} Stg := Stg + ', QT5'; {$endif} {$ifdef LCLGTK3} Stg := Stg + ', GTK3'; {$endif} {$ifdef LCLGTK2} Stg := Stg + ', GTK2'; {$endif} Stg := Stg + #10 + rsAboutBDate + ' ' + {$i %DATE%} + #10 + rsAboutCPU + ' ' + {$i %FPCTARGETCPU%} + ' ' + rsAboutOperatingSystem + ' ' + {$i %FPCTARGETOS%} + ' ' + GetEnvironmentVariable('XDG_CURRENT_DESKTOP'); AboutFrm := CreateMessageDialog(Stg, mtInformation, [mbClose]); AboutFrm.ShowModal; AboutFrm.free; AboutFrm := Nil; //Showmessage(Stg); end; end. tomboy-ng_0.34-1/source/tb_sdiff.lrj0000644000175000017500000000465514145033507017220 0ustar dbannondbannon{"version":1,"strings":[ {"hash":33421508,"name":"tformsdiff.caption","sourcebytes":[65,32,78,111,116,101,32,83,121,110,99,32,67,108,97,115,104,32,104,97,115,32,98,101,101,110,32,68,101,116,101,99,116,101,100],"value":"A Note Sync Clash has been Detected"}, {"hash":31088229,"name":"tformsdiff.labelremote.caption","sourcebytes":[76,97,98,101,108,82,101,109,111,116,101],"value":"LabelRemote"}, {"hash":202931964,"name":"tformsdiff.labellocal.caption","sourcebytes":[76,97,98,101,108,76,111,99,97,108],"value":"LabelLocal"}, {"hash":94564212,"name":"tformsdiff.label3.caption","sourcebytes":[82,101,109,111,116,101,32,67,104,97,110,103,101,100],"value":"Remote Changed"}, {"hash":180302756,"name":"tformsdiff.label4.caption","sourcebytes":[76,111,99,97,108,32,67,104,97,110,103,101,100],"value":"Local Changed"}, {"hash":164800533,"name":"tformsdiff.radiolong.hint","sourcebytes":[77,97,121,98,101,32,110,101,99,101,115,115,97,114,121,32,116,111,32,115,104,111,119,32,100,105,102,102,101,114,101,110,99,101],"value":"Maybe necessary to show difference"}, {"hash":156750467,"name":"tformsdiff.radiolong.caption","sourcebytes":[76,111,110,103,32,76,105,110,101,115],"value":"Long Lines"}, {"hash":59263924,"name":"tformsdiff.radioshort.hint","sourcebytes":[69,97,115,105,101,114,32,116,111,32,114,101,97,100],"value":"Easier to read"}, {"hash":103486035,"name":"tformsdiff.radioshort.caption","sourcebytes":[83,104,111,114,116,32,76,105,110,101,115],"value":"Short Lines"}, {"hash":38215182,"name":"tformsdiff.label1.caption","sourcebytes":[79,114,32,109,97,107,101,32,97,32,99,104,111,105,99,101,32,102,111,114,32,114,101,109,97,105,110,100,101,114,32,111,102,32,116,104,105,115,32,114,117,110],"value":"Or make a choice for remainder of this run"}, {"hash":90352804,"name":"tformsdiff.buttalloldest.caption","sourcebytes":[79,108,100,101,115,116],"value":"Oldest"}, {"hash":88923300,"name":"tformsdiff.buttallnewest.caption","sourcebytes":[78,101,119,101,115,116],"value":"Newest"}, {"hash":5462396,"name":"tformsdiff.buttalllocal.caption","sourcebytes":[76,111,99,97,108],"value":"Local"}, {"hash":93079205,"name":"tformsdiff.buttallremote.caption","sourcebytes":[82,101,109,111,116,101],"value":"Remote"}, {"hash":122881516,"name":"tformsdiff.bitbtnuselocal.caption","sourcebytes":[85,115,101,32,76,111,99,97,108],"value":"Use Local"}, {"hash":93327317,"name":"tformsdiff.bitbtnuseremote.caption","sourcebytes":[85,115,101,32,82,101,109,111,116,101],"value":"Use Remote"} ]} tomboy-ng_0.34-1/source/searchunit.lfm0000644000175000017500000003035314145033507017566 0ustar dbannondbannonobject SearchForm: TSearchForm Left = 892 Height = 401 Top = 292 Width = 824 ActiveControl = Edit1 Caption = 'tomboy-ng_Search' ClientHeight = 401 ClientWidth = 824 OnActivate = FormActivate OnCloseQuery = FormCloseQuery OnCreate = FormCreate OnDestroy = FormDestroy OnKeyDown = FormKeyDown OnResize = FormResize OnShow = FormShow LCLVersion = '2.3.0.0' object Edit1: TEdit AnchorSideLeft.Control = ButtonMenu AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = ButtonRefresh AnchorSideRight.Control = CheckCaseSensitive AnchorSideBottom.Control = ButtonRefresh AnchorSideBottom.Side = asrBottom Left = 106 Height = 32 Top = 3 Width = 326 Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Left = 2 BorderSpacing.Right = 9 OnEnter = Edit1Enter OnExit = Edit1Exit OnKeyDown = FormKeyDown OnKeyUp = Edit1KeyUp ParentShowHint = False ShowHint = True TabOrder = 0 end object ButtonRefresh: TButton AnchorSideTop.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom Left = 704 Height = 32 Hint = 'Update Search Results' Top = 3 Width = 117 Anchors = [akTop, akRight] BorderSpacing.Top = 3 BorderSpacing.Right = 3 Caption = 'Refresh' OnClick = ButtonRefreshClick OnKeyDown = FormKeyDown ParentShowHint = False ShowHint = True TabOrder = 1 TabStop = False end object Panel1: TPanel AnchorSideLeft.Control = Owner AnchorSideTop.Control = ButtonRefresh AnchorSideTop.Side = asrBottom AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = StatusBar1 Left = 0 Height = 343 Top = 36 Width = 824 Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Top = 1 Caption = 'Panel1' ClientHeight = 343 ClientWidth = 824 TabOrder = 2 object Splitter1: TSplitter AnchorSideTop.Control = Panel1 AnchorSideBottom.Control = Panel1 AnchorSideBottom.Side = asrBottom Left = 233 Height = 341 Top = 1 Width = 5 Align = alNone Anchors = [akTop, akBottom] end object ButtonClearFilters: TButton AnchorSideLeft.Control = Panel1 AnchorSideTop.Control = Panel1 AnchorSideRight.Control = Splitter1 Left = 1 Height = 32 Top = 1 Width = 232 Anchors = [akTop, akLeft, akRight] Caption = 'Clear Filters' Enabled = False OnClick = ButtonClearFiltersClick OnKeyDown = FormKeyDown TabOrder = 2 TabStop = False end object ListBoxNotebooks: TListBox AnchorSideLeft.Control = ButtonClearFilters AnchorSideTop.Control = Panel2 AnchorSideTop.Side = asrBottom AnchorSideRight.Control = Splitter1 AnchorSideBottom.Control = Panel1 AnchorSideBottom.Side = asrBottom Left = 1 Height = 278 Hint = 'Right Click to manage Notebooks' Top = 64 Width = 232 Anchors = [akTop, akLeft, akRight, akBottom] ExtendedSelect = False ItemHeight = 0 OnClick = ListBoxNotebooksClick OnKeyDown = FormKeyDown OnMouseUp = ListBoxNotebooksMouseUp ParentShowHint = False ScrollWidth = 230 ShowHint = True Sorted = True TabOrder = 1 TopIndex = -1 end object Panel2: TPanel AnchorSideLeft.Control = ButtonClearFilters AnchorSideTop.Control = ButtonClearFilters AnchorSideTop.Side = asrBottom AnchorSideRight.Control = Splitter1 Left = 1 Height = 31 Top = 33 Width = 232 Anchors = [akTop, akLeft, akRight] Caption = 'Notebooks' TabOrder = 3 end object ListViewNotes: TListView AnchorSideLeft.Control = Splitter1 AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel1 AnchorSideRight.Control = Panel1 AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Panel1 AnchorSideBottom.Side = asrBottom Left = 241 Height = 341 Top = 1 Width = 582 Anchors = [akTop, akLeft, akRight, akBottom] AutoSortIndicator = True AutoWidthLastColumn = True BorderSpacing.Left = 3 Columns = < item end item Width = 530 end> HideSelection = False ParentShowHint = False ReadOnly = True RowSelect = True ScrollBars = ssAutoVertical SortColumn = 1 SortType = stText TabOrder = 4 ViewStyle = vsReport OnDblClick = ListViewNotesDblClick OnDrawItem = ListViewNotesDrawItem OnKeyDown = FormKeyDown OnKeyPress = ListViewNotesKeyPress end end object ButtonMenu: TSpeedButton AnchorSideLeft.Control = Owner AnchorSideTop.Control = Edit1 AnchorSideBottom.Control = Edit1 AnchorSideBottom.Side = asrBottom Left = 0 Height = 32 Top = 3 Width = 104 Anchors = [akTop, akLeft, akBottom] Caption = 'Menu' Glyph.Data = { 36090000424D3609000000000000360000002800000018000000180000000100 2000000000000009000064000000640000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000003232 3238333333050000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000000000002E2E2E163636 36F93C3C3CF0393939863737371C000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000000000003737377D8080 80F6DEDEDEFF727272FA3A3A3ADC000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000003434348D34343440555555033D3D3DEBD9D9 D9FFFFFFFFFF777777F536363672000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000003E3E3EEB464646F53B3B3BEB595959F2FFFF FFFFEEEEEEFF3A3A3AF630303010000000000000000000000000000000000000 000000000000000000004D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D 4DFF4D4D4DFF4D4D4DFF4D4D4DFF3E3E3EFFE8E8E8FFCDCDCDFFCECECEFFFFFF FFFF9E9E9EFC3E3E3EB100000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF474747FFEAEAEAFFFFFFFFFFFFFFFFFFFFFF FFFFACACACFC434343F5404040D0323232510000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF454545FFEDEDEDFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFCFCFCFFF383838F9323232420000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FFFFFFFFFFFFFFFFFF414141FFF0F0F0FFFFFFFFFFFFFFFFFFFFFF FFFFD8D8D8FF3E3E3EF43333334B000000000000000000000000000000000000 000000000000000000004D4D4DFFFAFAFAFFFAFAFAFFFAFAFAFFFAFAFAFFFAFA FAFFFAFAFAFFFAFAFAFFFAFAFAFF3F3F3FFFF2F2F2FFFFFFFFFFFFFFFFFFD9D9 D9FF3E3E3EF53434344E00000000000000000000000000000000000000000000 000000000000000000004D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D 4DFF4D4D4DFF4D4D4DFF4D4D4DFF383838FFF5F5F5FFFFFFFFFFDBDBDBFF3E3E 3EF6353535570000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFAFAFAFFFAFAFAFFFAFAFAFFFAFAFAFFFAFA FAFFFAFAFAFFFAFAFAFFFAFAFAFF3A3A3AFFF8F8F8FFE0E0E0FF424242F53636 365A000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FFFFFFFFFFFFFFFFFF383838FFDDDDDDFF424242FF3636365E0000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF363636FF494949FF454545FF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FFFFFFFFFFFFFFFFFFFFFFFFFF353535FFAEAEAEFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFDFDFDFFA9A9A9FFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FF000000FFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D 4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000 } OnClick = ButtonMenuClick end object CheckCaseSensitive: TCheckBox AnchorSideTop.Control = ButtonRefresh AnchorSideRight.Control = CheckAutoRefresh AnchorSideBottom.Control = ButtonRefresh AnchorSideBottom.Side = asrBottom Left = 441 Height = 32 Top = 3 Width = 126 Anchors = [akTop, akRight, akBottom] BorderSpacing.Right = 10 Caption = 'Case Sensitive' OnChange = CheckCaseSensitiveChange OnKeyDown = FormKeyDown ParentShowHint = False TabOrder = 3 TabStop = False end object StatusBar1: TStatusBar Left = 0 Height = 22 Top = 379 Width = 824 Panels = <> end object CheckAutoRefresh: TCheckBox AnchorSideTop.Control = ButtonRefresh AnchorSideRight.Control = ButtonRefresh AnchorSideBottom.Control = ButtonRefresh AnchorSideBottom.Side = asrBottom Left = 577 Height = 32 Top = 3 Width = 117 Anchors = [akTop, akRight, akBottom] BorderSpacing.Right = 10 Caption = 'Auto Refresh' OnChange = CheckAutoRefreshChange OnKeyDown = FormKeyDown TabOrder = 5 TabStop = False end object SelectDirectoryDialog1: TSelectDirectoryDialog Left = 344 Top = 72 end object PopupMenuNotebook: TPopupMenu Left = 560 Top = 72 object MenuEditNotebookTemplate: TMenuItem Caption = 'Edit Notebook Template' OnClick = MenuEditNotebookTemplateClick end object MenuDeleteNotebook: TMenuItem Caption = 'Delete Notebook' OnClick = MenuDeleteNotebookClick end object MenuRenameNoteBook: TMenuItem Caption = 'Rename NoteBook' OnClick = MenuRenameNoteBookClick end object MenuNewNoteFromTemplate: TMenuItem Caption = 'Create New Note from Template' OnClick = MenuNewNoteFromTemplateClick end object MenuItemManageNBook: TMenuItem Caption = 'Manage Notes in Note Book' OnClick = MenuItemManageNBookClick end object MenuItem3: TMenuItem Caption = '-' end object MenuCreateNoteBook: TMenuItem Caption = 'Create new Note Book' OnClick = MenuCreateNoteBookClick end end end tomboy-ng_0.34-1/source/trans.pas0000644000175000017500000001157514145033507016562 0ustar dbannondbannonunit trans; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ Contains parent, abstract class that does Transport part of tomboy-ng sync. It moves files around, one way or another, determined by its children. HISTORY 2018/10/25 Much testing, support for Tomdroid. 2018/10/28 Added password } {$mode objfpc}{$H+} interface uses Classes, SysUtils, SyncUtils; type { TTomboyTrans } TTomboyTrans = class // An abstract class, parent of eg FileTrans and NetTrans private public // A password for those Transports that need one. Username, Password : string; DebugMode : boolean; // Indicates its a new repo, don't look for remote manifest. ANewRepo : Boolean; // Set to '' is no errors. ErrorString : string; // Local notes directory NotesDir, ConfigDir : string; // A url to network server or 'remote' file directory for FileSync RemoteAddress : string; { The current server ID. Is set with a successful TestTransport call. } ServerID : string; { The current Server Rev, before we upload. Is set with a successful TestTransport call. } RemoteServerRev : integer; { A method to call when we can advise a GUI of progress through sync } ProgressProcedure : TProgressProcedure; { Tests availability of remote part of connection. For file sync (eg) thats existance of remote manifest and 0 dir, write access. Sets its own ServerID. This would be a good place to put lock or authenticate as necessary} function TestTransport(const WriteNewServerID : boolean = False) : TSyncAvailable; virtual; abstract; { May (or may not) do some early transport tests, ie, in Tomdroid sync it pings the remote device. Should return SyncReady or an error value if something failed.} function SetTransport() : TSyncAvailable; virtual; abstract; {Request a list of all notes the server knows about. Returns with Last Change Date (LCD) if easily available and always if GetLCD is true. We don't use all fields in TInfoList, must get ID and RevNo. The list must have been created. This is always a new list, unlike one derived from local manifest.} function GetRemoteNotes(const NoteMeta : TNoteInfoList; const GetLCD : boolean) : boolean; virtual; abstract; {Request that all the notes mentioned in the simple list be downloaded and, if necessary, any existing note be moved to Backup. Note that the list contains just IDs, there is no '.note' - WRONG, at least in Tomdroid .note is there. } function DownloadNotes(const DownLoads : TNoteInfoList) : boolean; virtual; abstract; { --- Check if this function does actully need implementing ------ Advise server that a note has been deleted, a new rev has been triggered. Would call note by note, returns false if Transport has an error. ExistRev is rev number under which the note should be found in remote repo and deleted from iff you feel so inclinded.} function DeleteNote(const ID : string; const ExistRev : integer) : boolean; virtual; abstract; { Push a list of notes up to the server. A new revision has been made and we are passed its number. If it turns out to be a new Repo, we'll make the necessary directories first. } function UploadNotes(const Uploads : TStringList) : boolean; virtual; abstract; { Tells Trans to deal with with remote mainfest. This is the trigger for a new revision on the server, the server must now do whatever it needs to accomodate the new new revision, some new or update notes will be sent to it a bit later. New RevNo will be RemoteServerRev plus 1 } function DoRemoteManifest(const RemoteManifest : string; MetaData : TNoteInfoList = nil) : boolean; virtual; abstract; { Returns a full file name (inc path) to a (copy?) of indicated server version of a note. File sync will return just full path and name to the 'remote' file but net sync will need to download the file and return path and name to an overwriteable file, perhaps $CONFIG/remote.note ? We need this so we can compare notes when we are resolving a clash.} function DownLoadNote(const ID : string; const RevNo : Integer) : string; virtual; abstract; end; implementation { TTomboyTrans } end. tomboy-ng_0.34-1/source/markdown.lrj0000644000175000017500000000156314145033507017255 0ustar dbannondbannon{"version":1,"strings":[ {"hash":208094446,"name":"tformmarkdown.caption","sourcebytes":[70,111,114,109,77,97,114,107,100,111,119,110],"value":"FormMarkdown"}, {"hash":73996050,"name":"tformmarkdown.panel1.caption","sourcebytes":[77,97,114,107,100,111,119,110,32,69,120,112,111,114,116,101,114],"value":"Markdown Exporter"}, {"hash":4863637,"name":"tformmarkdown.buttonclose.caption","sourcebytes":[67,108,111,115,101],"value":"Close"}, {"hash":108741772,"name":"tformmarkdown.buttoncopyall.caption","sourcebytes":[67,111,112,121,32,65,108,108],"value":"Copy All"}, {"hash":366789,"name":"tformmarkdown.buttonsave.caption","sourcebytes":[83,97,118,101],"value":"Save"}, {"hash":98288873,"name":"tformmarkdown.label1.caption","sourcebytes":[80,114,101,115,115,32,67,116,114,108,45,65,44,32,67,116,114,108,45,67,32,116,111,32,99,111,112,121],"value":"Press Ctrl-A, Ctrl-C to copy"} ]} tomboy-ng_0.34-1/source/sync.pas0000644000175000017500000020455114145033507016405 0ustar dbannondbannonunit sync; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ } {$mode objfpc}{$H+} { How to use this Unit - Syncutils will probably be needed in Interface Uses Sync in implementation of Uses. if we belive we have an existion Repo accessible - ASync := TSync.Create(); ASync.SetTransport(TransP); // possible value defined in SyncUtils, SyncFile, SyncNextCloud, SyncAndroid ASync.DebugMode:=True; ASync.TestRun := ? ; ASync.ProceedFunction:=@Proceed; // A higher level function that can resolve clashes ASync.NotesDir:= ?; ASync.ConfigDir := ?; ASync.SyncAddress := ?; ASync.RepoAction:= RepoUse; // RepoUse says its all there, ready to go. Async.SetMode(SyncFile); // SyncFile, SyncNextRuby .... SyncReady <> ASync.TestConnection() then // something bad happened, SyncReady only // acceptable answer. Check ErrorString If joining an existing or making a new repo, set RepoAction to RepoJoin, if TestConnection returns SyncNoRemoteRepo then ask user if they want to create a new repo, try again with RepoNew. Other errors to be dealt with include - SyncXMLError, SyncNoRemoteDir, SyncBadRemote, SyncNoRemoteWrite .... ----------------------------------------------------------------------------- Operation of this unit - Fistly, this unit depends on on the Trans unit, a virtual unit of which the TransFile has been implemented and TransNet partially. Further Transport layers should be easily made. Two seperate approaches are needed. In both cases we build a list of all the notes we know about and what we plan to do for each. The list is built differently for each case and, then, the same processes are applied to that list. Creating a new Repo is, effectivly, a variation of the second. ---- Terms ---- LCD - Last Change Date LSD - Last Sync Date LocalDelete - a note that has been previously synced but is no longer mentioned in Remote Manifest, its been deleted elsewhere. RemoteDelete - a note that has been previously synced but has been eleted locally, remove it from Repo. NewUpLoad - a note the Repo has not seen before EditUpLoad - a note, previusly synced and has been edited locally since last sync. Some globals we'll need to know - - Repo, config and notes directory. - Remote ServerID - RemoteRevNo (except if its a new repo) - Local Last Sync Date, as a string. - Local Last Revision Number TestConnection() will establish indicated Repo dir exists and we have write permission there, does it look like an Existing Repo ? If an existing repo, get ServerID and RemoteRevNo. If we are making a new connection, make a GUID and set those vars appropriatly. The Model as implemented in tomboy-ng, October 2018 We call TestTransportEarly() and/or TestTransport() Its tests and may, or may not populate NoteMetaData with remote notes. It may, or may not put the remote LCD in NoteMetaData. We call StartSync() (not talking about Android mode here.) --------------------- RepoAction = RepoUse (that is, it all should be setup, just go and do it) CheckUsingRev() Assigned a action to each existing entry in NoteMetaData based on the current revision number and notes present in NotesDir. Note this method is an alternative to CheckUsingLCD(). CheckRemoteDeletes() Marks remote deletes, that is notes that are mentioned in LocalManifets as having been synced in the past (but not deleted section) but were not listed in NoteMetaData at this stage because the Remote Server does not know about them. Note, this will override a local note that has been edited since last sync - should this be a clash ? CheckLocalDeletes() looks at notes listed in LocalManifest as Deletes, it markes them, in NoteMetaData as DeleteRemote to be deleted from remote system (maybe just not mentioned in remote manifest any more). CheckNewNotes() looks in Notes dir for any notes there that are not yet listed in NoteMetaData. These notes are UploadNew. Call the General Write Behavour Block if not a TestRun. RepoAction = RepoJoin --------------------- CheckUsingLCD(True) Assignes an Action to each entry in NoteMetaData (which only contains entries from remote repo at this stage) based on last-change-date. If it finds a potential clash, aborts if it does not have last-change-date for the remote note. In that case, we recall LoadReopData(True) this time demanding last change date. And then run CheckUsingLCD again. Note this method is an alternative to CheckUsingRev(). Any notes thats determined here to be an UpLoad has its LCD (in NoteMetaData) set to the local note's LCD. Because a join cannot use local manifest, we do not honour remote or local deletes. CheckNewNotes() looks in Notes dir for any notes there that are not yet listed in NoteMetaData. These notes are UploadNew. Call the General Write Behavour Block if not a TestRun. RepoAction = RepoNew (if we determine, during a RepoJoin, that the dir we are pointing to does not contain a repo, we create one in this mode. Must always call RepoJoin first) ----------------------- CheckNewNotes() looks in Notes dir for any notes there that are not yet listed in NoteMetaData (which, is, of course empty at this stage). These notes are UploadNew. Call the General Write Behavour Block if not a TestRun. General Write Behavour ---------------------- applies for all three cases above. Some methods are not relevent in some modes, they just return true when they detect that themselves.) ProcessClashes() DoDownLoads() WriteRemoteManifest() - writes out a local copy of remote manifest to be used later. We always write it (except in TestRun) but only call Transport to deal with it if we have notes changing. DoDeletes() - Deletes from remote server. In current file implementation, does nothing. DoUploads() DoDeleteLocal() WriteLocalManifest() Note, we want to write a new local manifest even if there are no note changes taking place, that way, we get an updated Last-Sync-Date and possibly updated revnumber. If we have not changed any files, then RevNo is the one we found in RemoteManifest. So, we must step through the write stack. We make a half harted attempt to restore normality if we get to local manifest stage and somehow fail to write it out. ----------------------------------------------------------------------------------- HISTORY 2018/10/18 Memory leak in CheckUsingLCD(), StartSync() should not call processClashes() during a TestRun. Only during real thing. 2018/10/22 CheckMetaData() was returning wrong value. 2018/10/25 Much testing, support for Tomdroid. 2018/10/28 Much tweaking and bug fixing. 2018/10/29 Tell TB_Sdiff about note title before showing it. 2018/11/03 Call checkmetadata before resolving clashes. 2018/11/04 No longer call MarkNoteReadOnly as we now rely on searchForm.ProcessSyncUpdates 2018/11/05 Now set Notemeatdata LCD to LCD of local note when Clash handler sets SyUpLoadEdit 2018/11/25 Added DeleteFromLocalManifest(), called from search unit, TEST ! 2018/06/05 Change to doing Tomboy's sync dir names, rev 431 is in ~/4/341 2019/07/19 Escape ' and " when using Title as an attribute in local manifest. 2020/02/27 Better detect when we try to sync and don't have a local manifest, useful for Tomdroid, check normal ! 2021/01/04 Support TomdroidFile sync mode. 2021/08/31 Added sha to TNoteInfo 2021/09/08 Added progress indicator 2021/09/27 Selective Sync, possible to have both configured and in use. } interface uses Classes, SysUtils, SyncUtils, Trans, TransFileAnd; type { ----------------- T S Y N C --------------------- } { TSync } TSync = class private // Generally an empty string but in Android/Tomdroid something we prefix // to local manifest file name to indicate which connection it relates to. ManPrefix : string; // Set by SetTransport(), indicates what sort of Sync we are trying to do. TransportMode : TSyncTransport; { Indicates an action to take to be taken for each (and every) note during a sync. } ProceedAction : TSyncAction; // Where we find Tomboy style notes FNotesDir : string; // Where we find config and local manifest files FConfigDir : string; { Scans Notes dir looking for each note in NoteMetaData. Any it finds are either clashes or SyNothing, anything left are downloads. If AssumeNoClash and we find a clash, unresolable 'cos LCD missing, ret False, (and expect LoadRepoData to be called again. Used when JOINING an existing repo.} function CheckUsingLCD(AssumeNoClash : boolean) : boolean; { Returns true if the passed dates are pretty close, see code for just how close } function DatesClose(const DS1, DS2: TDateTime): boolean; { Backs up and then removes any local local notes listed NoteMetaData as SyDeleteLocal } function DoDeleteLocal(): boolean; { Returns the title of given note, prefers the local version but if it does not exist, then "downloads" remote one } function GetNoteTitle(const ID : ANSIString; const Rev : integer): ANSIString; // function IDLooksOK(const ID: string): boolean; { Looks at a clash and determines if its an up or down depending on possible higher order TSyncActions such as newer, older } function ResolveAllClash(const Act : TSyncAction; const ID, FullRemoteFileName : ANSIString): TSyncAction; { Goes over NoteMetaData (which has only remote notes at this stage) assigning an Action to each. Only called when using an established sync connection. } function CheckUsingRev(): boolean; {Notes we have deleted (and existed) here since last sync are marked DeleteRemote because we must delete them from the server. For file sync, that means not mentioning them in remote manifest any more. Note that while it might seem unnecessary, we must inc the revision number.} procedure CheckLocalDeletes(); { Scans over the notes directory for any note not mentioned in NoteMetaData and adds it as an syUploadNew as its a new note since last sync. Call after all the other methods that help build the NoteMetaDate. } procedure CheckNewNotes(); {if we have a note prev synced (ie, in local manifest) but not now in RemoteMetaData, it was deleted by another client, Mark these as DeleteLocal, will later backup and delete.} procedure CheckRemoteDeletes(); // Just a debug procedure, dumps (some) contents of a list to console procedure DisplayNoteInfo(const meta: TNoteInfoList; const ListTitle : string); // Based on NoteMetaData, calls transport to delete notes from Server. function DoDeletes(): boolean; { We call transport for all the notes in the list we need download. Transport does most of the work. In TestMode, does nothing } function DoDownloads(): boolean; { Uploads any files it finds necessary in NoteMetaData. Returns false if anything goes wrong (such as a file error) } function DoUploads(): boolean; { Asks Transport for a list of the notes remote server knows about. If ForceLCD then make heroic efforts to get last-change-dates } function LoadRepoData(ForceLCD : boolean): boolean; { Searches list for any clashes, refering each one to user. Done after list is filled out in case we want to ask user for general instrucions } procedure ProcessClashes(); // Checks if local note exists, optionally returning with its last change date. function LocalNoteExists(const ID : string; out CDate: string; GetDate: boolean=false): Boolean; // Call this when we are resolving a sync clash. Note : not possible results make sense ! function ProceedWith(const ID, FullRemoteFileName, NTitle: ANSIString): TSyncAction; { Reads through Local Manifest file, filling out LocalMetaData, LastSyncDateSt and CurrRev. If local manifest does not exist, still returns True but CurrRev=0 and LocalLastSyncDateSt='' If FullFileName parameter is missing, uses default version.} function ReadLocalManifest(const FullFileName : string = ''): boolean; { Writes a local mainfest file. Assumes NoteMetaData contains valid data about new Rev numbers and for uploads, last-change-date. If WriteOK is false then don't rev number and don't mention new notes in local manifest. Should never write entries in the DeletedNotes section. This function is called at the end of a normal file sync, another one is used when updating (with deletes) an existing manifest. Key diff is ability to inc rev no and (unnecessary) writing of a failsafe version if things go wrong. Merge at some stage. } function WriteLocalManifest(const WriteOK, NewRev : boolean) : boolean; { We write a remote manifest out localy if we have any uploads or to handle the delete from server a note that was deleted locally to do. Then, if TestMode is false, call Transport to deal with it. Writing it locally is fast and we get to check for and isolate any data errors. Initially written to $CONFIG/manifest.xml-remote and copied (moved ?).} function WriteRemoteManifest(out NewRev: boolean): boolean; { Only used with DeleteFromLocalManifest(), iff it finds a matching entry in indicated manifest main sesction moves it to the deleted Notes section } function DeleteFromThisManifest(const FullFileName, ID: string): boolean; { Only used with DeleteFromLocalManifest(), writes LocalMetaData back to disk. Honours TestRun. } function ReWriteLocalManifest(const FullFileName : string) : boolean; { Applies only to Github, returns the token expire data or 'Expired' } function FGetTokenExpire() : string; function FGetTransRemoteAddress() : string; public // A passord, passed on to Trans for those Transports that need it. // Must be set (if needed) before SetTransport is called. UserName, Password : string; // Indicates what we want this unit to do. Set it and call TestConnection() repeatly... RepoAction : TRepoAction; { Records local manifests view of serverID, after succefull test, it should be the remote manifest's one too. In Android mode, we preload it from the config file at class creation and its overwritten (with same data) when local manifest is read. But in RepoJoin, we set it, after TestConnection to the Transport's view of what remote ServerID is. This is for Android mode to be able to record the new ID in its own config file. } LocalServerID : string; { the calling process must pass a function address to this var. It will be called if the sync process finds a sync class where both copies of a note have changed since last sync.} ProceedFunction : TProceedFunction; { A method to call when we can advise a GUI of progress through sync } ProgressProcedure : TProgressProcedure; // A URL or directory with trailing delim. SyncAddress : string; // Revision number the client is currently on CurrRev : integer; // A string of local last sync date. Empty if we have not synced before // Available iff we are in RepoUse mode after TestConnection() LocalLastSyncDateSt : string; // Last time this client synced (not this run), set and tested in call to StartSync() // Available iff we are in RepoUse mode after TestConnection() LocalLastSyncDate : TDateTime; // Write debug messages as we do things. DebugMode : boolean; // Determine what we'd do and write ref ver of manifests but don't move files around. // The first run during a Join is a TestRun, then, if user says Save, its not. TestRun : boolean; // A reason why something failed. ErrorString : string; { Data about notes in remote manifest, this list ultimatly holds the actions to be taked when the the actual sync process really runs. } RemoteMetaData : TNoteInfoList; // Data obtained from Local Manifest. Represents notes previously synced. Might be empty..... LocalMetaData : TNoteInfoList; procedure FSetConfigDir(Dir : string); property ConfigDir : string read FConfigDir write FSetConfigDir; property TransMode : TSyncTransport read TransportMode; property TokenExpire : string read FGetTokenExpire; procedure FSetNotesDir(Dir : string); Property NotesDir : string read FNotesDir write FSetNotesDir; { Returns the set Transport's RemoteAddress, for GithubSync } property GetTransRemoteAddress : string read fGetTransRemoteAddress; { IFF its there, delete the indicated ID from main section of local manifest (and any Tomdroid and SyncGithub manifests) and list it in the deleted section instead. Its really stand alone, create a sync object, set config and notes dir, call this method and free. } function DeleteFromLocalManifest(ID: ANSIString) : boolean; { Reports on contents of a created and filled list } procedure ReportMetaData(out UpNew, UpEdit, Down, DelLoc, DelRem, Clash, DoNothing, Errors: integer); { Selects a Trans layer, adjusts config dir, TransFileAnd : checks for the expected remote dir, may return SyncNoRemoteRepo, SyncNoServerID (not an error, just not used previously) or SyncReady. } function SetTransport(Mode : TSyncTransport) : TSyncAvailable; { Checks NoteMetaData for valid Actions, writes error to console. Always returns True and does mark bad lines with Action=SyError Also fills in note Title for notes we will do something with.} function CheckMetaData() : boolean; { May return : SyncXMLError, SyncNoRemoteDir, SyncNoRemoteWrite, SyncNoRemoteRepo, SyncBadRemote, SyncMismatch. Checks if the connecton looks viable, either (fileSync) it has right files there and write access OR (NetSync) network answers somehow (?). Reads local manifest if RepoAction=RepoUse and compares ts serverID with one found by Trans.testConnection. SyncReady means we can proceed to StartSync, else must do something first, setup new connect, consult user etc.} function TestConnection() : TSyncAvailable; { Do actual sync, but if TestRun=True just report on what you'd do. Assumes a Transport has been selected and remote address is set. We must already be a member of this sync, ie, its remote ID is recorded in our local manifest. } function StartSync() : boolean; constructor Create(); destructor Destroy(); override; end; implementation { TSync } uses laz2_DOM, laz2_XMLRead, TransFile, TransAndroid, TransGithub, LazLogger, LazFileUtils, FileUtil, Settings, tb_utils; var Transport : TTomboyTrans; constructor TSync.Create(); begin ProgressProcedure := Nil; RemoteMetaData := TNoteInfoList.Create; LocalMetaData := TNoteInfoList.Create; Transport := nil; end; destructor TSync.Destroy(); begin FreeandNil(LocalMetaData); FreeandNil(RemoteMetaData); FreeandNil(Transport); inherited Destroy(); end; function TSync.DeleteFromLocalManifest(ID: ANSIString) : boolean; var FullFileName : string; Info : TSearchRec; begin FullFileName := ConfigDir + 'manifest.xml'; if FileExists(FullFileName) then if not DeleteFromThisManifest(FullFileName, ID) then begin debugln('ERROR - failed to delete ' + ID + ' from ' + FullFileName); // Note - not finding the manifest file is not an error, just unsynced. exit(False); end else if DebugMode then debugln('DeleteFromLocalManifest - cannot find ' + FullFileName + ' not in use ?'); FullFileName := ConfigDir + SyncTransportName(SyncGithub) + PathDelim + 'manifest.xml'; if FileExists(FullFileName) then if not DeleteFromThisManifest(FullFileName, ID) then begin debugln('ERROR - failed to delete ' + ID + ' from ' + FullFileName); exit(False); end else if DebugMode then debugln('DeleteFromLocalManifest - cannot find ' + FullFileName + ' not in use ?'); if DirectoryExists(ConfigDir + 'android') then begin if FindFirst(ConfigDir + 'android' + pathdelim + '*.xml', faAnyFile, Info)=0 then try repeat // Info.Name is just the file name, no path prepended. // debugln('DeleteFromLocalManifest-------- Found xml file ' + Info.Name); DeleteFromThisManifest(ConfigDir + 'android' + pathdelim + Info.Name, ID); until FindNext(Info) <> 0; finally FindClose(Info); end; end else if DebugMode then debugln('DeleteFromLocalManifest - cannot find ' + ConfigDir + 'android'); exit(True); end; function TSync.LocalNoteExists(const ID : string; out CDate : string; GetDate : boolean = false) : Boolean; var Doc : TXMLDocument; Node : TDOMNode; //LastChange : string; begin if not FileExists(NotesDir + ID + '.note') then exit(False); if not GetDate then exit(True); Result := True; try ReadXMLFile(Doc, NotesDir + ID + '.note'); Node := Doc.DocumentElement.FindNode('last-change-date'); if assigned(node) then CDate := Node.FirstChild.NodeValue else begin CDate := ''; Result := False; end; finally Doc.free; end; end; { ================= E X T E R N A L C A L L O U T S ===========================} function TSync.ProceedWith(const ID, FullRemoteFileName, NTitle : ANSIString) : TSyncAction; var ClashRec : TClashRecord; //ChangeDate : ANSIString; begin // Note - we no longer fill in all of clash record, let sdiff unit work it out. ClashRec.NoteID := ID; ClashRec.Title:= NTitle; ClashRec.ServerFileName := FullRemoteFileName; ClashRec.LocalFileName := self.NotesDir + ID + '.note'; Result := ProceedFunction(Clashrec); if Result in [SyAllOldest, SyAllNewest, SyAllLocal, SyAllRemote] then ProceedAction := Result; end; function TSync.ResolveAllClash(const Act : TSyncAction; const ID, FullRemoteFileName : ANSIString) : TSyncAction; var Temp : string; begin Result := SyDownload; // just in case .... case Act of SyAllLocal : exit(SyUpLoadEdit); SyAllRemote : exit(SyDownLoad); SyAllNewest : if TB_GetGMTFromStr(GetNoteLastChangeSt(NotesDir + ID + '.note', Temp)) > TB_GetGMTFromStr(GetNoteLastChangeSt(FullRemoteFileName, Temp)) then exit(SyUploadEdit) else exit(SyDownLoad); SyAllOldest : if TB_GetGMTFromStr(GetNoteLastChangeSt(NotesDir + ID + '.note', Temp)) < TB_GetGMTFromStr(GetNoteLastChangeSt(FullRemoteFileName, Temp)) then exit(SyUploadEdit) else exit(SyDownLoad); end; end; procedure TSync.ProcessClashes(); var Index : integer; RemoteNote : string; begin for Index := 0 to RemoteMetaData.Count -1 do begin //debugln('TSync.ProcessClashes checking note number ' + inttostr(Index) + ' id=' + RemoteMetaData.Items[Index]^.ID); with RemoteMetaData.Items[Index]^ do begin if Action = SyClash then begin RemoteNote := Transport.DownLoadNote(ID, Rev); debugln('TSync.ProcessClashes - Resolving clash with ' + RemoteNote); if ProceedAction = SyUnSet then begin // let user decide Action := ProceedWith(ID, RemoteNote, RemoteMetaData.Items[Index]^.Title); if Action in [SyAllOldest, SyAllNewest, SyAllLocal, SyAllRemote] then Action := ResolveAllClash(Action, ID, RemoteNote); end else Action := ResolveAllClash(ProceedAction, ID, RemoteNote); // user has already said "all something" end; //if its now become an upload, we update the LCD because ...... if Action = SyUpLoadEdit then begin LastChange := GetNoteLastChangeSt(NotesDir + ID + '.note', ErrorString); if LastChange <> '' then LastChangeGMT := TB_GetGMTFromStr(LastChange) else debugln('ERROR, Failed to get LCD from local ' + ID + ' --- ' + ErrorString); end; end; end; end; procedure TSync.ReportMetaData(out UpNew, UpEdit, Down, DelLoc, DelRem, Clash, DoNothing, Errors : integer); var Index : integer; begin UpNew := 0; UpEdit := 0; Down := 0; Errors := 0; DelLoc := 0; DelRem := 0; DoNothing := 0; Clash := 0; for Index := 0 to RemoteMetaData.Count -1 do begin case RemoteMetaData.Items[Index]^.Action of SyUpLoadNew : inc(UpNew); SyUpLoadEdit : inc(UpEdit); SyDownLoad : inc(Down); SyDeleteLocal : inc(DelLoc); SyDeleteRemote : inc(DelRem); SyClash : inc(Clash); SyNothing : inc(DoNothing); SyError : inc(Errors); end; end; end; function TSync.CheckMetaData(): boolean; var Index : integer; begin Result := True; ErrorString := ''; for Index := 0 to RemoteMetaData.Count -1 do begin if RemoteMetaData[Index]^.Action = SyUnSet then begin Debugln('ERROR note not assigned ' + RemoteMetaData[Index]^.ID + ' ' + RemoteMetaData.ActionName(RemoteMetaData[Index]^.Action) + ' ' + RemoteMetaData[Index]^.LastChange + ' ' + RemoteMetaData[Index]^.Title ); result := False; end; if IDLooksOK(RemoteMetaData[Index]^.ID) then begin if (RemoteMetaData[Index]^.Action in [SyNothing, SyUploadNew, SyUpLoadEdit, SyDownLoad, SyDeleteLocal, SyDeleteRemote, SyClash] ) and (RemoteMetaData[Index]^.Title = '') then RemoteMetaData[Index]^.Title := GetNoteTitle(RemoteMetaData[Index]^.ID, RemoteMetaData[Index]^.Rev); end else begin if RemoteMetaData[Index]^.Title = '' then RemoteMetaData[Index]^.Title := GetNoteTitle(RemoteMetaData[Index]^.ID, RemoteMetaData[Index]^.Rev); Debugln('ERROR - invalid ID detected when CheckMetaData [' + RemoteMetaData[Index]^.ID + ']'); RemoteMetaData[Index]^.Action := SyError; ErrorString := 'ERROR - invalid ID detected when CheckMetaData [' + RemoteMetaData[Index]^.ID + ']'; end; end; if debugmode then debugln('CheckMetaData - NoteMetaData has ' + inttostr(RemoteMetaData.Count) + ' entries.'); end; function TSync.GetNoteTitle(const ID : ANSIString; const Rev : integer) : ANSIString; var Doc : TXMLDocument; Node : TDOMNode; FileName : string; begin Result := 'File Not Found'; FileName := NotesDir + ID + '.note'; if not FileExistsUTF8(FileName) then if assigned(Transport) then FileName := Transport.DownLoadNote(ID, Rev); if FileExistsUTF8(FileName) then begin try Result := 'Unknown Title'; try ReadXMLFile(Doc, FileName); Node := Doc.DocumentElement.FindNode('title'); Result := Node.FirstChild.NodeValue; except on EXMLReadError do Result := 'Note has no Title ' + FileName; on EAccessViolation do Result := 'Access Violation ' + FileName; end; finally Doc.free; end; end else begin debugln('ERROR - cannot get title for ' + FileName); result := 'ERROR getting Title'; end; end; procedure TSync.DisplayNoteInfo(const meta : TNoteInfoList; const ListTitle : string); var I : Integer; St : string; begin debugln('-----------list dump for ' + ListTitle); for I := 0 to Meta.Count -1 do begin St := ' ' + inttostr(Meta.Items[i]^.Rev); while length(St) < 5 do St := St + ' '; // St := Meta.ActionName(Meta.Items[i]^.Action); debugln('ID=' + copy(Meta.Items[I]^.ID, 1, 9) + St + Meta.ActionName(Meta.Items[i]^.Action) + ' ' + Meta.Items[I]^.Title + ' sha=' + copy(Meta.Items[I]^.Sha, 1, 9)); debugln(' CDate=' + Meta.Items[i]^.CreateDate + ' LCDate=' + Meta.Items[i]^.LastChange); end; end; { ===================== D A T A C H E C K I N G M E T H O D S ============= } function TSync.DatesClose(const DS1, DS2 : TDateTime) : boolean; var Margin : TDateTime = 0.000001; // a tenth of a second is about one millionth of a day ! begin if DS1 > DS2 then result := (DS1 < (DS2 + Margin)) // 1 greater than 2, if it changes when we increase 2 result is true else Result := (DS1 > (DS2 - Margin)); // 1 is less than 2, if it changes when we decrease 2, result is true end; function TSync.CheckUsingLCD(AssumeNoClash : boolean) : boolean; var Index : integer; Count : integer = 0; Info : TSearchRec; PNote : PNoteInfo; LocLCD : string; // The local note's last change date begin { We declare a clash if both notes exist and LCDs are not identical (or nearly identical) However, iff we have a local last sync date (LLSD) then if the earlier note pre-dates it, its not a clash. So, not a 'pure' LCD model, } if FindFirst(NotesDir + '*.note', faAnyFile, Info)=0 then begin try repeat inc(Count); PNote := RemoteMetaData.FindID(copy(Info.Name, 1, 36)); LocLCD := GetNoteLastChangeSt(NotesDir + Info.Name, ErrorString); // hmm, not checking for errors there ..... if PNote <> nil then begin // ie, note exists on both sides if AssumeNoClash and (PNote^.LastChange = '') then begin if Debugmode then debugln('CheckUsingLCD exiting because if unresolved clash'); exit(false); // might be a clash, go fill out LCD in remote data end; // Next line new, we now accept an idetical string or a datestring thats pretty close if ((PNote^.LastChange = LocLCD) or (DatesClose(PNote^.LastChangeGMT, TB_GetGMTFromStr(LocLCD)))) then // its the same note PNote^.Action := SyNothing else begin PNote^.Action := SyClash; // Best we can do if last sync date not available. if LocalLastSyncDateSt <> '' then begin // We can override that iff we have a LLSD if TB_GetGMTFromStr(LocLCD) < LocalLastSyncDate then PNote^.Action := SyDownload else if PNote^.LastChangeGMT < LocalLastSyncDate then PNote^.Action := SyUploadEdit; if debugmode then debugln('GMTimes - loc=' + FormatDateTime( 'yyyy-mm-dd hh:mm:ss', TB_GetGMTFromStr(LocLCD)) + ' rem=' + FormatDateTime( 'yyyy-mm-dd hh:mm:ss', PNote^.LastChangeGMT) + ' LLSD=' + FormatDateTime( 'yyyy-mm-dd hh:mm:ss', LocalLastSyncDate) + ' rem-st=' + PNote^.LastChange); end; end; end else begin // this note is a new upload, add it to list. new(PNote); PNote^.ID := copy(Info.Name, 1, 36); PNote^.LastChange:=LocLCD; PNote^.Action:= SyUpLoadNew; // Note, we may overrule that in CheckRemoteDeletes() PNote^.Sha := ''; RemoteMetaData.Add(PNote); end; until FindNext(Info) <> 0; finally FindClose(Info); end; end; for Index := 0 to RemoteMetaData.Count -1 do if RemoteMetaData.Items[Index]^.Action = SyUnSet then RemoteMetaData.Items[Index]^.Action := SyDownLoad; if DebugMode then Debugln('CheckUsingLCD checked against ' + inttostr(Count) + ' local notes'); exit(True); end; procedure TSync.CheckRemoteDeletes(); var Index : integer; PNote : PNoteInfo; Count : integer = 0; begin // Must find a created LocalMetaData but an empty one is normal. // Iterate over LocalMetaData looking for notes listed as prev synced // but are not listed in RemoteMetaData. Or are listed as SyUploadNew !! // CheckUsingLCD puts all notes it finds locally but not in Remote as SyUploadNew // We'll add a entry (or change entry) in NoteMetaData for any we find. for Index := 0 to LocalMetaData.Count -1 do begin if not LocalMetaData.Items[Index]^.Deleted then begin PNote := RemoteMetaData.FindID(LocalMetaData.Items[Index]^.ID); if PNote = nil then begin // That is, we did not find it new(PNote); PNote^.ID:= LocalMetaData.Items[Index]^.ID; PNote^.Title := LocalMetaData.Items[Index]^.Title; // I think we know title, useful debug info here.... PNote^.Action := SyDeleteLocal; // Was deleted elsewhere, do same here. PNote^.Sha := ''; RemoteMetaData.Add(PNote); inc(Count); end else begin if PNote^.Action = SyUploadNew then // if it is mentioned in Local Man but Load decided it was '~New', its PNote^.Action := SyDeleteLocal; // really a note that was deleted remotely and should be deleted locally now end; end; end; if debugmode then debugln('CheckRemoteDeletes checked ' + inttostr(LocalMetaData.Count) + ' and found ' + inttostr(Count) + ' notes '); end; procedure TSync.CheckNewNotes(); var Info : TSearchRec; PNote : PNoteInfo; ID, CDate : string; Count : integer = 0; CountNew : integer = 0; begin if FindFirst(NotesDir + '*.note', faAnyFile, Info)=0 then begin repeat ID := copy(Info.Name, 1, 36); inc(Count); //Debugln('Found [' + NotesDir+ Info.Name + ']'); PNote := RemoteMetaData.FindID(ID); if PNote = nil then begin if LocalNoteExists(ID, CDate, True) then begin new(PNote); Pnote^.ID:=ID; Pnote^.LastChange:=CDate; PNote^.Action:=SyUploadNew; PNote^.sha := ''; RemoteMetaData.Add(PNote); inc(CountNew); end else Debugln('Failed to find lastchangedate in ' + Info.Name); end; until FindNext(Info) <> 0; end; FindClose(Info); if debugMode then debugln('CheckNewNotes found ' + inttostr(Count) + ' notes in local dir and ' + inttostr(CountNew) + ' new ones.'); end; // Iterate over LocalMetaData looking for notes that have been deleted // locally and put them in RemoteMetaData to be deleted from the server. procedure TSync.CheckLocalDeletes(); var I : integer; Count : integer = 0; PNote : PNoteInfo; begin for I := 0 to LocalMetaData.Count -1 do begin if LocalMetaData.Items[i]^.Deleted then begin inc(Count); PNote := RemoteMetaData.FindID(LocalMetaData.Items[i]^.ID); if PNote <> nil then PNote^.Action := SyDeleteRemote; end; end; if DebugMode then debugln('CheckLocalDeletes found ' + inttostr(Count) + ' deleted notes in local manifest'); end; function TSync.CheckUsingRev() : boolean; var I : integer; ID : string; // to make it a bit easier to read souce PNote : PNoteInfo; LocCDate : string; LocChange, RemChange : boolean; begin Result := True; for I := 0 to RemoteMetaData.Count -1 do begin ID := RemoteMetaData.Items[I]^.ID; if LocalNoteExists(ID, LocCDate) then begin LocalNoteExists(ID, LocCDate, True); LocChange := TB_GetGMTFromStr(LocCDate) > LocalLastSyncDate; // TDateTime is a float RemChange := RemoteMetaData.Items[I]^.Rev > CurrRev; // This is not valid for Tomdroid if LocChange and RemChange then RemoteMetaData.Items[I]^.Action := SyClash else if LocChange then RemoteMetaData.Items[I]^.Action := SyUpLoadEdit else if RemChange then RemoteMetaData.Items[I]^.Action := SyDownLoad else RemoteMetaData.Items[I]^.Action := SyNothing; end else begin // OK, not here but maybe we deleted it previously ? Pnote := LocalMetaData.FindID(ID); if PNote <> Nil then begin if PNote^.Deleted then RemoteMetaData.Items[I]^.Action:=SyDeleteRemote; // I have deleted that already. end else RemoteMetaData.Items[I]^.Action:=SyDownload; // its a new note from elsewhere end; if RemoteMetaData.Items[I]^.Action = SyUnset then begin debugln('---- Note on Sync List with unassigned action ----'); debugln('ID=' + RemoteMetaData.Items[I]^.ID); debugln('sync.pas CheckUsingRev() - please report this message'); end; if RemoteMetaData.Items[I]^.Action = SyUpLoadEdit then begin RemoteMetaData.Items[I]^.LastChange := GetNoteLastChangeSt(NotesDir + ID + '.note', ErrorString); // debugln('=========== LCD is [' + RemoteMetaData.Items[I]^.CreateDate + ']'); end; end; end; { ======================== N O T E M O V E M E N T M E T H O D S ================} function TSync.DoDownloads() : boolean; {var I : integer; } begin Result := Transport.DownloadNotes(RemoteMetaData); if Result = false then begin self.ErrorString:= Transport.ErrorString; debugln('ERROR - Download Notes reported ' + ErrorString); end; if DebugMode then debugln('Downloaded notes.'); end; function TSync.DoDeleteLocal() : boolean; var I : integer; begin for I := 0 to RemoteMetaData.Count -1 do begin if RemoteMetaData.Items[i]^.Action = SyDeleteLocal then begin if FileExists(NotesDir + RemoteMetaData.Items[i]^.ID + '.note') then if CopyFile(NotesDir + RemoteMetaData.Items[i]^.ID + '.note', NotesDir + PathDelim + 'Backup' + Pathdelim + RemoteMetaData.Items[i]^.ID + '.note') then DeleteFile(NotesDir + RemoteMetaData.Items[i]^.ID + '.note'); end; end; result := true; end; function TSync.DoDeletes() : boolean; var Index : integer; //Cnt : integer = 0; begin if DebugMode then Debugln('DoDeletes Count = ' + inttostr(RemoteMetaData.Count)); for Index := 0 to RemoteMetaData.Count - 1 do begin if RemoteMetaData[Index]^.Action = SyDeleteRemote then begin if DebugMode then Debugln('Delete remote note : ' + RemoteMetaData.Items[Index]^.ID); if not TestRun then begin if not Transport.DeleteNote(RemoteMetaData.Items[Index]^.ID, RemoteMetaData.Items[Index]^.Rev) then begin debugln('ERROR, TSync.DoDeletes got back false from transport'); Exit(False); end; end; end; end; Result := true; end; function TSync.DoUploads() : boolean; var Uploads : TstringList; Index : integer; begin if DebugMode then debugln('Doing uploads and Remote ServerRev is ' + inttostr(Transport.RemoteServerRev)); try Uploads := TstringList.Create; for Index := 0 to RemoteMetaData.Count -1 do begin if RemoteMetaData.Items[Index]^.Action in [SyUploadEdit, SyUploadNew] then begin Uploads.Add(RemoteMetaData.Items[Index]^.ID); RemoteMetaData.Items[Index]^.Rev := Transport.RemoteServerRev + 1; end; end; if not TestRun then if not Transport.UploadNotes(Uploads) then begin ErrorString := Transport.ErrorString; exit(False); end; finally Uploads.Free; end; Result := true; end; function TSync.FGetTokenExpire(): string; begin if assigned(Transport) and (Transport is TGitHubSync) then Result := TGitHubSync(Transport).TokenExpires else Result := 'not applicable'; // should never happen end; function TSync.FGetTransRemoteAddress(): string; begin Result := Transport.RemoteAddress; end; { ================= S T A R T U P M E T H O D S ============== } function TSync.SetTransport(Mode: TSyncTransport) : TSyncAvailable; begin if ProgressProcedure <> nil then ProgressProcedure('Set Transport'); TransportMode := Mode; NotesDir := AppendPathDelim(NotesDir); ConfigDir := AppendPathDelim(ConfigDir); ErrorString := ''; FreeAndNil(Transport); case Mode of SyncFile : begin SyncAddress := AppendPathDelim(Sett.GetSyncFileRepo()); Transport := TFileSync.Create; end; SyncGitHub : begin Transport := TGithubSync.Create; Transport.Password := Password; Transport.Username := UserName; ConfigDir := ConfigDir + SyncTransportName(SyncGithub) + PathDelim; ForceDirectory(ConfigDir); end; SyncAndroid : begin // debugln('Oh boy ! We have called the android line !'); Transport := TAndSync.Create; ManPrefix := copy(LocalServerID, 1, 8); // But in join mode, LocalServerID is empty at this stage ... end; SyncFileAndroid : begin // debugln('Oh boy ! We have called the android line !'); Transport := TAndFileTrans.Create; ManPrefix := copy(Transport.ServerID, 1, 13); // here, servid is set in TAndFileTrans.create SyncAddress := Transport.RemoteAddress; end; end; Transport.ProgressProcedure := ProgressProcedure; Transport.Password := Password; Transport.NotesDir := NotesDir; Transport.DebugMode := DebugMode; if TransportMode in [SyncAndroid, SyncFileAndroid ] then begin ConfigDir := ConfigDir + 'android' + PathDelim; ForceDirectory(ConfigDir); end; Transport.ConfigDir := ConfigDir; // unneeded I think ?? Transport.RemoteAddress:= SyncAddress; // happens _before_ Trans.SetTransport Result := Transport.SetTransport(); // in github, this will (re)set Transport.RemoteAddress if TransportMode = SyncFileAndroid then LocalServerID := Transport.ServerID; // we need it to find profile ErrorString := Transport.ErrorString; if DebugMode then begin debugln('Remote address is (n.a. Tomdroid) ' + SyncAddress); debugln('Local Config ' + ConfigDir); debugln('Notes dir ' + NotesDir); end; end; function TSync.TestConnection(): TSyncAvailable; {var XServerID : string;} begin if ProgressProcedure <> nil then ProgressProcedure('Test Transport'); if RepoAction = RepoNew then begin LocalLastSyncDate := 0; LocalLastSyncDateSt := ''; Transport.RemoteServerRev:=-1; Transport.ANewRepo:= True; // means we should prepare for a new repo (but not make it yet), don't check for files. end; if RepoAction = RepoUse then begin if not ReadLocalManifest() then exit(SyncXMLError); // Error in local mainfest, OK or no manifest=true if LocalLastSyncDateSt = '' then begin ErrorString := 'Failed to read local manifest, is this an existing sync ?'; debugln('ReadLocalManifest set an empty LocalLastSyncDateSt, probably local manifest does not exist.'); exit(SyncNoLocal); end; LocalLastSyncDate := TB_GetGMTFromStr(LocalLastSyncDateSt); if LocalLastSyncDate < 1.0 then begin ErrorString := 'Invalid last sync date in local manifest [' + LocalLastSyncDateSt + ']'; debugln('Invalid last sync date in ' + ConfigDir + ManPrefix + 'manifest.xml'); exit(SyncXMLError); end; end; if RepoAction = RepoJoin then begin LocalLastSyncDate := 0; LocalLastSyncDateSt := ''; if TransportMode in [ SyncAndroid, SyncFileAndroid ] then Transport.ANewRepo:= True; // Ugly, but while its technically a 'new' it looks a bit like Join..... end; Result := Transport.TestTransport(not TestRun); // ***************** if Result <> SyncReady then begin ErrorString := Transport.ErrorString; exit; end; if TransportMode = SyncFileAndroid then // During a join in SyncFileAndroid, we just set a new serverid on remote dir. ManPrefix := copy(Transport.ServerID, 1, 13); if DebugMode then begin debugln('CurrRev=' + inttostr(CurrRev) + ' Last Sync=' + LocalLastSyncDateSt + ' Local Entries=' + inttostr(LocalMetaData.Count)); debugln('Config=' + ConfigDir + ' NotesDir=' + NotesDir); end; if RepoAction = RepoUse then if Transport.ServerID <> LocalServerID then begin ErrorString := 'ServerID Mismatch'; if DebugMode then debugln('ERROR Server ID Mismatch Remote ' + Transport.ServerID + ' and local ' + LocalServerID); exit(SyncMismatch); end; if RepoAction = RepoJoin then begin LocalServerID := Transport.ServerID; if (TransportMode = SyncAndroid) then ManPrefix := copy(LocalServerID, 1, 8); end; if Result = SyncReady then if not IDLooksOK(Transport.ServerID) then begin ErrorString := 'An invalid serverID detected [' + Transport.ServerID + ']'; debugln('ERROR - completed TestConnection but ServerID is invalid [' + Transport.ServerID + ']'); Result := SyncBadError; end; end; function TSync.LoadRepoData(ForceLCD : boolean): boolean; begin if ProgressProcedure <> nil then ProgressProcedure('Load Remote Repo'); Result := True; FreeAndNil(RemoteMetaData); RemoteMetaData := TNoteInfoList.Create; if not assigned(Transport) then debugln('Transport is not assigned'); if not assigned(RemoteMetaData) then debugln('RemoteMetaData is not assigned'); if TransportMode = SyncGitHub then exit(); case RepoAction of RepoUse : Result := Transport.GetRemoteNotes(RemoteMetaData, False); RepoJoin : Result := Transport.GetRemoteNotes(RemoteMetaData, ForceLCD); // Note, RepoNew does not apply here, if we are making a new one, we assume its empty. end; if DebugMode then begin debugln('LoadRepoData found ' + inttostr(RemoteMetaData.Count) + ' remote notes'); // DisplayNoteInfo(RemoteMetaData, 'NoteMetaData just after Loading'); end; // We do not load remote metadata when creating a new repo ! end; { ---------- The Lets Do it Function ------------- } function TSync.StartSync(): boolean; var NewRev : boolean = false; // Tick1, Tick2, Tick3, Tick4 : Dword; begin Result := True; if ProgressProcedure <> nil then ProgressProcedure('Starting Sync'); // TestRun := True; if not LoadRepoData(False) then exit(False); // don't get LCD until we know we need it. case RepoAction of RepoUse : begin case TransportMode of SyncAndroid, SyncFileAndroid : CheckUsingLCD(False); SyncGithub : TGithubSync(Transport).AssignActions(RemoteMetaData, LocalMetaData, TestRun); otherwise CheckUsingRev(); end; CheckRemoteDeletes(); CheckLocalDeletes(); end; RepoJoin : if TransportMode = SyncGithub then TGithubSync(Transport).AssignActions(RemoteMetaData, LocalMetaData, TestRun) else // Github will always have a LCD but not usable for this purpose. if not CheckUsingLCD(True) then begin // at least 1 possible clash LoadRepoData(True); // start again, getting LCD this time CheckUsingLCD(False); end; RepoNew : begin freeandNil(RemoteMetaData); RemoteMetaData := TNoteInfoList.Create; // clean out the list abd start again if TransportMode = SyncGithub then TGithubSync(Transport).AssignActions(RemoteMetaData, LocalMetaData, TestRun) end end; //DisplayNoteInfo(RemoteMetaData, 'RemoteMetaData before CheckNewNotes()'); if TransportMode <> SyncGithub then CheckNewNotes(); //DisplayNoteInfo(RemoteMetaData, 'RemoteMetaData before CheckMetaData()'); CheckMetaData(); if DebugMode then DisplayNoteInfo(RemoteMetaData, 'RemoteMetaData after CheckMetaData()'); if TestRun then begin if ProgressProcedure <> nil then ProgressProcedure('Finished Test Run'); exit(); end; ProcessClashes(); if DebugMode then DisplayNoteInfo(RemoteMetaData, 'NoteMetaData after ProcessClashes'); // ====================== Set an exit here to do no-write tests exit(false); if not DoDownLoads() then exit(SayDebugSafe('TSync.StartSync - failed DoDownLoads')); if TransPortMode <> SyncGitHub then if not WriteRemoteManifest(NewRev) then exit(SayDebugSafe('TSync.StartSync - failed early WriteRemoteManifest')); if not DoDeletes() then exit(SayDebugSafe('TSync.StartSync - failed DoDeletes')); if not DoUploads() then exit(SayDebugSafe('TSync.StartSync - failed DoUploads')); if not DoDeleteLocal() then exit(SayDebugSafe('TSync.StartSync - failed DoDeleteLocal')); if TransportMode = SyncGithub then if not Transport.DoRemoteManifest('', RemoteMetaData) then exit(SayDebugSafe('TSync.StartSync - failed late WriteRemoteManifest')); if not WriteLocalManifest(true, NewRev) then WriteLocalManifest(false, false); // write a recovery local manifest. Downloads only noted. (* if DoDownLoads() then if TransPortMode <> SyncGitHub then if WriteRemoteManifest(NewRev) then if DoDeletes() then if DoUploads() then if DoDeleteLocal() then if TransportMode = SyncGithub then if not WriteLocalManifest(true, NewRev) then WriteLocalManifest(false, false); // write a recovery local manifest. Downloads only noted. *) if ProgressProcedure <> nil then ProgressProcedure('Sync Complete'); Result := True; end; // ------------------ M A N I F E S T R E L A T E D ----------------------- function TSync.WriteRemoteManifest(out NewRev : boolean): boolean; var OutFile: TextFile; Index : integer; NewRevString : string; begin if DebugMode then debugln('Ready to do remote Manifest'); if not IDLooksOK(Transport.ServerID) then exit(false); // already checked but .... result := true; NewRev := False; for Index := 0 to RemoteMetaData.Count - 1 do begin if RemoteMetaData[Index]^.Action in [SyUploadNew, SyUpLoadEdit, SyDeleteRemote] then begin NewRev := True; break; // one is enough, we need a new manifest file ! end; end; if Not NewRev then exit(true); // exit cos no need for new Man, ret true cos no file error, NewRevString := inttostr(Transport.RemoteServerRev + 1); AssignFile(OutFile, ConfigDir + 'manifest.xml-remote'); try try Rewrite(OutFile); writeln(OutFile, ''); write(OutFile, ''); for Index := 0 to RemoteMetaData.Count - 1 do begin if RemoteMetaData[Index]^.Action in [SyUploadNew, SyUpLoadEdit, SyDownLoad, SyNothing] then begin write(OutFile, ' ') else writeln(OutFile, ' last-change-date="' + RemoteMetaData.Items[Index]^.LastChange + '" />'); end; end; writeln(OutFile, ''); except on E: EInOutError do begin Debugln('File handling error occurred. Details: ' + E.Message); exit(false); // file error ! end; end; finally CloseFile(OutFile); end; // do a safe version of this - if not TestRun then result := Transport.DoRemoteManifest(ConfigDir + 'manifest.xml-remote'); if debugmode then debugln('Have written remote manifest to ' + ConfigDir + ManPrefix + 'manifest.xml-remote'); end; //OK, this needs to call its code for each valid android manifest file. function TSync.DeleteFromThisManifest(const FullFileName, ID : string): boolean; var i : integer; Found : boolean = false; begin // if debugmode then debugln('DeleteFromThisManifest, searching for ' + ID); if not ReadLocalManifest(FullFileName) then exit(false); // read a local manifest if debugmode then debugln('DeleteFromThisManifest lines = ' + inttostr(LocalMetaData.count)); if LocalMetaData.count = 0 then exit(True); //if debugmode then debugln('DeleteFromThisManifest searcing for ' + ID); for I := 0 to LocalMetaData.count -1 do begin // debugln('DeleteFrom.. Testing ' + LocalMetaData.Items[i]^.ID); if LocalMetaData.Items[i]^.ID = ID then begin LocalMetaData.Items[i]^.Deleted:= True; LocalMetaData.Items[i]^.Title := GetNoteTitle(ID, -1); // -1 says don't try and download if its not local Found := True; if debugmode then debugln('DeleteFromThisManifest deleted ' + ID + ' from ' + FullFileName); break; end; end; if Found then ReWriteLocalManifest(FullFileName); Result := True; end; function TSync.ReWriteLocalManifest(const FullFileName : string) : boolean; var OutFile: TextFile; Index : integer; begin AssignFile(OutFile, FullFileName + '-local'); try try Rewrite(OutFile); writeln(OutFile, ''); writeln(Outfile, ''); writeln(OutFile, ' ' + LocalMetaData.LastSyncDateSt + ''); write(OutFile, ' "' + inttostr(LocalMetaData.LastRev)); writeln(OutFile, '"'); writeln(OutFile, ' "' + LocalMetaData.ServerID + '"'); writeln(OutFile, ' '); for Index := 0 to LocalMetaData.Count - 1 do begin if not LocalMetaData[Index]^.Deleted then begin write(Outfile, ' '' then write(Outfile, 'sha="' + LocalMetaData[Index]^.Sha + '" '); writeln(Outfile, '/>'); end; end; writeln(OutFile, ' '#10' '); for Index := 0 to LocalMetaData.Count - 1 do begin if LocalMetaData[Index]^.Deleted then begin write(Outfile, ' '); end; end; writeln(OutFile, ' '#10''); finally CloseFile(OutFile); end; except on E: EInOutError do begin Debugln('File handling error occurred. Details: ' + E.Message); exit(false); end; end; // if to here, copy the file over top of existing local manifest { if debugmode then debugln('Have written local manifest to ' + FullFileName + '-local'); } if not TestRun then begin renamefileutf8(FullFileName, FullFileName + '-old'); renamefileutf8(FullFileName + '-local', FullFileName); end; result := True; end; function TSync.WriteLocalManifest(const WriteOK, NewRev : boolean ): boolean; { We try and provide some recovery from a fail to write to remote repo. It should not happen but ... If WriteOk is false we write back local manifest that still mentions the previous deleted files and does not list locally new and changed files. Such files retain their thier previous rev numbers. Test ! } var OutFile: TextFile; Index : integer; IncRev : integer = 0; begin if not IDLooksOK(Transport.ServerID) then exit(false); // already checked but .... result := true; if WriteOK and NewRev then IncRev := 1 else IncRev := 0; AssignFile(OutFile, ConfigDir + ManPrefix + 'manifest.xml-local'); // ManPrefix is '' for most Modes. try try Rewrite(OutFile); writeln(OutFile, ''); writeln(Outfile, ''); writeln(OutFile, ' ' + TB_GetLocalTime + ''); write(OutFile, ' "' + inttostr(Transport.RemoteServerRev + IncRev)); writeln(OutFile, '"'); writeln(OutFile, ' "' + Transport.ServerID + '"'); writeln(OutFile, ' '); for Index := 0 to RemoteMetaData.Count - 1 do begin if RemoteMetaData[Index]^.Action in [SyUploadNew, SyUpLoadEdit, SyDownLoad, SyNothing] then begin if (not WriteOK) and (RemoteMetaData[Index]^.Action = SyUpLoadNew) then continue; write(Outfile, ' '' then write(Outfile, 'sha="' + RemoteMetaData[Index]^.Sha + '" '); writeln(Outfile, '/>'); end; end; writeln(OutFile, ' '#10' '); writeln(OutFile, ' '#10''); finally CloseFile(OutFile); end; except on E: EInOutError do begin Debugln('File handling error occurred. Details: ' + E.Message); exit(false); end; end; // if to here, copy the file over top of existing local manifest if not TestRun then copyfile(ConfigDir + ManPrefix + 'manifest.xml-local', ConfigDir + ManPrefix + 'manifest.xml'); if debugmode then debugln('Have written local manifest to ' + ConfigDir + ManPrefix + 'manifest.xml-local'); end; function TSync.ReadLocalManifest(const FullFileName : string = '') : boolean; var Doc : TXMLDocument; NodeList : TDOMNodeList; Node, NodeSha : TDOMNode; j : integer; NoteInfoP : PNoteInfo; RevStr, ServerID, ManifestFile : string; begin Result := true; ErrorString := ''; freeandNil(LocalMetaData); LocalMetaData := TNoteInfoList.Create; if FullFileName = '' then begin // get a FFN when using this unit to edit local man after a file delete ManifestFile := ConfigDir + ManPrefix + 'manifest.xml'; if not FileExists(ManifestFile) then begin LocalLastSyncDateSt := ''; CurrRev := 0; exit(True); // Its not an error, just never synced before end; end else ManifestFile := FullFileName; // existance is checked before calling. if DebugMode then debugln('Reading local mainfest ' + ManifestFile); try try ReadXMLFile(Doc, ManifestFile); Node := Doc.DocumentElement.FindNode('last-sync-date'); if assigned(Node) then begin LocalLastSyncDateSt := Node.FirstChild.NodeValue; LocalMetaData.LastSyncDateSt := Node.FirstChild.NodeValue; if not MyTryISO8601ToDate(LocalLastSyncDateSt, LocalMetaData.LastSyncDate, True) then LocalMetaData.LastSyncDate := 0.0; end else begin LocalLastSyncDateSt := ''; LocalMetaData.LastSyncDateSt := ''; LocalMetaData.LastSyncDate := 0.0; debugln('ERROR, cannot find LSD in ' + ManifestFile); end; Node := Doc.DocumentElement.FindNode('server-id'); // ToDo, check its assigned ! ServerID := Node.FirstChild.NodeValue; if ServerID[1] = '"' then ServerID := copy(ServerID, 2, 36); if not IDLooksOK(ServerID) then begin ErrorString := 'Local manifest contains an invalid serverID [' + ServerID +']'; debugln('ERROR - local manifest contains an invalid serverID [' + ServerID +']'); debugln('Maybe you should delete it and rejoin the Repo. ?'); exit(false); end; LocalServerID := ServerID; LocalMetaData.ServerID:= ServerID; Node := Doc.DocumentElement.FindNode('last-sync-rev'); try RevStr := Node.FirstChild.NodeValue; if RevStr[1] = '"' then Revstr := copy(revStr, 2, length(RevStr) - 2); CurrRev := strtoint(RevStr); except on EConvertError do // just a plain bad string ErrorString := 'Error converting Local Rev Version ' + RevStr; on EObjectCheck do // mac does this ErrorString := 'Error in local mainfest, check RevNo'; on EAccessViolation do // Lin does this ErrorString := 'Error in local mainfest, check RevNo'; end; LocalMetaData.LastRev := CurrRev; if ErrorString <> '' then begin CurrRev := 0; LocalLastSyncDateSt := ''; LocalMetaData.LastSyncDateSt:=''; exit(False); end; NodeList := Doc.DocumentElement.FindNode('note-revisions').ChildNodes; if assigned(NodeList) then for j := 0 to NodeList.Count-1 do begin new(NoteInfoP); NoteInfoP^.ID := NodeList.Item[j].Attributes.GetNamedItem('guid').NodeValue; NoteInfoP^.Rev := strtoint(NodeList.Item[j].Attributes.GetNamedItem('latest-revision').NodeValue); NodeSha := NodeList.Item[j].Attributes.GetNamedItem('sha'); if NodeSha = nil then NoteInfoP^.Sha := '' else NoteInfoP^.Sha := NodeSha.NodeValue; NoteInfoP^.Deleted := False; LocalMetaData.Add(NoteInfoP); end; NodeList := Doc.DocumentElement.FindNode('note-deletions').ChildNodes; if assigned(NodeList) then for j := 0 to NodeList.Count-1 do begin new(NoteInfoP); NoteInfoP^.ID := NodeList.Item[j].Attributes.GetNamedItem('guid').NodeValue; NoteInfoP^.Title := NodeList.Item[j].Attributes.GetNamedItem('title').NodeValue; NoteInfoP^.Deleted := True; NoteInfoP^.Sha := ''; LocalMetaData.Add(NoteInfoP); end; finally Doc.Free; end; except on EAccessViolation do begin // probably means we did not find an expected attribute ErrorString := 'Error in local mainfest'; CurrRev := 0; LocalMetaData.LastRev:=0; LocalLastSyncDateSt := ''; LocalMetaData.LastSyncDateSt:=''; Result := false; end; end; // if Debugmode then DisplayNoteInfo(LocalMetaData, 'LocalMetaData'); end; procedure TSync.FSetConfigDir(Dir: string); begin FConfigDir := AppendPathDelim(Dir); if DirectoryExists(FConfigDir) then begin if Not DirectoryIsWritable(FConfigDir) then self.ErrorString:= 'Cannot write to config dir'; end else ErrorString := 'Config dir does not exist'; end; procedure TSync.FSetNotesDir(Dir: string); begin FNotesDir := AppendPathDelim(Dir); end; end. tomboy-ng_0.34-1/source/index.pas0000644000175000017500000001000514145033507016525 0ustar dbannondbannonunit Index; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ This unit find and displays all the 'headings' in a note, returns with the block index of the one user clicked. A Heading is any complete line that is all either Large or Huge text. We indent Huge, Large Bold and just Large differently so easy to see relative heading importance. HISTORY 2019/05/14 Display strings all (?) moved to resourcestrings 2020/06/14 Added lockout to deal with RH issue. } {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, KMemo; type { TFormIndex } TFormIndex = class(TForm) Label1: TLabel; ListBox1: TListBox; Panel1: TPanel; procedure FormActivate(Sender: TObject); procedure FormShow(Sender: TObject); procedure ListBox1Click(Sender: TObject); private BlockClose : boolean; function IsHeading(const BlkNo: integer): integer; public TheKMemo : TKMemo; SelectedBlock : integer; end; var FormIndex: TFormIndex; implementation {$R *.lfm} { TFormIndex } uses Settings, lazlogger; procedure TFormIndex.FormShow(Sender: TObject); var Index : integer = 0; begin BlockClose := True; ModalResult := mrNone; SelectedBlock := -1; ListBox1.Items.BeginUpdate; try while Index < TheKmemo.Blocks.Count do begin while TheKMemo.Blocks.Items[Index].ClassNameIs('TKMemoParagraph') do begin inc(Index); if Index >= TheKMemo.Blocks.Count then exit; end; Index := IsHeading(Index); end; finally ListBox1.Items.EndUpdate; end; end; procedure TFormIndex.FormActivate(Sender: TObject); begin BlockClose := False; end; procedure TFormIndex.ListBox1Click(Sender: TObject); begin if (Listbox1.ItemIndex = -1) or BlockClose then begin ListBox1.ItemIndex := -1; exit; end; SelectedBlock := PtrInt(Listbox1.Items.Objects[Listbox1.ItemIndex]); //ShowMessage('Attached value: ' + IntToStr(SelectedBlock)); Modalresult := mrOK; end; function TFormIndex.IsHeading(const BlkNo : integer) : integer; var Index : integer; St : string = ''; begin Index := BlkNo; Result := BlkNo; // write('[CALLED=' + inttostr(blkno) + '] '); while Result < TheKmemo.Blocks.Count do begin if TheKMemo.Blocks.Items[Result].ClassNameIs('TKMemoParagraph') then break; inc(result); end; // writeln('[PARA=' + inttostr(Result)+']'); // Result is now pointing to first Para beyond BlkNo OR beyond kmemo content while Index < Result do begin // writeln('[' + inttostr(Index) + '] ' + TKmemoTextBlock(TheKMemo.Blocks.Items[Index]).Text); if (TheKMemo.Blocks.Items[Index].ClassNameIs('TKMemoTextBlock') and (TKmemoTextBlock(TheKMemo.Blocks.Items[Index]).TextStyle.Font.Size in [Sett.FontTitle, Sett.FontLarge, Sett.FontHuge])) then {begin writeln('================ Examined ' + TKmemoTextBlock(TheKMemo.Blocks.Items[Index]).Text);} inc(Index){; end } else // its not a heading exit(Result) // Remember we may be beyond the content .... end; // OK, its a heading, all blocks are Large or Huge. Huge=NoSpaces; LargeBold=2 spaces; Large=4 spaces if TKmemoTextBlock(TheKMemo.Blocks.Items[BlkNo]).TextStyle.Font.Size = Sett.FontLarge then begin St := '. '; if not (fsBold in TKmemoTextBlock(TheKMemo.Blocks.Items[BlkNo]).TextStyle.Font.style) then St := St + ' '; end; Index := BlkNo; while Index < Result do begin St := St + TKmemoTextBlock(TheKMemo.Blocks.Items[Index]).Text; inc(Index); end; ListBox1.AddItem(St, TObject(PtrInt(BlkNo))); inc(Result); end; end. tomboy-ng_0.34-1/source/syncgui.lrj0000644000175000017500000000245714145033507017117 0ustar dbannondbannon{"version":1,"strings":[ {"hash":372803,"name":"tformsync.caption","sourcebytes":[83,121,110,99],"value":"Sync"}, {"hash":86477809,"name":"tformsync.label1.caption","sourcebytes":[76,97,98,101,108,49],"value":"Label1"}, {"hash":86477810,"name":"tformsync.label2.caption","sourcebytes":[76,97,98,101,108,50],"value":"Label2"}, {"hash":187059587,"name":"tformsync.labelprogress.caption","sourcebytes":[76,97,98,101,108,80,114,111,103,114,101,115,115],"value":"LabelProgress"}, {"hash":77089212,"name":"tformsync.buttoncancel.caption","sourcebytes":[67,97,110,99,101,108],"value":"Cancel"}, {"hash":4863637,"name":"tformsync.buttonclose.caption","sourcebytes":[67,108,111,115,101],"value":"Close"}, {"hash":233429619,"name":"tformsync.buttonsave.caption","sourcebytes":[83,97,118,101,32,97,110,100,32,83,121,110,99],"value":"Save and Sync"}, {"hash":90721267,"name":"tformsync.panel3.caption","sourcebytes":[80,97,110,101,108,51],"value":"Panel3"}, {"hash":75149406,"name":"tformsync.listviewreport.columns[0].caption","sourcebytes":[65,99,116,105,111,110],"value":"Action"}, {"hash":5966629,"name":"tformsync.listviewreport.columns[1].caption","sourcebytes":[84,105,116,108,101],"value":"Title"}, {"hash":90862724,"name":"tformsync.listviewreport.columns[2].caption","sourcebytes":[78,111,116,101,32,73,68],"value":"Note ID"} ]} tomboy-ng_0.34-1/source/cli.pas0000644000175000017500000001250414145033507016173 0ustar dbannondbannonunit cli; {$mode objfpc}{$H+} { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ This unit is active before the GUI section and may decide GUI is not needed. Please see included License file. History 2020/06/18 Remove unnecessary debug line. } interface uses Classes, SysUtils, Dialogs; function ContinueToGUI() : boolean ; var SingleNoteName : string = ''; // other unit will want to know..... const Version_string = {$I %TOMBOY_NG_VER}; implementation uses Forms, LCLProc, LazFileUtils, ResourceStr, simpleipc; { If something on commandline means don't proceed, ret True } function CommandLineError(inCommingError : string = '') : boolean; // WARNING - the options here MUST match the options list in HaveCMDParam() below var ErrorMsg : string; begin ErrorMsg := InCommingError; Result := false; if ErrorMsg = '' then begin ErrorMsg := Application.CheckOptions('hgo:l:', 'lang: debug-log: dark-theme no-splash version help gnome3 open-note: debug-spell debug-sync debug-index config-dir: save-exit shiftaltF-findprev'); if Application.HasOption('h', 'help') then ErrorMsg := 'Usage -'; end; if ErrorMsg <> '' then begin DebugLn(ErrorMsg); {$ifdef DARWIN} debugln(rsMachelp1); debugln(rsMacHelp2); {$endif} debugln(' --dark-theme'); //debugln(' --delay-start ' + rsHelpDelay); debugln(' --lang=CCode ' + rsHelpLang); // syntax depends on bugfix https://bugs.freepascal.org/view.php?id=35432 debugln(' --debug-log=SOME.LOG ' + rsHelpDebug); debugln(' -h --help ' + rsHelpHelp); debugln(' --version ' + rsHelpVersion); // debugln(' -g --gnome3 ' + rsHelpRedHat); // must permit its use but does nothing, not needed. debugln(' --no-splash ' + rsHelpNoSplash); debugln(' --debug-sync ' + rsHelpDebugSync); debugln(' --debug-index ' + rsHelpDebugIndex); debugln(' --debug-spell ' + rsHelpDebugSpell); debugln(' --config-dir=PATH_to_DIR ' + rsHelpConfig); debugln(' -o --open-note=PATH_to_NOTE ' + rsHelpSingleNote); debugln(' --save-exit ' + rsHelpSaveExit); // debugln(' --shiftaltF-findprev ' + rsHelpShiftAltF); result := true; end; end; { Ret T if we have ONE or more command line Paramaters, not to be confused with a Option, a parameter has no '-'. Because the only parameter we expect is SingleNoteFileName, we also honour -o --open-note. More than one such parameter is an error, report to console, ret true but set SingleFileName to ''. } function HaveCMDParam() : boolean; // WARNING - the options here MUST match the options list in CommandLineError() above var Params : TStringList; LongOpts : array [1..12] of string = ('dark-theme', 'lang:', 'debug-log:', 'no-splash', 'version', 'gnome3', 'debug-spell', 'debug-sync', 'debug-index', 'config-dir:','open-note:', 'save-exit'{, 'shiftaltF-findprev'}); begin Result := False; if Application.HasOption('o', 'open-note') then begin SingleNoteName := Application.GetOptionValue('o', 'open-note'); //UseTrayMenu := False; exit(True); end; Params := TStringList.Create; try Application.GetNonOptions('hgo:', LongOpts, Params); {for I := 0 to Params.Count -1 do debugln('Extra Param ' + inttostr(I) + ' is ' + Params[I]); } if Params.Count = 1 then begin if Params[0] <> '%f' then begin // MX Linux passes the %f from desktop file during autostart SingleNoteName := Params[0]; exit(True); end; end; if Params.Count > 1 then begin CommandLineError('Unrecognised parameters on command line'); SingleNoteName := ''; exit(True); end; finally FreeAndNil(Params); end; end; function AreWeClient() : boolean; var CommsClient : TSimpleIPCClient; begin Result := False; try CommsClient := TSimpleIPCClient.Create(Nil); CommsClient.ServerID:='tomboy-ng'; if CommsClient.ServerRunning then begin CommsClient.Active := true; CommsClient.SendStringMessage('SHOWSEARCH'); CommsClient.Active := false; Result := True; end; finally freeandnil(CommsClient); end; end; function ContinueToGUI() : boolean ; begin if CommandLineError() then exit(False); if Application.HasOption('version') then begin debugln('tomboy-ng version ' + Version_String); exit(False); end; if HaveCMDParam() then if SingleNoteName = '' then exit(False) // thats an error, more than one parameter else exit(True); // proceed in SNM // Looks like a normal startup if AreWeClient() then exit(False); Result := true; end; end. tomboy-ng_0.34-1/source/tomdroid.lfm0000644000175000017500000001760514145033507017247 0ustar dbannondbannonobject FormTomdroid: TFormTomdroid Left = 605 Height = 377 Top = 267 Width = 836 Caption = 'Tomdroid' ClientHeight = 377 ClientWidth = 836 OnShow = FormShow LCLVersion = '2.1.0.0' object ButtonClose: TButton AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 716 Height = 44 Top = 333 Width = 120 Anchors = [akRight, akBottom] Caption = 'Close' ModalResult = 11 TabOrder = 0 end object Panel1: TPanel AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = ButtonClose Left = 0 Height = 330 Top = 0 Width = 836 Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Bottom = 3 Caption = 'Panel1' ClientHeight = 330 ClientWidth = 836 TabOrder = 1 object ComboBox1: TComboBox Left = 16 Height = 33 Top = 88 Width = 250 ItemHeight = 0 OnSelect = ComboBox1Select Style = csDropDownList TabOrder = 0 end object EditProfileName: TEdit Left = 16 Height = 29 Hint = 'eg MySamsungNote7' Top = 148 Width = 180 OnChange = EditProfileNameChange TabOrder = 1 Text = 'EditProfileName' end object Label1: TLabel Left = 28 Height = 21 Top = 17 Width = 452 Caption = 'Tomdroid SSH Sync - deprecated, will be dropped soon.' Font.Height = 18 ParentColor = False ParentFont = False end object Label3: TLabel Left = 16 Height = 19 Top = 128 Width = 95 Caption = 'Profile Name' ParentColor = False end object EditPassword: TEdit Left = 16 Height = 29 Top = 268 Width = 120 OnChange = EditProfileNameChange TabOrder = 3 end object EditIPAddress: TEdit Left = 16 Height = 29 Top = 208 Width = 180 OnChange = EditProfileNameChange TabOrder = 2 Text = '0.0.0.0' end object Label4: TLabel Left = 16 Height = 19 Top = 188 Width = 142 Caption = 'IP address of device' ParentColor = False end object Label5: TLabel Left = 16 Height = 19 Top = 248 Width = 176 Caption = 'SSH Password for device' ParentColor = False end object CheckSavePassword: TCheckBox Left = 144 Height = 24 Top = 268 Width = 60 Caption = 'Save' TabOrder = 4 end object Panel2: TPanel AnchorSideLeft.Control = ComboBox1 AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel1 AnchorSideRight.Control = Panel1 AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Panel1 AnchorSideBottom.Side = asrBottom Left = 286 Height = 224 Top = 89 Width = 533 Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Left = 20 BorderSpacing.Top = 88 BorderSpacing.Right = 16 BorderSpacing.Bottom = 16 Caption = 'Panel2' ClientHeight = 224 ClientWidth = 533 TabOrder = 5 object Memo1: TMemo AnchorSideLeft.Control = Splitter1 AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel2 AnchorSideRight.Control = Panel2 AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Panel2 AnchorSideBottom.Side = asrBottom Left = 251 Height = 222 Top = 1 Width = 281 Anchors = [akTop, akLeft, akRight, akBottom] Lines.Strings = ( 'Memo1' ) TabOrder = 0 end object Splitter1: TSplitter AnchorSideTop.Control = Panel2 AnchorSideBottom.Control = Panel2 AnchorSideBottom.Side = asrBottom Left = 239 Height = 222 Top = 1 Width = 12 Align = alNone Anchors = [akTop, akBottom] ResizeAnchor = akRight end object StringGridReport: TStringGrid AnchorSideLeft.Control = Panel2 AnchorSideTop.Control = Panel2 AnchorSideRight.Control = Splitter1 AnchorSideBottom.Control = Panel2 AnchorSideBottom.Side = asrBottom Left = 1 Height = 222 Top = 1 Width = 238 Anchors = [akTop, akLeft, akRight, akBottom] ColCount = 0 FixedCols = 0 FixedRows = 0 Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goThumbTracking, goSmoothScroll, goCellHints] RowCount = 0 TabOrder = 2 end end object LabelServerID: TLabel AnchorSideTop.Control = Label1 AnchorSideTop.Side = asrBottom Left = 360 Height = 19 Top = 38 Width = 100 Caption = 'LabelServerID' ParentColor = False end object CheckBoxDebugMode: TCheckBox AnchorSideLeft.Control = Label1 AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Label1 AnchorSideRight.Control = CheckBoxTestRun Left = 609 Height = 24 Hint = 'writes debug messages to terminal' Top = 17 Width = 118 Anchors = [akTop, akRight] BorderSpacing.Left = 10 Caption = 'Debug Mode' ParentShowHint = False ShowHint = True TabOrder = 6 end object CheckBoxTestRun: TCheckBox AnchorSideLeft.Control = CheckBoxDebugMode AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Label1 AnchorSideRight.Control = Panel1 AnchorSideRight.Side = asrBottom Left = 737 Height = 24 Top = 17 Width = 88 Anchors = [akTop, akRight] BorderSpacing.Left = 10 BorderSpacing.Right = 10 Caption = 'Test Run' TabOrder = 7 end object Label2: TLabel Left = 18 Height = 19 Top = 64 Width = 287 Caption = 'Select an existing profile (or enter data) ' ParentColor = False end object Label6: TLabel AnchorSideTop.Control = LabelServerID AnchorSideTop.Side = asrBottom Left = 360 Height = 19 Top = 57 Width = 354 Caption = 'Upload means from tomboy-ng to Android Device' ParentColor = False end end object ButtonSync: TButton AnchorSideRight.Control = ButtonClose AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 596 Height = 45 Top = 332 Width = 120 Anchors = [akRight, akBottom] Caption = 'Sync' OnClick = ButtonSyncClick TabOrder = 5 end object ButtonSaveProfile: TButton AnchorSideRight.Control = ButtonJoin AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 356 Height = 45 Top = 332 Width = 120 Anchors = [akRight, akBottom] Caption = 'Save Profile' OnClick = ButtonSaveProfileClick TabOrder = 2 end object ButtonHelp: TButton AnchorSideRight.Control = ButtonDelete AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 116 Height = 45 Top = 332 Width = 120 Anchors = [akRight, akBottom] Caption = 'Help' OnClick = ButtonHelpClick TabOrder = 3 end object ButtonJoin: TButton AnchorSideRight.Control = ButtonSync AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 476 Height = 45 Top = 332 Width = 120 Anchors = [akRight, akBottom] Caption = 'Join' OnClick = ButtonJoinClick TabOrder = 4 end object ButtonDelete: TButton AnchorSideRight.Control = ButtonSaveProfile AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 236 Height = 45 Top = 332 Width = 120 Anchors = [akRight, akBottom] Caption = 'Delete Profile' OnClick = ButtonDeleteClick TabOrder = 6 end end tomboy-ng_0.34-1/source/searchunit.pas0000644000175000017500000017607014145033507017602 0ustar dbannondbannonunit SearchUnit; { Copyright (C) 2017-2021 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ This form will put its icon in the System Tray and its resposible for acting on any of the menu choices from that tray icon. The form, and therefore the application, does not close if the user clicks the (typically top right) close box, just hides. It does not close until the user clicks 'close' from the System Tray Menu. It also displays the Search box showing all notes and manages the note_lister, the data structure holding info in memory of all notes. } { HISTORY 20170928 Added a function that returns true if passed string is in the current title list. 20171005 - Added an ifdef Darwin to RecentNotes() to address a OSX bug that prevented the recent file names being updated. 2017/10/10 - added a refresh button, need to make it auto but need to look at timing implication for people with very big note sets first. 2017/10/10 - added the ability to update the stringlist when a new note is created or an older one updated. So, recent notes list under TrayIcon is now updated whenever a save is made. 2017/11/07 - switched over to using NoteLister, need to remove a lot of unused code. 2017/11/28 - fixed a bug I introduced while restructuring OpenNote to better handle a note being auto saved. This bug killed the Link button in EditNote 2017/11/29 - check to see if NoteLister is still valid before passing on updates to a Note's status. If we are quiting, it may not be. 2017/12/03 Added code to clear Search box when it gets focus. Issue #9 2017/12/05 Added tests that we have a Notes Directory before opening a new note or the search box. Issue #23. 2017/12/27 Changes flowing from this no longer being the main form. 1. Setting is now main form. This is to deal with a Cocoa issue where we we cannot Hide() in the OnShow event. 2017/12/28 Ensured recent items in popup menu are marked as empty before user sets a notes dir. 2017/12/29 DeleteNote() now moves file into Backup/. 2017/12/30 Removed commented out code relting to calling Manual Sync 2018/01/01 Added a check to see if FormSync is already visible before calling ShowModal 2018/01/01 Added code to mark a previously sync'ed and now deleted note in local manifest. 2018/01/01 Set goThumbTracking true so contents of scroll box glide past as you move the "Thumb Slide". 2018/01/01 Moved call to enable/disable the sync menu item into RecentMenu(); 2018/01/25 Changes to support Notebooks 2018/01/39 Altered the Mac only function that decides when we should update the traymenu recent used list. 2018/02/04 Don't show or populate the TrayIcon for Macs. Hooked into Sett's Main Menu for Mac and now most IconTray/Main menu items are responded to in Sett. 2018/02/04 Now control MMSync when we do the Popup One. 2018/04/12 Added ability to call MarkNoteReadOnly() to cover case where user has unchanged note open while sync process downloads or deletes that note from disk. 2018/04/13 Taught MarkNoteReadOnly() to also delete ref in NoteLister to a sync deleted note 2018/05/12 Extensive changes - MainUnit is now just that. Name of this unit changed. 2018/05/20 Alterations to way we startup, wrt mainform status report. Mark 2018/06/04 NoteReadOnly() now checks if NoteLister is valid before calling. 2018/07/04 Pass back some info about how the note indexing went. 2018/08/18 Can now set search option, Case Sensitive, Any Combination from here. 2018/08/18 Update Mainform line about notes found whenever IndexNotes() is called. 2018/11/04 Added ProcessSyncUpdates to keep in memory model in line with on disk and recently used list 2018/11/25 Now uses Sync.DeleteFromLocalManifest(), called when a previously synced not is deleted, TEST ! 2018/12/29 Small improvements in time to save a file. 2019/02/01 OpenNote() now assignes a new note to the notebook if one is open (ie ButtonNotebookOptions is enabled) 2019/02/09 Move autosize stringgrid1 (back?) into UseList() 2019/02/16 Clear button now calls UseList() to ensure autosize happens. 2019/03/13 Now pass editbox the searchterm (if any) so it can move cursor to first occurance in note 2019/04/07 Restructured Main and Popup menus. Untested Win/Mac. 2019/04/13 Don't call note_lister.GetNotes more than absolutly necessary. 2019/04/15 One Clear Filters button to replace Clea and Show All Notes. Checkboxes Mode instead of menu 2019/04/16 Fixed resizing atifacts on stringGrids by turning off 'Flat' property, Linux ! 2019/08/18 Removed AnyCombo and CaseSensitive checkboxes and replaced with SearchOptionsMenu, easier translations 2019/11/19 When reshowing an open note, bring it to current workspace, Linux only. Test on Wayland ! 2019/12/11 Heavily restructured Startup, Main Menu everywhere ! 2019/12/12 Commented out #868 that goRowHighlight to stringgridnotebook, ugly black !!!!! 2019/12/19 Restored the File Menu names to the translate system. 2020/01/24 Fixed a Qt5 startup issue, don't fill in RecentItems in menu before File & Help are there. 2020/01/29 A lot of tweaks around UseList(), MMenu Recent no longer from StringGrid, ctrl updates to speed up. 2020/01/31 LoadStringGrid*() now uses the Lazarus column mode. Better ctrl of Search Term highlight (but still highlit when makeing form re-visible). Drop Create Date and Filename from Search results string grid. But I still cannot control the little green triangles in stringgrid headings indicating sort. 2020/02/01 Do not refresh the string grids automatically, turn on the refresh button for user to do it. 2020/02/19 hilight selected notebook name. 2020/03/09 Make sure 'x' (put in by a bug) is not a valid sync repo path. 2020/05/10 Faster search 2020/05/19 Replaced StringGridNotebook with a ListBox 2020/06/07 ListBoxNotebooks sorted (but not reverse sortable, that would require TListBox becoming TListView) 2020/07/09 New help notes location. 2020/07/17 OpenNote was checking edit1.test = 'search' instead of rsMenuSearch 2020/11/14 ListViewNotes now has alternating colours, req ugly fix for Qt5 involving increasing font size 2020/12/10 Move focus to Search Field whenever Search Form is re-shown, issue #211 2021/01/22 When activating a note from the search form, jump to first match if Search Term is not empty 2021/01/23 A check box to choose Auto Refresh or not. 2021/02/11 Some debugs around Ctrl-Q, to be removed and make two listboxes respond to Ctrl-N 2021/02/14 Direct all key down events via Form's OnKeyDown handler Ctrl-N and Ctrl-Q 2021/07/05 UpDateList now only refreshes menu if item on top has changed 2021/08/02 Use Template when creating new note from Template. Sigh .... And don't update notelister (and menus) if its a Notebook thats been edited. 2021/09/25 Fix bug that prevented saving first note in a dir, introduced in July. Nasty. 2021/11/03 When deleteing a notebook, remove references to it from the notes. 2021/11/04 Changes to support new Notebook management model } {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ActnList, {Grids, }ComCtrls, StdCtrls, ExtCtrls, Menus, Buttons, Note_Lister, lazLogger, ResourceStr; // These are choices for main popup menus. type TMenuTarget = (mtSep=1, mtNewNote, mtSearch, mtAbout=10, mtSync, mtTomdroid, mtSettings, mtMainHelp, mtHelp, mtQuit, mtRecent); // These are the possible kinds of main menu items type TMenuKind = (mkFileMenu, mkRecentMenu, mkHelpMenu, mkAllMenu); type { TSearchForm } TSearchForm = class(TForm) ButtonClearFilters: TButton; ButtonRefresh: TButton; CheckAutoRefresh: TCheckBox; CheckCaseSensitive: TCheckBox; Edit1: TEdit; ListBoxNotebooks: TListBox; ListViewNotes: TListView; MenuEditNotebookTemplate: TMenuItem; MenuDeleteNotebook: TMenuItem; MenuCreateNoteBook: TMenuItem; MenuItemManageNBook: TMenuItem; MenuItem3: TMenuItem; MenuRenameNoteBook: TMenuItem; MenuNewNoteFromTemplate: TMenuItem; Panel1: TPanel; Panel2: TPanel; PopupMenuNotebook: TPopupMenu; ButtonMenu: TSpeedButton; Splitter1: TSplitter; StatusBar1: TStatusBar; SelectDirectoryDialog1: TSelectDirectoryDialog; procedure ButtonMenuClick(Sender: TObject); { If a search is underway, searches. Else, if we have an active notebook filter applied, reapply it. Failing both of the above, refreshes the Notes and Notebooks with data in Note_Lister. } procedure ButtonRefreshClick(Sender: TObject); procedure ButtonClearFiltersClick(Sender: TObject); procedure CheckAutoRefreshChange(Sender: TObject); procedure CheckCaseSensitiveChange(Sender: TObject); procedure Edit1Enter(Sender: TObject); procedure Edit1Exit(Sender: TObject); procedure Edit1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); // called after OnShow. procedure FormActivate(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: boolean); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormResize(Sender: TObject); procedure FormShow(Sender: TObject); procedure ListBoxNotebooksClick(Sender: TObject); procedure ListBoxNotebooksMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ListViewNotesDblClick(Sender: TObject); procedure ListViewNotesDrawItem(Sender: TCustomListView; AItem: TListItem; ARect: TRect; AState: TOwnerDrawState); procedure ListViewNotesKeyPress(Sender: TObject; var Key: char); procedure MenuDeleteNotebookClick(Sender: TObject); procedure MenuEditNotebookTemplateClick(Sender: TObject); procedure MenuCreateNoteBookClick(Sender: TObject); procedure MenuItemManageNBookClick(Sender: TObject); procedure MenuRenameNoteBookClick(Sender: TObject); // Rather than opening an empty note we copy the template. // save it, index it and pass the filename to OpenNote( procedure MenuNewNoteFromTemplateClick(Sender: TObject); { Recieves 2 lists from Sync subsystem, one listing deleted notes ID, the other downloded note ID. Adjusts Note_Lister according and marks any note that is currently open as read only. Does not move files around. } procedure ProcessSyncUpdates(const DeletedList, DownList: TStringList); private HelpList : TStringList; NeedRefresh : boolean; HelpNotes : TNoteLister; procedure AddItemMenu(TheMenu: TPopupMenu; Item: string; mtTag: TMenuTarget; OC: TNotifyEvent; MenuKind: TMenuKind); procedure CreateMenus(); procedure DoSearch(); procedure FileMenuClicked(Sender: TObject); procedure InitialiseHelpFiles(); function MakeNoteFromTemplate(const Template: String): string; // clears then Inserts file items in all main menus, note also removes help items .... procedure MenuFileItems(AMenu: TPopupMenu); procedure MenuHelpItems(AMenu: TPopupMenu); procedure MenuListBuilder(MList: TList); procedure RecentMenuClicked(Sender: TObject); procedure Refresh(); function RemoveFromHelpList(const FullHelpNoteFileName: string): boolean; procedure RemoveNBTag(NB: string); //procedure RefreshNoteAndNotebooks(); procedure ScaleListView(); { If there is an open note from the passed filename, it will be marked read Only, will accept a GUID, Filename or FullFileName inc path } procedure MarkNoteReadOnly(const FullFileName: string); //procedure ShowListIndicator(St: string); public PopupTBMainMenu : TPopupMenu; SelectedNotebook : integer; // Position in Notebook grid use has clicked, 0 means none. //AllowClose : boolean; NoteLister : TNoteLister; NoteDirectory : string; { Tells all open notes to save their contents. Used, eg before we run a sync to ensure recently changed content is considered by the (File based) sync engine.} procedure FlushOpenNotes(); { Makes a backup note with last three char of manin name being the PutInName that tells us where it came from, ttl - title opn - just opened. Does nothing if name not UUID length. Pass it a ID, Filename or FullFileName } procedure BackupNote(const NoteName, PutIntoName: string); // Public procedure to show the help note named (without path info) procedure ShowHelpNote(HelpNoteName: string); procedure UpdateStatusBar(SyncSt : string); {Just a service provided to NoteBook.pas, refresh the list of notebooks after adding or removing one} procedure RefreshNotebooks(); // Fills in the Main TB popup menus. If AMenu is provided does an mkAllMenu on // that Menu, else applies WhichSection to all know Main TB Menus. procedure RefreshMenus(WhichSection: TMenuKind; AMenu: TPopupMenu=nil); function MoveWindowHere(WTitle: string): boolean; { Puts the names of recently used notes in the indicated menu, removes esisting ones first. } procedure MenuRecentItems(AMenu : TPopupMenu); { Call this NoteLister no longer thinks of this as a Open note } procedure NoteClosing(const ID: AnsiString); { Updates the In Memory List with passed data. Either updates existing data or inserts new } procedure UpdateList(const Title, LastChange, FullFileName: ANSIString; TheForm : TForm); { Reads header in each note in notes directory, updating Search List and the recently used list under the TrayIcon. Downside is time it takes to index. use UpdateList() if you just have updates. } function IndexNotes() : integer; { Returns true when passed string is the title of an existing note } function IsThisaTitle(const Term: ANSIString): boolean; { Gets called with a title and filename (clicking grid), with just a title (clicked a note link or recent menu item or Link Button) or nothing (new note). If its just Title but Title does not exist, its Link Button. DontBackUp says do not make a backup as we opne because we are in a Roll Back Cycle.} procedure OpenNote(NoteTitle: String; FullFileName: string = ''; TemplateIs: AnsiString = ''; BackUp: boolean = True; InSearch : boolean = false) ; { Returns True if it put next Note Title into SearchTerm } function NextNoteTitle(out SearchTerm : string) : boolean; { Initialises search of note titles, prior to calling NextNoteTitle() } procedure StartSearch(); { Deletes the actual file then removes the indicated note from the internal data about notes, updates local manifest, refreshes Grid, may get note or template } procedure DeleteNote(const FullFileName : ANSIString); const MenuEmpty = '(empty)'; end; var SearchForm: TSearchForm; implementation {$R *.lfm} //{$define LVOWNERDRAW} // Ownerdraw of ListViewNotes gives us alternating colours but all sorts of problems // I'll try a release without it and, maybe, try agin later. And maybe not. uses MainUnit, // Opening form, manages startup and Menus EditBox, settings, // Manages settings. LCLType, // For the MessageBox LazFileUtils, // LazFileUtils needed for TrimFileName(), cross platform stuff sync, // because we need it to manhandle local manifest when a file is deleted process, // Linux, we call wmctrl to move note to current workspace TomdroidFile, LCLVersion, // used to enable, or not, sort indicators in lcl2.0.8 or later NoteBook, tb_utils; { TSearchForm } { ------------- FUNCTIONS THAT PROVIDE SERVICES TO OTHER UNITS ------------ } procedure TSearchForm.ProcessSyncUpdates(const DeletedList, DownList : TStringList); // The lists arrive here with just the 36 char ID, the following functions must be OK with that ! var Index : integer; begin if NoteLister <> nil then begin for Index := 0 to DeletedList.Count -1 do begin if NoteLister.IsATemplate(DeletedList.Strings[Index]) then NoteLister.DeleteNoteBookwithID(DeletedList.Strings[Index]) else begin MarkNoteReadOnly(DeletedList.Strings[Index]); NoteLister.DeleteNote(DeletedList.Strings[Index]); end; end; for Index := 0 to DownList.Count -1 do begin MarkNoteReadOnly(DownList.Strings[Index]); if NoteLister.IsIDPresent(DownList.Strings[Index]) then begin NoteLister.DeleteNote(DownList.Strings[Index]); //debugln('We have tried to delete ' + DownList.Strings[Index]); end; NoteLister.IndexThisNote(DownList.Strings[Index]); //debugln('We have tried to reindex ' + DownList.Strings[Index]); end; RefreshMenus(mkRecentMenu); { Visible T F T F Checked T T F F Refresh Yes n n n NeedRefresh n Yes Yes Yes EnableButt n n Yes n } if Visible and CheckAutoRefresh.checked then Refresh() else begin if Visible then ButtonRefresh.Enabled := True else NeedRefresh := True; end; { if Visible then begin if CheckAutoRefresh.Checked then Refresh() else ButtonRefresh.Enabled := True end else NeedRefresh := True; } end; end; procedure TSearchForm.FlushOpenNotes(); var AForm : TForm; begin if assigned(NoteLister) then begin AForm := NoteLister.FindFirstOpenNote(); while AForm <> Nil do begin if TEditBoxForm(AForm).dirty then TEditBoxForm(AForm).SaveTheNote(); AForm := SearchForm.NoteLister.FindNextOpenNote(); end; end; end; procedure TSearchForm.NoteClosing(const ID : AnsiString); begin if NoteLister <> nil then // else we are quitting the app ! if not NoteLister.ThisNoteIsOpen(ID, nil) then // maybe its a help note ? RemoveFromHelpList(ID); end; procedure TSearchForm.StartSearch(); // Call before using NextNoteTitle() to list Titles. begin NoteLister.StartSearch(); // TitleIndex := 1; end; { Removes the indicated NoteBook tag from any note that has it } procedure TSearchForm.RemoveNBTag(NB : string); var STL : TStringList; // note: NoteLister.GetNotesInNoteBook does not need STL created or freed ! i : integer = 0; Dummy : TForm; begin if NB = '' then exit; if NoteLister.GetNotesInNoteBook(StL, NB) then while i < StL.Count do begin if NoteLister.IsThisNoteOpen(STL[i], Dummy) then continue; // don't bother to do open notes. // ToDo : test this RemoveNoteBookTag(Sett.NoteDirectory + STL[i], NB); inc(i) end; end; procedure TSearchForm.DeleteNote(const FullFileName: ANSIString); var NewName, ShortFileName : ANSIString; // LocalMan : TTomboyLocalManifest; LocalMan : TSync; begin // debugln('DeleteNote ' + FullFileName); ShortFileName := ExtractFileNameOnly(FullFileName); // an ID LocalMan := TSync.Create; LocalMan.DebugMode:=false; LocalMan.ConfigDir:= Sett.LocalConfig; LocalMan.NotesDir:= Sett.NoteDirectory; if not LocalMan.DeleteFromLocalManifest(copy(ShortFileName, 1, 36)) then showmessage('Error marking note delete in local manifest ' + LocalMan.ErrorString); LocalMan.Free; if NoteLister.IsATemplate(ShortFileName) then begin // this does not remove notebook tag from any notes that were members of this note. // if the note is Open, thats OK, it will be saved correctly on exit. RemoveNBTag(NoteLister.GetNotebookName(ShortFileName)); // remove ref to the notebook from all notes NoteLister.DeleteNoteBookwithID(ShortFileName); DeleteFileUTF8(FullFileName); ButtonClearFiltersClick(self); end else begin NoteLister.DeleteNote(ShortFileName); NewName := Sett.NoteDirectory + 'Backup' + PathDelim + ShortFileName + '.note'; if not DirectoryExists(Sett.NoteDirectory + 'Backup') then if not CreateDirUTF8(Sett.NoteDirectory + 'Backup') then DebugLn('Failed to make Backup dir, ' + Sett.NoteDirectory + 'Backup'); if not RenameFileUTF8(FullFileName, NewName) then DebugLn('Failed to move ' + FullFileName + ' to ' + NewName); end; RefreshMenus(mkRecentMenu); if Visible and CheckAutoRefresh.checked then Refresh() else begin if Visible then ButtonRefresh.Enabled := True else NeedRefresh := True; end; // if Visible then ButtonRefresh.Enabled := True // else NeedRefresh := True; end; function TSearchForm.NextNoteTitle(out SearchTerm: string): boolean; begin Result := NoteLister.NextNoteTitle(SearchTerm); end; function TSearchForm.IsThisaTitle(const Term : ANSIString) : boolean; begin Result := NoteLister.IsThisATitle(Term); end; procedure TSearchForm.RefreshNotebooks(); begin NoteLister.LoadListNotebooks(ListBoxNotebooks.Items, ButtonClearFilters.Enabled); end; procedure TSearchForm.UpdateStatusBar(SyncSt: string); begin //StatusBar1.Panels[0].Text:= SyncSt; StatusBar1.SimpleText:= SyncSt; end; procedure TSearchForm.UpdateList(const Title, LastChange, FullFileName : ANSIString; TheForm : TForm ); var // T1, T2, T3, T4 : dword; NeedUpdateMenu : boolean = False; // Updating the menu can be a bit slow. begin if NoteLister = Nil then exit; // we are quitting the app ! // We don't do any of this if the its a notebook. if NoteLister.IsATemplate(ExtractFileNameOnly(FullFileName)) then exit; // if this note is already last in list, we don't need to update menus if noteLister.Count() > 0 then NeedUpDateMenu := (Title <> NoteLister.GetTitle(noteLister.Count()-1)); // Can we find line with passed file name ? If so, apply new data. //T1 := gettickcount64(); // ToDo : do not call AlterNote if its a Notebook we have here ....... if not NoteLister.AlterNote(ExtractFileNameOnly(FullFileName), LastChange, Title) then begin NoteLister.AddNote(ExtractFileNameOnly(FullFileName)+'.note', Title, LastChange); end; //T2 := gettickcount64(); NoteLister.ThisNoteIsOpen(FullFileName, TheForm); //T3 := gettickcount64(); if NeedUpDateMenu then RefreshMenus(mkRecentMenu); // else debugln('SearchUnit.UpdateList - saved a call to RefreshMenu'); if Visible and CheckAutoRefresh.checked then Refresh() else begin if Visible then ButtonRefresh.Enabled := True else NeedRefresh := True; end; //T4 := gettickcount64(); //debugln('SearchUnit.UpdateList ' + inttostr(T2 - T1) + ' ' + inttostr(T3 - T2) + ' ' + inttostr(T4 - T3)); end; // ---------------------------------------------------------------------------- // --------------- H E L P N O T E S ------------------------------------- procedure TSearchForm.InitialiseHelpFiles(); // Todo : this uses about 300K, 3% of extra memory, better to code up a simpler model ? begin if HelpNotes <> nil then freeandnil(HelpNotes); HelpNotes := TNoteLister.Create; // freed in OnClose event. HelpNotes.DebugMode := Application.HasOption('debug-index'); // HelpNotes.WorkingDir:= MainForm.ActualHelpNotesPath; HelpNotes.WorkingDir:= Sett.HelpNotesPath + Sett.HelpNotesLang + PathDelim; HelpNotes.IndexNotes(true); end; function TSearchForm.RemoveFromHelpList(const FullHelpNoteFileName : string) : boolean; var Index : integer; begin Result := False; //debugln('Looking for help note ' + extractFileName(fullHelpNoteFileName)); if HelpList <> Nil then if HelpList.Find(extractFileName(FullHelpNoteFileName), Index) then begin //debugln('Found help note ' + extractFileName(fullHelpNoteFileName)); HelpList.Delete(Index); Result := True; end; end; procedure TSearchForm.ShowHelpNote(HelpNoteName: string); var EBox : TEditBoxForm; TheForm : TForm; Index : integer; begin if FileExists(Sett.HelpNotesPath + Sett.HelpNotesLang + PathDelim + HelpNoteName) then begin If HelpList = nil then begin HelpList := TStringList.Create; HelpList.Sorted:=True; end else begin if HelpList.Find(HelpNoteName, Index) then begin // we now try to remove entries from HelpList when a help note is closed. // This is far prettier when running under debugger, user does not care. try TheForm := TEditBoxForm(HelpList.Objects[Index]); debugln('Attempting a reshow of ' + HelpNoteName); TheForm.Show; SearchForm.MoveWindowHere(TheForm.Caption); TheForm.EnsureVisible(true); exit; except on E: Exception do {showmessage(E.Message)}; // If user had this help page open but then closed it entry is still in // list so we catch the exception, ignore it and open a new note. // its pretty ugly under debugger but user does not see this. end; end; end; // If we did not find it in the list and exit, above, we will make a new one. EBox := TEditBoxForm.Create(Application); EBox.SetReadOnly(False); EBox.SearchedTerm := ''; EBox.NoteTitle:= ''; EBox.NoteFileName := Sett.HelpNotesPath + Sett.HelpNotesLang + PathDelim + HelpNoteName; Ebox.TemplateIs := ''; EBox.Show; EBox.Dirty := False; HelpList.AddObject(HelpNoteName, EBox); EBox.Top := HelpList.Count * 10; EBox.Left := HelpList.Count * 10; EBox.Width := Screen.Width div 2; // Set sensible sizes. EBox.Height := Screen.Height div 2; end else showmessage('Unable to find ' + Sett.HelpNotesPath + Sett.HelpNotesLang + PathDelim + HelpNoteName); end; // --------------------------------------------------------------------------- // ------------- M E N U F U N C T I O N S ------------------------------- // --------------------------------------------------------------------------- { Menus are built and populated at end of CreateForm. } procedure TSearchForm.CreateMenus(); begin InitialiseHelpFiles(); PopupTBMainMenu := TPopupMenu.Create(self); // LCL will dispose because of 'self' ButtonMenu.PopupMenu := PopupTBMainMenu; MainForm.MainTBMenu := TPopupMenu.Create(self); MainForm.ButtMenu.PopupMenu := MainForm.MainTBMenu; // Add any other 'fixed' menu here. end; // Builds a list of all the Menus we have floating around at the moment. procedure TSearchForm.MenuListBuilder(MList : TList); var AForm : TForm; begin if assigned(NoteLister) then begin AForm := NoteLister.FindFirstOpenNote(); while AForm <> Nil do begin MList.Add(TEditBoxForm(AForm).PopupMainTBMenu); AForm := SearchForm.NoteLister.FindNextOpenNote(); end; end; if assigned(PopupTBMainMenu) then MList.Add(PopupTBMainMenu); if assigned(MainForm.MainTBMenu) then MList.Add(MainForm.MainTBMenu); if (MainForm.UseTrayMenu) and assigned(MainForm.PopupMenuTray) then MList.Add(MainForm.PopupMenuTray); if assigned(Sett.PMenuMain) then MList.Add(Sett.PMenuMain); end; procedure TSearchForm.RefreshMenus(WhichSection : TMenuKind; AMenu : TPopupMenu = nil); var MList : TList; I : integer; // T1, T2, T3, T4, T5, T6 : qword; begin if (WhichSection = mkRecentMenu) and (PopupTBMainMenu.Items.Count = 0) then exit; // This is a call during startup, File and Help are not there yet, messes with Qt5 //debugln('In RefreshMenus'); if AMenu <> Nil then begin MenuFileItems(AMenu); MenuHelpItems(AMenu); MenuRecentItems(AMenu); exit(); end; MList := TList.Create; MenuListBuilder(MList); //T1 := gettickcount64(); case WhichSection of mkAllMenu : for I := 0 to MList.Count - 1 do begin MenuFileItems(TPopupMenu(MList[i])); MenuHelpItems(TPopupMenu(MList[i])); MenuRecentItems(TPopupMenu(MList[i])); end; mkFileMenu : for I := 0 to MList.Count - 1 do MenuFileItems(TPopupMenu(MList[i])); mkRecentMenu : for I := 0 to MList.Count - 1 do MenuRecentItems(TPopupMenu(MList[i])); (* begin T2 := gettickcount64(); // I saw this taking longer than expected but seems fast enough now ?? MList.Count; T3:= gettickcount64(); for I := 0 to MList.Count - 1 do begin T5 := gettickcount64(); MenuRecentItems(TPopupMenu(MList[i])); // 2mS - 5mS ?? T4 := gettickcount64(); T6 := gettickcount64(); debugln('Loop timing ' + dbgs(T6 - T5)); end; debugln('SearchUnit.RefreshMenus MList.count = ' + inttostr(T3 - T2) + 'ms ' + dbgs(T4 - T3)); end; *) mkHelpMenu : for I := 0 to MList.Count - 1 do begin InitialiseHelpFiles(); MenuHelpItems(TPopupMenu(MList[i])); end; end; MList.Free; end; procedure TSearchForm.AddItemMenu(TheMenu : TPopupMenu; Item : string; mtTag : TMenuTarget; OC : TNotifyEvent; MenuKind : TMenuKind); var MenuItem : TMenuItem; procedure AddHelpItem(); var X : Integer = 0; begin while X < TheMenu.Items.Count do begin if TheMenu.Items[X].Tag = ord(mtMainHelp) then begin TheMenu.Items[X].Add(MenuItem); exit; end; inc(X); end; end; begin if Item = '-' then begin TheMenu.Items.AddSeparator; TheMenu.Items.AddSeparator; exit(); end; MenuItem := TMenuItem.Create(Self); if mtTag = mtQuit then {$ifdef DARWIN} MenuItem.ShortCut:= KeyToShortCut(VK_Q, [ssMeta]); {$else} MenuItem.ShortCut:= KeyToShortCut(VK_Q, [ssCtrl]); {$endif} MenuItem.Tag := ord(mtTag); // for 'File' entries, this identifies the function to perform. MenuItem.Caption := Item; MenuItem.OnClick := OC; case MenuKind of mkFileMenu : TheMenu.Items.Insert(0, MenuItem); mkRecentMenu : TheMenu.Items.Add(MenuItem); mkHelpMenu : AddHelpItem(); end; end; procedure TSearchForm.MenuFileItems(AMenu : TPopupMenu); var i : integer = 0; begin while i < AMenu.Items.Count do begin // Find the seperator if (AMenu.Items[i]).Caption = '-' then break; inc(i); end; dec(i); // cos we want to leave the '-' while (i >= 0) do begin // Remove File Type entries AMenu.Items.Delete(i); // Because it removes Help, removes all the individual help items too. dec(i); end; if AMenu.Items.Count = 0 then // If menu empty, put in seperator AddItemMenu(AMenu, '-', mtSep, nil, mkFileMenu); AddItemMenu(AMenu, rsMenuQuit, mtQuit, @FileMenuClicked, mkFileMenu); AddItemMenu(AMenu, rsMenuHelp, mtMainHelp, nil, mkFileMenu); {$ifdef LINUX} if Sett.CheckShowTomdroid.Checked then AddItemMenu(AMenu, 'Tomdroid', mtTomdroid, @FileMenuClicked, mkFileMenu); {$endif} AddItemMenu(AMenu, rsMenuSettings, mtSettings, @FileMenuClicked, mkFileMenu); AddItemMenu(AMenu, rsMenuSync, mtSync, @FileMenuClicked, mkFileMenu); AddItemMenu(AMenu, rsMenuAbout, mtAbout, @FileMenuClicked, mkFileMenu); AddItemMenu(AMenu, rsMenuSearch, mtSearch, @FileMenuClicked, mkFileMenu); AddItemMenu(AMenu, rsMenuNewNote, mtNewNote, @FileMenuClicked, mkFileMenu); // Note items are in reverse order because we Insert at the top. end; procedure TSearchForm.MenuRecentItems(AMenu : TPopupMenu); var i : integer = 1; j : integer; //T1, T2, T3, T4 : dword; begin //T1 := gettickcount64(); // debugln('In MenuRecentItems ' + AMenu.Name); i := AMenu.Items.Count; while i > 0 do begin // Remove any existing entries first dec(i); if TMenuItem(AMenu.Items[i]).Tag = ord(mtRecent) then AMenu.Items.Delete(i); end; //T2 := gettickcount64(); i := NoteLister.Count; j := i -10; if j < 0 then j := 0; //T3 := gettickcount64(); while i > j do begin dec(i); AddItemMenu(AMenu, NoteLister.GetTitle(i), mtRecent, @RecentMenuClicked, mkRecentMenu) end; //T4 := gettickcount64(); //debugln('TSearchForm.MenuRecentItems ' + inttostr(T2 - T1) + ' ' + inttostr(T3 - T2) + ' ' + inttostr(T4 - T3)); end; procedure TSearchForm.MenuHelpItems(AMenu : TPopupMenu); var NoteTitle : string = ''; Count : integer; begin Count := AMenu.Items.Count; while Count > 0 do begin // Remove any existing entries first dec(Count); if TMenuItem(AMenu.Items[Count]).Tag = ord(mtMainHelp) then begin AMenu.Items[Count].Clear; break; end; end; HelpNotes.StartSearch(); while HelpNotes.NextNoteTitle(NoteTitle) do AddItemMenu(AMenu, NoteTitle, mtHelp, @FileMenuClicked, mkHelpMenu); end; procedure TSearchForm.FileMenuClicked(Sender : TObject); var FileName : string; //Tick, Tock : qword; begin case TMenuTarget(TMenuItem(Sender).Tag) of mtSep, mtRecent : showmessage('Oh, that is bad, should not happen'); mtNewNote : if (Sett.NoteDirectory = '') then ShowMessage(rsSetupNotesDirFirst) else OpenNote(''); mtSearch : if Sett.NoteDirectory = '' then showmessage(rsSetupNotesDirFirst) else begin MoveWindowHere(Caption); //Tick := Gettickcount64(); EnsureVisible(true); //Tock := Gettickcount64(); Show; //debugln('SearchForm - FileMenuClicked ' + dbgs(Tock - Tick) + 'ms ' + dbgs(GetTickCount64() - Tock) + 'mS'); end; mtAbout : MainForm.ShowAbout(); mtSync : if Sett.ValidSync then Sett.Synchronise() else showmessage(rsSetupSyncFirst); mtSettings : begin MoveWindowHere(Sett.Caption); Sett.EnsureVisible(true); Sett.Show; end; {$ifdef LINUX} mtTomdroid : if FormTomdroidFile.Visible then FormTomdroidFile.BringToFront else FormTomdroidFile.ShowModal;{$endif} mtHelp : begin if HelpNotes.FileNameForTitle(TMenuItem(Sender).Caption, FileName) then {MainForm.}ShowHelpNote(FileName) else showMessage(rsCannotFindNote + TMenuItem(Sender).Caption); end; mtQuit : MainForm.close; end; end; procedure TSearchForm.RecentMenuClicked(Sender: TObject); begin if TMenuItem(Sender).Caption <> SearchForm.MenuEmpty then SearchForm.OpenNote(TMenuItem(Sender).Caption); end; procedure TSearchForm.ButtonRefreshClick(Sender: TObject); begin Refresh(); end; (* procedure TSearchForm.ShowListIndicator(St : string); // Just a debug method, disable or remove before production var SortInd0, SortInd1 : TSortIndicator; begin SortInd0 := ListViewNotes.Column[0].SortIndicator; SortInd1 := ListViewNotes.Column[1].SortIndicator; case SortInd0 of siNone : writeln(St + '--Col 0 None'); siAscending : writeln(St + '--Col 0 Ascending'); siDescending : writeln(St + '--Col 0 Descending'); end; case SortInd1 of siNone : writeln(St + '--Col 1 None'); siAscending : writeln(St + '--Col 1 Ascending'); siDescending : writeln(St + '--Col 1 Descending'); end; end; *) procedure TSearchForm.Refresh(); // This Method has issues relating to following bug reports - // https://bugs.freepascal.org/view.php?id=38394 ListView right hand side obscoured by scroll bar // https://bugs.freepascal.org/view.php?id=38393 ListView Qt5 shows wrong sort indicator var NB : string; SortInd0, SortInd1 : TSortIndicator; begin // see https://forum.lazarus.freepascal.org/index.php/topic,48568.msg350984/topicseen.html // for info about hiding the sort indicators after changing note data. We don't need to but .... // Note setup ListViewNotes in Create() and set its colours in ShowForm() //ListViewNotes.Column[1].SortIndicator := siDescending; SortInd0 := ListViewNotes.Column[0].SortIndicator; SortInd1 := ListViewNotes.Column[1].SortIndicator; if (Edit1.Text <> rsMenuSearch) and (Edit1.Text <> '') then DoSearch() else begin if (ListBoxNotebooks.ItemIndex > -1) then begin // if a notebook is currently selected. NB := ListBoxNotebooks.Items[ListBoxNotebooks.ItemIndex]; if NB <> '' then begin // NoteLister.LoadNotebookGrid(StringGrid1, NB); NoteLister.LoadNotebookViewList(ListViewNotes, NB); end; // ToDo : there is an issue here. If user has a notebook selected when sync happens, and that // sync removes a notebook, a 'Refresh' will not make the deleted notebook disappear. It // does no go until filters are cleared. end else begin NoteLister.LoadListView(ListViewNotes, False); NoteLister.LoadListNotebooks(ListBoxNotebooks.Items, ButtonClearFilters.Enabled); ScaleListView(); end; SelectedNotebook := 0; // ie off end; ButtonRefresh.Enabled := false; UpdateStatusBar(inttostr(ListViewNotes.Items.Count) + ' ' + rsNotes); ListViewNotes.Column[0].SortIndicator := SortInd0; ListViewNotes.Column[1].SortIndicator := SortInd1; if not ((SortInd0 = siNone) and (SortInd1 = siDescending)) then // default condition, comes out of NoteLister recent first ListViewNotes.Sort; //ShowListIndicator('After refresh'); end; procedure TSearchForm.DoSearch(); var TS1, {TS2, TS3,} TS4 : qword; Found : integer; begin if (Edit1.Text = '') then ButtonClearFiltersClick(self); if (Edit1.Text <> rsMenuSearch) and (Edit1.Text <> '') then begin ButtonClearFilters.Enabled := True; TS1:=gettickcount64(); Found := NoteLister.SearchNotes(Edit1.Text); // observes sett.checkCaseSensitive // TS2:=gettickcount64(); NoteLister.LoadListView(ListViewNotes, True); // ToDo : do we need to call ScaleListView here ? // TS3:=gettickcount64(); NoteLister.LoadListNotebooks(ListBoxNotebooks.Items, True); TS4:=gettickcount64(); StatusBar1.SimpleText := 'Search=' + inttostr(TS4 - TS1) + 'mS and we found ' + dbgs(Found) + ' notes'; {StatusBar1.SimpleText := 'Search=' + inttostr(TS2 - TS1) + 'mS LoadSt=' + inttostr(TS3-TS2) + 'mS LoadNB=' + inttostr(TS4 - TS3) + 'mS and we found ' + dbgs(Found) + ' notes';} end; end; procedure TSearchForm.Edit1Exit(Sender: TObject); begin if Edit1.Text = '' then begin Edit1.Hint:=rsSearchHint; Edit1.Text := rsMenuSearch; Edit1.SelStart := 1; Edit1.SelLength := length(Edit1.Text); end; end; procedure TSearchForm.Edit1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin // Must do this here to stop LCL from selecting the text on VK_RETURN if Key = VK_RETURN then begin Key := 0; DoSearch(); end; end; procedure TSearchForm.FormActivate(Sender: TObject); //var tick : qword; begin if NeedRefresh then begin //Tick := gettickcount64(); NeedRefresh := False; ButtonRefreshClick(self); //debugln('SearchForm - FormActivate (first run) ' + dbgs(GetTickCount64() - Tick) + 'mS'); end; //debugln('Search Unit Form Activate'); Edit1.SetFocus; end; procedure TSearchForm.FormCloseQuery(Sender: TObject; var CanClose: boolean); begin CanClose := False; hide(); end; function TSearchForm.IndexNotes() : integer; // var // TS1, TS2 : TTimeStamp; begin // TS1 := DateTimeToTimeStamp(Now); // if not Sett.HaveConfig then exit(0); // we assume we always have some sort of config now if NoteLister <> Nil then freeandnil(NoteLister); NoteLister := TNoteLister.Create; TheNoteLister := NoteLister; // This is how we make NoteLister accessible from other units. NoteLister.DebugMode := Application.HasOption('debug-index'); NoteLister.WorkingDir:=Sett.NoteDirectory; Result := NoteLister.IndexNotes(); UpdateStatusBar(inttostr(Result) + ' ' + rsNotes); if CheckAutoRefresh.Checked then Refresh() else NeedRefresh := True; // eg refresh ListViewNotes on next OnActivate RefreshMenus(mkRecentMenu); // TS2 := DateTimeToTimeStamp(Now); // debugln('TSearchForm.IndexNotes - Indexing took (mS) ' + inttostr(TS2.Time - TS1.Time)); // Dell, 2K notes, 134mS MainForm.UpdateNotesFound(Result); // Says how many notes found and runs over checklist. Sett.StartAutoSyncAndSnap(); end; procedure TSearchForm.FormCreate(Sender: TObject); //var Tick : qword; {$ifdef LCLQT5}{$ifdef LVOWNERDRAW} var fd: TFontData;{$endif} {$endif} begin HelpList := Nil; //Tick := GetTickCount64(); Caption := 'tomboy-ng Search'; NoteLister := nil; if (SingleNoteFileName <> '') then exit; ListViewNotes.Column[0].Caption := rsName; ListViewNotes.Column[1].Caption := rsLastChange; Edit1.Hint:=rsSearchHint; Edit1.Text := rsMenuSearch; Edit1.SelStart := 1; Edit1.SelLength := length(Edit1.Text); CreateMenus(); IndexNotes(); // This could be a slow process, maybe a new thread ? RefreshMenus(mkAllMenu); // IndexNotes->UseList has already called RefreshMenus(mkRecentMenu) and Qt5 does not like it. {$if (lcl_fullversion>2000600)} // trunk=2010000 : 2.1.0 or 2.01.00.00 2.0.6 : 2000600, note IDE greys incorrectly. ListViewNotes.AutoSortIndicator := True; // ListViewNotes.Column[1].SortIndicator := siAscending; ListViewNotes.Column[1].SortIndicator := siDescending; //debugln('Using sort indicators'); {$endif} { ListView Settings } // make extra column in Object Inspector ListViewNotes.AutoSortIndicator := True; ListViewNotes.Column[1].SortIndicator := siDescending; ListViewNotes.AutoSort:=True; ListViewNotes.SortDirection:= sdDescending; // Most recent, ie bigger date numbers, on top ListViewNotes.AutoWidthLastColumn:= True; ListViewNotes.ViewStyle:= vsReport; ListViewNotes.ReadOnly := True; {$ifdef LVOWNERDRAW} ListViewNotes.OwnerDraw:= True; {$ifdef LCLQT5} // This because when ownerdrawn, we loose spacing between rows in Qt5, ugly workaround. fd := GetFontData( SearchForm.Font.Handle ); ListViewNotes.Font.Height := round((fd.Height * 72 / SearchForm.Font.PixelsPerInch)) + 4; {$endif} {$endif} end; procedure TSearchForm.FormShow(Sender: TObject); begin // if MainForm.closeASAP or (MainForm.SingleNoteFileName <> '') then exit; Left := Placement + random(Placement*2); Top := Placement + random(Placement * 2); CheckCaseSensitive.checked := Sett.SearchCaseSensitive; // {$ifdef windows} // linux apps know how to do this themselves if Sett.DarkTheme then begin // Note - Windows won't let us change button colour anymore. ListBoxNotebooks.Color := Sett.BackGndColour; ListBoxNoteBooks.Font.Color := Sett.TextColour; Edit1.Color := Sett.BackGndColour; Edit1.Font.Color := Sett.TextColour; // color := Sett.HiColour; Color := Sett.BackGndColour; font.color := Sett.TextColour; ListViewNotes.Color := clnavy; // ListViewNotes.Font.Color := Sett.HiColour; ListViewNotes.Font.Color := Sett.BackGndColour; splitter1.Color:= clnavy; end; CheckAutoRefresh.Checked := Sett.AutoRefresh; ListViewNotes.Color := ListBoxNoteBooks.Color; ListViewNotes.Font.Color := ListBoxNotebooks.Font.Color; // {$endif} ListBoxNotebooks.Hint := rsNotebookOptionRight; {$ifdef DARWIN} ButtonMenu.Refresh; ListBoxNotebooks.Hint := rsNotebookOptionCtrl; {$endif} // Cocoa issue Edit1.SetFocus; end; procedure TSearchForm.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin (* if {$ifdef DARWIN}ssMeta{$else}ssCtrl{$endif} in Shift then if key = VK_Q then debugln('TSearchForm.FormKeyDown - Detected Ctrl IN Shift - Q, ignoring'); *) if [{$ifdef DARWIN}ssMeta{$else}ssCtrl{$endif}] = Shift then begin if key = ord('N') then begin OpenNote(''); Key := 0; exit(); end; if key = VK_Q then begin // debugln('TSearchForm.FormKeyDown - Quitting because of a Ctrl-Q'); MainForm.Close(); end; end; end; procedure TSearchForm.FormResize(Sender: TObject); begin ScaleListView(); end; procedure TSearchForm.FormDestroy(Sender: TObject); begin NoteLister.Free; NoteLister := Nil; HelpNotes.Free; HelpNotes := Nil; freeandnil(HelpList); end; procedure TSearchForm.CheckCaseSensitiveChange(Sender: TObject); begin Sett.SearchCaseSensitive:= CheckCaseSensitive.Checked; // Sett.CheckCaseSensitive.Checked := CheckCaseSensitive.Checked; end; procedure TSearchForm.Edit1Enter(Sender: TObject); // ToDo : this should select the word, 'Search' if user clicks in field but does not ?? begin if Edit1.Text = rsMenuSearch then begin //Edit1.SelStart:=0; //Edit1.SelLength:= length(rsMenuSearch); Edit1.SelectAll; end; end; procedure TSearchForm.MarkNoteReadOnly(const FullFileName: string); var TheForm : TForm; begin if NoteLister = nil then exit; if NoteLister.IsThisNoteOpen(FullFileName, TheForm) then begin // if user opened and then closed, we won't know we cannot access try TEditBoxForm(TheForm).SetReadOnly(); exit(); except on EAccessViolation do DebugLn('Tried to mark a closed note as readOnly, that is OK'); end; end; end; function TSearchForm.MoveWindowHere(WTitle: string): boolean; {$ifdef LINUX} var AProcess: TProcess; List : TStringList = nil; {$endif} begin Result := False; {$IFDEF LINUX} // ToDo : Apparently, Windows now has something like Workspaces, implement ..... //debugln('In MoveWindowHere with ', WTitle); AProcess := TProcess.Create(nil); AProcess.Executable:= 'wmctrl'; AProcess.Parameters.Add('-R' + WTitle); AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes]; try AProcess.Execute; Result := (AProcess.ExitStatus = 0); // says at least one packet got back except on E: EProcess do debugln('Is wmctrl available ? Cannot move ' + WTitle); end; List := TStringList.Create; List.LoadFromStream(AProcess.Output); // just to clear it away. //debugln('Process List ' + List.Text); List.Free; AProcess.Free; {$endif} end; procedure TSearchForm.OpenNote(NoteTitle: String; FullFileName: string; TemplateIs: AnsiString; BackUp: boolean; InSearch: boolean); // Everything except the first parameter is optional, take care ! // Might be called with no Title (NewNote) or a Title with or without a Filename // When called from EditBox, we may pass a Notebook Name, if its a new note that // notebook will be associated with the new note. Otherwise, ANY request for a new // note while a notebook is selected in SeachForm will assign the notebook to note. // If we choose NewNoteFromTemplate TemplateIs is NOT set because we create the note // and pass its filename into here. It already has its templale associated. var EBox : TEditBoxForm; NoteFileName : string; TheForm : TForm; begin NoteFileName := FullFileName; if (NoteTitle <> '') then begin if FullFileName = '' then Begin if NoteLister.FileNameForTitle(NoteTitle, NoteFileName) then NoteFileName := Sett.NoteDirectory + NoteFileName else NoteFileName := ''; end else NoteFileName := FullFileName; // if we have a Title and a Filename, it might be open aleady if NoteLister.IsThisNoteOpen(NoteFileName, TheForm) then begin // Note is already open // if user opened and then closed, we won't know we cannot re-show try TheForm.Show; MoveWindowHere(TheForm.Caption); TheForm.EnsureVisible(true); if (NoteFileName <> '') and (NoteTitle <> '') and (InSearch) then TEditBoxForm(TheForm).NewFind(Edit1.Text); exit(); except on EAccessViolation do DebugLn('Tried to re show a closed note, that is OK'); end; // We catch the exception and proceed .... but it should never happen. end; end; // if to here, we need open a new window. If Filename blank, its a new note // If we already have a template (ie notebook) then ignore the SearchForm notebook selection if (TemplateIs = '') and (NoteFileName = '') and (NoteTitle ='') and (ListBoxNotebooks.ItemIndex > -1) then // a new note with notebook selected. TemplateIs := ListBoxNotebooks.Items[ListBoxNotebooks.ItemIndex]; EBox := TEditBoxForm.Create(Application); EBox.SearchedTerm := ''; EBox.NoteTitle:= NoteTitle; EBox.NoteFileName := NoteFileName; Ebox.TemplateIs := TemplateIs; EBox.Show; // if we have a NoteFileName at this stage, we just opened an existing note. if (NoteFileName <> '') and (NoteTitle <> '') and (InSearch) then EBox.NewFind(Edit1.Text); if (NoteFileName <> '') and BackUp then BackupNote(NoteFileName, 'opn'); EBox.Dirty := False; NoteLister.ThisNoteIsOpen(NoteFileName, EBox); end; // ----------------------------- ListView Things ------------------------------- { ListView Settings - Are set in CreateForm. AutoSort, AutoSortIndicator, AutoWidthLastColumn all true Make two columns, name them, leave autwith off, ReadOnly, RowSelect true ScrollBars ssAutoVertical, ViewStyle vsReport. Note that AutoSortIndicator and SortIndicator are not available in LCL2.0.6 and earlier So, don't set them in the form, leave at default settings and set them in a } {if lcl > 2.0.6} { structure. Note, the IDE gets this wrong and greys lines out it should not. } procedure TSearchForm.ListViewNotesDblClick(Sender: TObject); var NoteTitle : ANSIstring; FullFileName : string; begin if ListViewNotes.Selected = nil then exit; // White space below notes .... NoteTitle := ListViewNotes.Selected.Caption; FullFileName := Sett.NoteDirectory + ListViewNotes.Selected.SubItems[1]; if not FileExistsUTF8(FullFileName) then begin showmessage('Cannot open ' + FullFileName); exit(); end; if length(NoteTitle) > 0 then OpenNote(NoteTitle, FullFileName, '', True, ((Edit1.Text <> '') and (Edit1.Text <> rsMenuSearch) and Visible)); end; procedure TSearchForm.ListViewNotesDrawItem(Sender: TCustomListView; AItem: TListItem; ARect: TRect; AState: TOwnerDrawState); begin // Note this only works for TListView if ViewStyle is vsReport // (and obviously, we are in ownerdraw mode). {$ifdef LVOWNERDRAW} if Odd(AItem.Index) then ListViewNotes.Canvas.Brush.Color := Sett.AltColour; ListViewNotes.Canvas.FillRect(ARect); {$ifdef LCLQT5} // Note we have increased the font height for Qt5 in OnCreate() ListViewNotes.Canvas.TextRect(ARect, 2, ARect.Top, AItem.Caption); // Title column ListViewNotes.Canvas.TextRect(ARect, ListViewNotes.Column[0].Width + 2 // LCD Column , ARect.Top, AItem.SubItems[0]); {$else} ListViewNotes.Canvas.TextRect(ARect, 2, ARect.Top+2, AItem.Caption); // Title column ListViewNotes.Canvas.TextRect(ARect, ListViewNotes.Column[0].Width + 2 // LCD Column , ARect.Top+2, AItem.SubItems[0]); {$endif} {$endif} end; procedure TSearchForm.ListViewNotesKeyPress(Sender: TObject; var Key: char); begin if Key = char(ord(VK_RETURN)) then ListViewNotesDblClick(Sender); end; procedure TSearchForm.ScaleListView(); var Col1Width : integer; begin {$ifdef LCLQT5} Col1width := listviewnotes.Canvas.Font.GetTextWidth('2020-06-02 12:30:00000'); // 00 allow for apparent error in scroll with {$else} Col1width := listviewnotes.Canvas.Font.GetTextWidth('2020-06-02 12:30:000'); {$endif} ListViewNotes.Column[1].Width := Col1width; if ListViewNotes.ClientWidth > 100 then ListViewNotes.Column[0].Width := ListViewNotes.ClientWidth - Col1width; end; procedure TSearchForm.BackupNote(const NoteName, PutIntoName : string); var NewName : string; OldName : string; begin NewName := ExtractFileNameOnly(NoteName); OldName := Sett.NoteDirectory + NewName + '.note'; if not FileExistsUTF8(OldName) then exit; // Its a new, as yet unsave note if length(NewName) <> 36 then exit; // We only do notes with UUID names // We remove last four char from ID and replace with eg, -opn or -ttl. This has // some loss of entropy, acceptable and allows use of existing Backup recovery. NewName := Sett.NoteDirectory + 'Backup' + PathDelim + copy(NewName, 1, 32) + '-' + PutIntoName + '.note'; // We assume here that Sett unit has checked and created a Backup dir is necessary. if FileExistsUTF8(NewName) then if not DeleteFile(NewName) then debugln('ERROR, failed to delete ' + NewName); {debugln('File exists = ' + booltostr(, True)); debugln('Dir exits = ' + booltostr(DirectoryExists(Sett.NoteDirectory + 'Backup'), True)); } if not CopyFile(OldName, NewName) then debugln('ERROR, failed to copy : ' + #10 + OldName + #10 + NewName); //debugln('SearchForm : BackupNote ' + #10 + OldName + #10 + NewName); end; { ----------------- NOTEBOOK STUFF -------------------- } // This button clears both search term (if any) and restores all notebooks and // displays all available notes. procedure TSearchForm.ButtonClearFiltersClick(Sender: TObject); begin ButtonClearFilters.Enabled := False; ListBoxNotebooks.ItemIndex := -1; Edit1.Hint:=rsSearchHint; Edit1.Text := rsMenuSearch; ButtonRefreshClick(self); Edit1.SetFocus; Edit1.SelStart := 0; Edit1.SelLength := length(Edit1.Text); UpdateStatusBar(''); end; procedure TSearchForm.CheckAutoRefreshChange(Sender: TObject); begin Sett.AutoRefresh := CheckAutoRefresh.Checked; end; procedure TSearchForm.ListBoxNotebooksClick(Sender: TObject); begin ButtonClearFilters.Enabled := True; ButtonRefreshClick(self); SelectedNoteBook := ListBoxNotebooks.ItemIndex; // Events here if there is a term search is progress are ignored because ButtonRefreshClick acts on // search terms first. //ListBoxNotebooks.Hint := 'Options for ?'; //StringGridNotebooks.Hint := 'Options for ' + StringGridNotebooks.Cells[0, StringGridNotebooks.Row]; end; // Popup a menu when rightclick a notebook procedure TSearchForm.ListBoxNotebooksMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var HaveItem : boolean; begin // debugln('TSearchForm.ListBoxNotebooksMouseDown - Selected in listboxnotebook ' + dbgs(ListBoxNotebooks.ItemIndex)); if {$ifdef DARWIN} (ssCtrl in Shift) {$ELSE} (Button = mbRight) {$ENDIF} then begin HaveItem := (ListBoxNotebooks.ItemIndex > -1); PopupMenuNotebook.Items[0].Enabled := HaveItem; PopupMenuNotebook.Items[1].Enabled := HaveItem; PopupMenuNotebook.Items[2].Enabled := HaveItem; PopupMenuNotebook.Items[3].Enabled := HaveItem; PopupMenuNotebook.Items[4].Enabled := HaveItem; PopupMenuNotebook.Popup; end; end; procedure TSearchForm.ButtonMenuClick(Sender: TObject); begin //ShowListIndicator('From Menu'); PopupTBMainMenu.popup; end; procedure TSearchForm.MenuEditNotebookTemplateClick(Sender: TObject); var NotebookID : ANSIString; begin NotebookID := NoteLister.NotebookTemplateID(ListBoxNotebooks.Items[ListBoxNotebooks.ItemIndex]); if NotebookID = '' then //showmessage('Error, cannot open template for ' + StringGridNotebooks.Cells[0, StringGridNotebooks.Row]) showmessage('Error, cannot open template for ' + ListBoxNotebooks.Items[ListBoxNoteBooks.ItemIndex]) else OpenNote(ListBoxNotebooks.Items[ListBoxNoteBooks.ItemIndex] + ' Template', Sett.NoteDirectory + NotebookID); end; procedure TSearchForm.MenuCreateNoteBookClick(Sender: TObject); var NotebookPick : TNotebookPick; NewNoteBookName : string = ''; i : integer = 0; begin NotebookPick := TNotebookPick.Create(Application); NotebookPick.TheMode := nbMakeNewNoteBook; NotebookPick.FullFileName := ''; NotebookPick.Title := ''; NotebookPick.ChangeMode := False; NotebookPick.Top := Top; NotebookPick.Left := Left; if mrOK = NotebookPick.ShowModal then NewNotebookName := NotebookPick.NBName; NotebookPick.Free; ButtonClearFilters.Click; if NewNoteBookName <> '' then begin while i < ListBoxNoteBooks.Count do begin if ListBoxNoteBooks.Items[i] = NewNoteBookName then break else inc(i); end; if i < ListBoxNoteBooks.Count then begin ListBoxNoteBooks.ItemIndex := i; ListBoxNoteBooks.click; end else debugln('TSearchForm.MenuCreateNoteBookClick - failed to find the new NotebookName'); end; end; procedure TSearchForm.MenuItemManageNBookClick(Sender: TObject); var NotebookPick : TNotebookPick; begin NotebookPick := TNotebookPick.Create(Application); NotebookPick.TheMode := nbSetNotesInNoteBook; NotebookPick.FullFileName := ''; NotebookPick.Title := ''; NotebookPick.NBName := ListBoxNotebooks.Items[ListBoxNoteBooks.ItemIndex]; NotebookPick.ChangeMode := False; NotebookPick.Top := Top; NotebookPick.Left := Left; // if mrOK = NotebookPick.ShowModal then MarkDirty(); NotebookPick.ShowModal; NotebookPick.Free; ListBoxNotebooksClick(Sender); // ButtonClearFilters.Click; // ToDo : this should select the new Notebook if one made end; procedure TSearchForm.MenuRenameNoteBookClick(Sender: TObject); var NotebookPick : TNotebookPick; begin NotebookPick := TNotebookPick.Create(Application); NotebookPick.TheMode := nbChangeName; try NotebookPick.Title := ListBoxNotebooks.Items[ListBoxNoteBooks.ItemIndex]; NotebookPick.ChangeMode := True; NotebookPick.Top := Top; NotebookPick.Left := Left; if mrOK = NotebookPick.ShowModal then ButtonClearFilters.Click; finally NotebookPick.Free; end; end; procedure TSearchForm.MenuDeleteNotebookClick(Sender: TObject); begin if IDYES = Application.MessageBox('Delete this Notebook', PChar(ListBoxNotebooks.Items[ListBoxNoteBooks.ItemIndex]), MB_ICONQUESTION + MB_YESNO) then DeleteNote(Sett.NoteDirectory + NoteLister.NotebookTemplateID(ListBoxNotebooks.Items[ListBoxNoteBooks.ItemIndex])); end; procedure TSearchForm.MenuNewNoteFromTemplateClick(Sender: TObject); begin OpenNote( MakeNoteFromTemplate(Sett.NoteDirectory + NoteLister.NotebookTemplateID(ListBoxNotebooks.Items[ListBoxNoteBooks.ItemIndex])), '', ''); end; // Copy Template to a new name removing the system:template and setting a Title function TSearchForm.MakeNoteFromTemplate(const Template : String) : string; var InFile, OutFile: TextFile; InString : String; //Start, Finish : integer; GUID : TGUID; RandBit, NewGUID : string; begin Result := ''; CreateGUID(GUID); NewGUID := copy(GUIDToString(GUID), 2, 36); RandBit := copy(NewGUID, 1, 4); // To add to template name initially AssignFile(InFile, Template); AssignFile(OutFile, Sett.NoteDirectory + NewGUID + '.note'); try try Reset(InFile); Rewrite(OutFile); while not eof(InFile) do begin readln(InFile, InString); if (Pos('system:template', InString) > 0) then // skip line continue; if (Pos('', InString) > 0) then InString := InString.Replace('Template', RandBit, [rfReplaceAll]); // Now, this might be the same line as above. <note-content version="0.3"> // but it might be 0.1 or 0.2 even. Possible (in gnote) that this line // also contains note content, bad if it has the word 'Template' .... if (Pos('<note-content version="', InString) > 0) then InString := InString.Replace('Template', RandBit, [rfReplaceAll]); writeln(OutFile, InString); end; finally CloseFile(OutFile); CloseFile(InFile); end; NoteLister.IndexThisNote(NewGUID); result := GetTitleFromFFN(Sett.NoteDirectory + NewGUID + '.note', false); ButtonRefresh.Enabled := true; except on E: EInOutError do begin debugln('File handling error occurred making new note from template. Details: ' + E.Message); exit(''); end; end; end; end. ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������tomboy-ng_0.34-1/source/hunspell.pas����������������������������������������������������������������0000644�0001750�0001750�00000026453�14145033507�017266� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������{$MODE objfpc}{$H+} unit hunspell; { Copyright (C) 2017-2020 David Bannon. License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html Note this unit 'includes' hunspell.inc that has a different license, please see that file for details. A Unit to connect to the hunspell library and check some spelling. First, create the class, it will try and find a library to load. Check ErrorMessage. Then call SetDictionary(), with a full filename of the dictionary to use. If GoodToGo is true, you can call Spell() and Suggests() otherwise, look in ErrorString for what went wrong. Look in FindLibrary() for default locations of Library. 2018/10/31 Changed to TLibHandle to accomadate Mac 64bit 2018/11/01 Added /usr/local/Cellar/hunspell/1.6.2/lib/ as place to look for hunspell library on Mac. Need to make that more flexible. 2018/11/29 Better debug messages 2020/11/13 Moved newly generated hunspell bindings out to a inc file. } interface uses Classes, dynlibs; { The Hunspell bindings are 'included' from another file to keep license issues managable and to comply with Debian requirements. } {$INCLUDE hunspell.inc} { THunspell } THunspell = class private Speller: Pointer; { Loads indicated library, returns False and sets ErrorMessage if something wrong } function LoadHunspellLibrary(LibraryName: AnsiString): Boolean; public { set to True if speller is ready to accept requests } GoodToGo : boolean; { empty if OK, contains an error message if something goes wrong } ErrorMessage : ANSIString; { Will have a full name to library if correctly loaded at create } LibraryFullName : string; { if set t, typically by caller, prints a lot of whats happening } DebugMode : boolean; { Will have a "first guess" as to where dictionaries are, poke another name in and call FindDictionary() if default did not work } constructor Create(const Debug : boolean; const FullLibName : ANSIString = ''); destructor Destroy; override; { Returns True if word spelt correctly } function Spell(Word: string): boolean; { Returns with List full of suggestions how to spell Word } procedure Suggest(Word: string; List: TStrings); { untested } procedure Add(Word: string); { untested } procedure Remove(Word: string); { returns a full library name or '' if it cannot find anything suitable } function FindLibrary(out FullName : AnsiString) : boolean; { returns true if it successfully set the indicated dictionary } function SetDictionary(const FullDictName: string) : boolean; function SetNewLibrary(const LibName : string) : boolean; end; var Hunspell_create: THunspell_create; var Hunspell_destroy: THunspell_destroy; var Hunspell_spell: Thunspell_spell; var Hunspell_suggest: Thunspell_suggest; var Hunspell_analyze: Thunspell_analyze; var Hunspell_stem: Thunspell_stem; var Hunspell_get_dic_encoding: Thunspell_get_dic_encoding; var Hunspell_add: THunspell_add; var Hunspell_free_list: THunspell_free_list; var Hunspell_remove: THunspell_remove; var HunLibLoaded: Boolean = False; var HunLibHandle: {THandle;} TLibHandle; // 64bit requires use of TLibHandle // see https://forum.lazarus.freepascal.org/index.php/topic,34352.msg225157.html implementation uses LazUTF8, SysUtils, {$ifdef linux}Process,{$endif} // Because we go looking for the library. {$ifdef WINDOWS}Forms,{$endif} // Forms needed so we can call Application.~ on Windows LazFileUtils, // Requires we add LCLBase to dependencies lazlogger; // lazlogger for the debug lines. { THunspell } function THunspell.LoadHunspellLibrary(libraryName: Ansistring): Boolean; begin Result := false; HunLibHandle := LoadLibrary(PAnsiChar(libraryName)); if HunLibHandle = NilHandle then begin if Debugmode then debugln('Failed to load library ' + libraryName); ErrorMessage := 'Failed to load library ' + libraryName; end else begin Result := True; Hunspell_create := THunspell_create(GetProcAddress(HunLibHandle, 'Hunspell_create')); if not Assigned(Hunspell_create) then Result := False; Hunspell_destroy := Thunspell_destroy(GetProcAddress(HunLibHandle, 'Hunspell_destroy')); if not Assigned(Hunspell_destroy) then Result := False; Hunspell_spell := THunspell_spell(GetProcAddress(HunLibHandle, 'Hunspell_spell')); if not Assigned(Hunspell_spell) then Result := False; Hunspell_suggest := THunspell_suggest(GetProcAddress(HunLibHandle, 'Hunspell_suggest')); if not Assigned(Hunspell_suggest) then Result := False; Hunspell_analyze := THunspell_analyze(GetProcAddress(HunLibHandle, 'Hunspell_analyze')); // not used here if not Assigned(Hunspell_analyze) then Result := False; Hunspell_stem := THunspell_stem(GetProcAddress(HunLibHandle, 'Hunspell_stem')); // not used here if not Assigned(Hunspell_stem) then Result := False; Hunspell_get_dic_encoding := THunspell_get_dic_encoding(GetProcAddress(HunLibHandle, 'Hunspell_get_dic_encoding')); // not used here if not Assigned(Hunspell_get_dic_encoding) then Result := False; Hunspell_free_list := THunspell_free_list(GetProcAddress(HunLibHandle, 'Hunspell_free_list')); if not Assigned(Hunspell_free_list) then Result := False; Hunspell_add := THunspell_add(GetProcAddress(HunLibHandle, 'Hunspell_add')); if not Assigned(Hunspell_add) then Result := False; Hunspell_remove := THunspell_remove(GetProcAddress(HunLibHandle, 'Hunspell_remove')); if not Assigned(Hunspell_remove) then Result := False; HunLibLoaded := Result; end; if ErrorMessage = '' then if not Result then begin ErrorMessage := 'Failed to find functions in ' + LibraryName; if debugmode then debugln('Hunspell Failed to find functions in ' + LibraryName); end; if Result and debugmode then debugln('Loaded library OK ' + LibraryName); end; constructor THunspell.Create(const Debug : boolean; const FullLibName : ANSIString = ''); begin DebugMode := Debug; ErrorMessage := ''; LibraryFullName := FullLibName; if LibraryFullName = '' then if Not FindLibrary(LibraryFullName) then begin if debugmode then debugln('Cannot find Hunspell library'); ErrorMessage := 'Cannot find Hunspell library'; exit(); end; //if debugmode then debugln('Creating Hunspell with library = ' + LibraryFullName); LoadHunspellLibrary(LibraryFullName); // will flag any errors it finds Speller := nil; // we are not GoodToGo yet, need a dictionary .... end; destructor THunspell.Destroy; begin //if DebugMode then debugln('About to destroy Hunspell'); if (HunLibHandle <> 0) and HunLibLoaded then begin if Speller<>nil then hunspell_destroy(Speller); Speller:=nil; if HunLibHandle <> 0 then FreeLibrary(HunLibHandle); HunLibLoaded := false; end; inherited Destroy; end; function THunspell.Spell(Word: string): boolean; begin Result := hunspell_spell(Speller, PChar(Word)) end; procedure THunspell.Suggest(Word: string; List: TStrings); var i, len: Integer; SugList, Words: PPChar; //Blar : AnsiString; begin List.clear; try len := hunspell_suggest(Speller, SugList, PChar(Word)); Words := SugList; for i := 1 to len do begin List.Add(Words^); //Blar := Words^; Inc(PtrInt(Words), sizeOf(Pointer)); end; finally Hunspell_free_list(Speller, SugList, len); end; end; procedure THunspell.Add(Word: string); begin Hunspell_add(Speller, Pchar(Word)); end; procedure THunspell.Remove(Word: string); begin Hunspell_remove(Speller, Pchar(Word)); end; function THunspell.FindLibrary(out FullName : ANSIString):boolean; var {$ifdef LINUX} I : integer = 1; {$endif} {$ifndef LINUX} Info : TSearchRec; Mask : ANSIString; {$endif} begin Result := False; {$IFDEF LINUX} // Assumes ldconfig always returns same format, better than searching several dirs if RunCommand('/bin/bash',['-c','ldconfig -p | grep hunspell'], FullName) then begin while UTF8Pos(' ', FullName, I) <> 0 do inc(I); if I=1 then exit(); UTF8Delete(FullName, 1, I-1); UTF8Delete(FullName, UTF8Pos(#10, FullName, 1), 1); Result := True; end else if RunCommand('/bin/bash',['-c','/sbin/ldconfig -p | grep hunspell'], FullName) then begin while UTF8Pos(' ', FullName, I) <> 0 do inc(I); if I=1 then exit(); UTF8Delete(FullName, 1, I-1); UTF8Delete(FullName, UTF8Pos(#10, FullName, 1), 1); Result := True; end; {$ENDIF} {$ifdef DARWIN} Mask := 'libhunspell*'; FullName := '/usr/local/Cellar/hunspell/1.6.2/lib/'; // /usr/local/Cellar/hunspell/1.6.2/lib/libhunspell-1.6.0.dylib if FindFirst(FullName + Mask, faAnyFile and faDirectory, Info)=0 then begin FullName := FullName + Info.name; Result := True; end; if not result then begin FullName := '/usr/lib/'; if FindFirst(FullName + Mask, faAnyFile and faDirectory, Info)=0 then begin FullName := FullName + Info.name; Result := True; end; end; FindClose(Info); {$endif} {$ifdef WINDOWS} // Now, only Windows left. Look for a dll in application home dir. Mask := '*hunspell*.dll'; FullName := ExtractFilePath(Application.ExeName); if FindFirst(FullName + Mask, faAnyFile and faDirectory, Info)=0 then begin FullName := FullName + Info.name; Result := True; end; FindClose(Info); {$endif} if Result then begin if DebugMode then debugln('FindLibrary looks promising [', FullName, ']'); end else if DebugMode then debugln('FindLibrary Failed to find a Hunspell Library', FullName, ']'); end; function THunspell.SetDictionary(const FullDictName: string) : boolean; var FullAff : string; begin if debugmode then debugln('about to try to set dictionary'); Result := False; if not FileExistsUTF8(FullDictName) then exit(); FullAff := FullDictName; UTF8Delete(FullAff, UTF8Length(FullAff) - 2, 3); FullAff := FullAff + 'aff'; if not FileExistsutf8(FullAFF) then exit(); try if assigned(Speller) then begin hunspell_destroy(Speller); if debugmode then debugln('Speller destroyed'); end; Speller := hunspell_create(PChar(FullAff), PChar(FullDictName)); // Create does not test the dictionaries ! except on E: Exception do debugln('Hunspell ' + E.Message); else debugln('Hunspell has lost it !'); end; Result := false; GoodToGo := assigned(Speller); if not GoodToGo then ErrorMessage := 'Failed to set Dictionary ' + FullDictName; Result := GoodToGo; end; function THunspell.SetNewLibrary(const LibName: string): boolean; begin LibraryFullName := LibName; Result := LoadHunspellLibrary(LibraryFullName); end; end. ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������tomboy-ng_0.34-1/source/import_notes.pas������������������������������������������������������������0000644�0001750�0001750�00000047547�14145033507�020165� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������unit import_notes; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ } { Will import either plain text or markdown converting content to note. Set DestinationDir, Mode (plaintext, markdown) and optionally FirstLineIsTitle (other wise, file name will beome title). Then pass a List of full file names, that is, including a path and extension, to convert. Things that must be done - 1. Notebook, a string that optionally contains the name of a notebook that will be assigned to each imported note. This will involve looking to see if there is already a notebook of this name, if not creating necessary files. Does not make sense if destination dir is not either Tomboy or tomboy-ng. 2. On completion, send tomboy-ng a hup if its running so it knows to refresh. HISTORY : 2021/08/19 Rewrite much of md import. More use of St.Replace() model. 2021/09/06 Support notebook lists 2021/09/25 Allow [] meaning an empty list of notebooks. 2021/09/25 Fixed an "beyond the end of a line" issue in PosMDTag(), only show up on build machine ??? 2021/09/28 Enable multilevel bullets 2021/10/01 Allow for the fact that a JSON Notebook string may have " or \ escaped. 2021/10/17 Remove four spaces from left of mono line. 2021/10/18 Inline MD Tags now support Flanking rules, https://spec.commonmark.org/0.30/#left-flanking-delimiter-run 2021/10/18 For some reason I was removing embedded underline xml, now I restore it ?? } {$mode objfpc}{$H+} interface uses Classes, SysUtils; type { TImportNotes } TImportNotes = class private function ChangeTag(var St: string; const ChangeFrom, ChangeToLead, ChangeToTrail: string): boolean; procedure ConvertList(var St: string); procedure DoLineHeadings(const STL: TStringList); { Ret True if it finds a matching pair of tags that obay the Flanking rules. If so, sets the out vars to start of each tag. Else rets false. Call until it does ret false. https://spec.commonmark.org/0.30/#left-flanking-delimiter-run } function FindMDTags(const St, Tag: string; out LeftFlank, RightFlank: integer ): boolean; function ImportFile(FullFileName: string) : boolean; function MarkUpMarkDown(Cont: TStringList) : boolean; // Gets passed a List with note content, puts an appropriate // header and footer on. function ProcessPlain(Cont: TStringList; const Title: string; LCD : string = ''; CDate: string = ''): boolean; public ErrorMsg : string; // '' if everything OK, content means something bad happened DestinationDir : string; // Required, dir to save notes to Mode : string; // ie plaintext, markdown .... ImportNames : TStringList; // A list of full file names to import, default is filename will become title FirstLineIsTitle : boolean; // if true, first line of note becomes title KeepFileName : boolean; // The note will have same base name as import. NoteBook : string; // Empty is OK, plain text notebook name or JSON array (including []) function Execute(): integer; // you know all you need, go do it. // Alt action for this Unit, converts a StringList that contains // markdown to a Note, no file i/o happens, note is returned in // the same stringlist. If LCD, CDate are '' then defaults are used. function MDtoNote(Content: TStringList; const LCD, CDate: string): boolean; constructor Create; destructor Destroy; override; end; implementation { TImportNotes } uses LazFileUtils, LazUTF8, LCLProc, TB_utils; function TImportNotes.ProcessPlain(Cont: TStringList; const Title: string; LCD: string; CDate : string): boolean; var Start : integer = 1; NBName : string = ''; //DateSt : string; // eg '2020-05-19T18:58:37.9513193+10:00'; // Finds Notebook names on the JSON Notebook string. Even allows for Escaped " and \ // returns string value or empty string if no more available function NextNBName() : string; var InValue : boolean = False; InEsc : boolean = False; //i, Index : integer; begin Result := ''; inc(Start); while Start < length(Notebook)-1 do begin //for i := Start+1 to length(Notebook)-1 do begin case Notebook[Start] of '"' : if InValue and not InEsc then // Ah, thats the end of a value. exit else if not InEsc then begin InValue := True; inc(Start); continue; end; // if we are inEsc, let it go through to keeper. '\' : if not InEsc then begin InEsc := True; // Must be first. inc(Start); continue; end; end; // In every case, if we are InEsc, we allow the use of the char InEsc := False; if InValue then Result := Result + NoteBook[Start]; inc(Start); end; end; begin if LCD = '' then LCD := TB_GetLocalTime(); if CDate = '' then CDate := TB_GetLocalTime(); //LCDateSt := TB_GetLocalTime(); Cont.Insert(0, ' <text xml:space="preserve"><note-content version="0.1">' + Title); Cont.Insert(0, ' <title>' + Title + ''); Cont.Insert(0, ''); Cont.Insert(0, ''); Cont.Add(' '); Cont.Add(' ' + LCD + ''); Cont.Add(' ' + LCD + ''); Cont.Add(' ' + CDate + ''); Cont.Add(' 1'); Cont.Add(' 1000'); Cont.Add(' 626'); Cont.Add(' 20'); Cont.Add(' 30'); Cont.Add(' '); // notebook may contain just the name of a notebook, My NoteBook or a json array, eg // [] or ["template","Man Pages"] or ["Man Pages"] or ["Man Pages", "Other Notebook"] // But Notebook names may have backslash or double inverted commas, escaped with backslash if (Notebook <> '') and (Notebook <> '[]') then begin if (NoteBook[1] = '[') then begin // its a JSON array NBName := NextNBName; // Uses the regional, 'Start' to keep track while NBName <> '' do begin if NBName = 'template' then Cont.Add(' system:template:' + '') else Cont.Add(' system:notebook:' + RemoveBadXMLCharacters(NBName) + ''); NBName := NextNBName; end; end else // if not an array, just use it as it is, one notebook if NoteBook <> '' then Cont.Add(' system:notebook:' + RemoveBadXMLCharacters(NoteBook) + ''); end; Cont.Add(' '); Cont.Add(' False'); Cont.Add(''); result := True; end; { Markdown Rules A line starting with a asterik and a space is a bullet. Or some whitespace first might be a multilevel bullet. Bold text is wrapped in ** at either end. Or __ (that is two underscores) at either end. Italics is wrapped in * at either end. Again, the underscore at either end will work as well. Highlight is wrapped in ~~ at either end, Stikeout is supported with ~~ at either end. a line starting with ###space is a bold, large line a line starting with ##space is a bold, huge line A line that is followed by some ===== or ------ are headings, huge and Large we ignore #space, have other ways of finding title. A line starting with four or more spaces is all monospace, remove exactly four spaces and add tags. In line text that is wrapped in backticks is in line mono, remove ticks and add tags. All the inline tags follow Flanking rules, eg LeftFlank must have something immediatly to the right. } // Iterates over list looking for a line that is either "------" or "======" and if // it finds one, removes that line and makes line ABOVE a header. // Setext - one or more = or - with up to three leading spaces and any number of training whitespace // Sigh .... procedure TImportNotes.DoLineHeadings(const STL : TStringList); var i : integer = 1; // Line 0 is the heading // Ret true if passed line is a SeText line, https://spec.commonmark.org/ function IsSeText(const St : string; Se : char) : boolean; var j : integer = 1; SeCount : integer = 0; begin Result := false; while j <= St.length do begin if St[j] = Se then begin inc(SeCount); inc(j); continue; end; // If its not a Se, nor whitespace, cannot be a heading. if (not (St[j] in [ ' ', #10, #13])) then exit(false); // only allowed 3 spaces at left if (J > 3) and (SeCount = 0) then exit(false); inc(j); end; result := SeCount > 0; end; // Will remove current line and make previous line a Heading. procedure MakeHeading(IsHuge : boolean); var St : string; begin StL.Delete(i); if i > 1 then begin St := StL[i-1]; if IsHuge then St := '' + St + '' else St := '' + St + ''; StL.Delete(i-1); StL.Insert(i-1, St); end; end; begin while I < STL.Count do begin // Must be while, we will alter count as we go if IsSeText(Stl[i], '=') then MakeHeading(True) else if IsSeText(Stl[i], '-') then MakeHeading(False) else inc(i); end; end; // ToDo : the flanking rules are grossly incomplete. We must ignore intermediate tags and test for real content. // ToDo : when we decide its a pair of MD Tags, we should ensure there are no unmatched xml tags between. function TImportNotes.FindMDTags(const St, Tag : string; out LeftFlank, RightFlank : integer) : boolean; begin LeftFlank := pos(Tag, St, 1); if LeftFlank = 0 then exit(False); while true do begin // OK, is it really a LeftFlank ? These tests must be improved significently ! if (St.Length < (LeftFlank + 1 + (2*Tag.Length))) // no room for content and trailing tag or (St[LeftFlank+Tag.Length] = ' ') then begin // not left flanking, need check better than this !! LeftFlank := pos(Tag, St, LeftFlank+1); if LeftFlank = 0 then exit(False); continue; end; break; end; // OK, we do have a LeftFlank, should look at any xml tags we step over here but for now, lets find a RightFlank RightFlank := pos(Tag, St, LeftFlank + Tag.Length); if (RightFlank = 0) then exit(False); while true do begin if (St[RightFlank -1] = ' ') then begin RightFlank := pos(Tag, St, RightFlank + Tag.Length); if (RightFlank = 0) then exit(False); continue; end; exit(True); end; result := False; end; (* function TImportNotes.FindMDTags(const St, Tag : string; out LeftFlank, RightFlank : integer) : boolean; begin LeftFlank := pos(Tag, St, 1); if LeftFlank = 0 then exit(False); while LeftFlank > 0 do begin // OK, is it really a LeftFlank ? These tests must be improved significently ! if (St.Length < (LeftFlank + 1 + (2*Tag.Length))) // no room for content and trailing tag or (St[LeftFlank+Tag.Length] = ' ') then begin // not left flanking, need check better than this !! LeftFlank := pos(Tag, St, LeftFlank+1); continue; end; // OK, we do have a LeftFlank, should test for matched tags here but for now, lets find a RightFlank RightFlank := pos(Tag, St, LeftFlank + Tag.Length); if (RightFlank = 0) then exit(False); // no point in looking further. if (St[RightFlank -1] = ' ') then begin RightFlank := pos(Tag, St, RightFlank + Tag.Length); continue; end; exit(True); end; result := False; end; *) function TImportNotes.ChangeTag(var St : string; const ChangeFrom, ChangeToLead, ChangeToTrail : string) : boolean; var LFlank, RFlank : integer; begin Result := False; if FindMDTags(St, ChangeFrom, LFlank, RFlank) then begin delete(St, RFlank, ChangeFrom.Length); insert(ChangeToTrail, St, RFlank); delete(St, LFlank, ChangeFrom.Length); insert(ChangeToLead, St, LFlank); result := True; end; end; { For our purpose, here, a level one list line starts with an * followed by a space. For every three spaces before the * its one level deeper. While MD lets you use other characters, its only a * here folks. } procedure TImportNotes.ConvertList(var St : string); var Spaces : integer = 1; // How many leading spaces. I : integer; xmltags : string = ''; begin while Spaces <= st.length do begin if St[Spaces] <> ' ' then break; inc(Spaces); end; // here, number of spaces is Spaces-1; We are here because either not (Spaces <= St.Length) or St[Spaces] <> ' '. if (Spaces > st.length) or (St[Spaces] <> '*') then exit; // either not a * or no room for one. // If to here, we know its a (0-n spaces)*, if its a space next, definitly list item. inc(Spaces); if (Spaces > st.length) or (St[Spaces] <> ' ') then exit; dec(Spaces, 2); //debugln('TImportNotes.ConvertList Spaces=' + inttostr(Spaces) + ' and St=' + St); // So, remove Spaces spaces, the * and one more space. delete(St, 1, Spaces+2); Spaces := Spaces div 3; // 0 div 3 = 0 for i := 0 to Spaces do xmltags := xmltags + ''; St := xmltags + St; xmltags := ''; for i := 0 to Spaces do // When Spaces = 0, we must add one set of tags. xmltags := xmltags + ''; St := St + xmltags; //debugln('TImportNotes.ConvertList St=' + St); end; // huge heading function TImportNotes.MarkUpMarkDown(Cont : TStringList) : boolean; var Index : integer = 0; St : string; DropNewLine : boolean = True; begin Result := True; while Index < Cont.Count do begin St := Cont.Strings[Index]; if (St = '') then begin if DropNewLine then begin Cont.Delete(Index); DropNewLine := False; continue; end else DropNewLine := True; end else DropNewLine := True; // DebugLn('Start [' + St + ']'); if copy(St, 1, 4) = '### ' then begin delete(St, 1, 4); St := '' + St + '' end else if copy(St, 1, 3) = '## ' then begin delete(St, 1, 3); St := '' + St + '' end else ConvertList(St); (* end else if copy(St, 1, 2) = '* ' then begin delete(St, 1, 2); //Line one St := '' + St + ''; end; *) St := St.Replace('<sub>', '', [rfReplaceAll]); St := St.Replace('</sub>', '', [rfReplaceAll]); St := St.Replace('<underline>', '', [rfReplaceAll]); St := St.Replace('</underline>', '', [rfReplaceAll]); St := St.Replace('<highlight>', '', [rfReplaceAll]); St := St.Replace('</highlight>', '', [rfReplaceAll]); // DebugLn('Middle [' + St + ']'); while ChangeTag(St, '***', '', '') do; while ChangeTag(St, '**', '', '') do; while ChangeTag(St, '__', '', '') do; while ChangeTag(St, '*', '', '') do; while ChangeTag(St, '_', '', '') do; while ChangeTag(St, '`', '', '') do; while ChangeTag(St, '~~', '', '') do; if copy(St, 1, 4) = ' ' then begin // Ah, thats leading space mono St := St.Remove(0, 4); if length(St) > 0 then St := '' + St + ''; end; // DebugLn('Finish [' + St + ']'); Cont.Strings[Index] := St; inc(Index); end; DoLineHeadings(Cont); end; function TImportNotes.ImportFile(FullFileName: string): boolean; var Content : TStringList; GUID : TGUID; NewFileName : string; Title : string; Index : integer = 0; begin Result := True; if FileExists(FullFileName) then begin try Content := TStringList.Create; Content.LoadFromFile(FullFileName); while Index < Content.Count do begin Content.Strings[Index] := RemoveBadXMLCharacters(Content.Strings[Index]); inc(Index); end; if Mode = 'markdown' then MarkUpMarkDown(Content); if FirstLineIsTitle then begin Title := Content.Strings[0]; Content.Delete(0); end else Title := ExtractFileNameOnly(FullFileName); if copy(Title, 1, 2) = '# ' then delete(Title, 1, 2); if copy(Title, 1, 2) = '## ' then delete(Title, 1, 3); if copy(Title, 1, 2) = '### ' then delete(Title, 1, 4); ProcessPlain(Content, Title); CreateGUID(GUID); if KeepFileName then NewFileName := ExtractFileNameOnly(FullFileName) + '.note' else NewFileName := copy(GUIDToString(GUID), 2, 36) + '.note'; Content.SaveToFile(AppendPathDelim(DestinationDir) + NewFileName); finally freeandnil(Content); end; end else begin ErrorMsg := 'Failed to open import file' + #10 + FullFileName; Result := False; end; end; function TImportNotes.Execute(): integer; var St : string; begin Result := 0; if ImportNames = nil then exit; for St in ImportNames do begin if not ImportFile(St) then exit; inc(Result); end; end; function TImportNotes.MDtoNote(Content: TStringList; const LCD, CDate: string): boolean; var Title : string; Index : integer = 0; begin Result := True; while Index < Content.Count do begin Content.Strings[Index] := RemoveBadXMLCharacters(Content.Strings[Index]); inc(Index); end; MarkUpMarkDown(Content); Title := Content.Strings[0]; Title := Title.Replace('', ''); Title := Title.Replace('', ''); Content.Delete(0); Title.Replace('#', '', [rfReplaceAll]); ProcessPlain(Content, Title, LCD, CDate); end; constructor TImportNotes.Create; begin end; destructor TImportNotes.Destroy; begin inherited Destroy; end; end. tomboy-ng_0.34-1/source/tomdroid.pas0000644000175000017500000004274514145033507017257 0ustar dbannondbannonunit tomdroid; {$mode objfpc}{$H+} { HISTORY 2018/12/06 Added AdjustNoteList() to call ProcessSyncUpdates at end of a sync 2018/04/28 Ensure user does not save profile after a Test run, the ID will change. 2019/05/14 Display strings all (?) moved to resourcestrings 2020/07/09 New help notes location. 2021/01/05 This unit is on it's way out. Its now a child of TomdroidFile and will be marked Legacy Remove from v0.33 or v0.34 depending on user reactions ..... } interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls, StdCtrls, ExtCtrls, Grids, LCLIntf, SyncUtils; // For TClashRec type { TFormTomdroid } TFormTomdroid = class(TForm) ButtonClose: TButton; ButtonJoin: TButton; ButtonDelete: TButton; ButtonSaveProfile: TButton; ButtonHelp: TButton; ButtonSync: TButton; CheckBoxTestRun: TCheckBox; CheckBoxDebugMode: TCheckBox; CheckSavePassword: TCheckBox; ComboBox1: TComboBox; EditProfileName: TEdit; EditPassword: TEdit; EditIPAddress: TEdit; Label1: TLabel; Label2: TLabel; Label6: TLabel; LabelServerID: TLabel; Label3: TLabel; Label4: TLabel; Label5: TLabel; Memo1: TMemo; Panel1: TPanel; Panel2: TPanel; Splitter1: TSplitter; StringGridReport: TStringGrid; procedure ButtonDeleteClick(Sender: TObject); procedure ButtonHelpClick(Sender: TObject); procedure ButtonJoinClick(Sender: TObject); procedure ButtonSaveProfileClick(Sender: TObject); procedure ButtonSyncClick(Sender: TObject); procedure ComboBox1Select(Sender: TObject); procedure EditProfileNameChange(Sender: TObject); procedure FormShow(Sender: TObject); private ProfileName, IPAddress, Password : string; // Keep copies to see if user changed after selection procedure AdjustNoteList(); procedure ClearFields(); procedure DisplaySync(); procedure DoNewSync(); procedure EnableButtons(const Enable: boolean); procedure LoadProfile(Profile: string); function NeedToSave(): boolean; function Proceed(const ClashRec: TClashRecord): TSyncAction; function ReadConfig(): boolean; function SaveCurrentProfile(const JustDelete : boolean = false): boolean; procedure ShowReport(); function DoSync(): boolean; public end; var FormTomdroid: TFormTomdroid; implementation {$R *.lfm} { TFormTomdroid } uses Settings, IniFiles, Sync, TB_SDiff, typInfo, LazLogger, LCLType, SearchUnit, // we call ProcessSyncUpdates( and ShowHelpNote( tb_utils; var ASync : TSync; function TFormTomdroid.ReadConfig() : boolean; var ConfigFile : TINIFile; begin if not FileExists(Sett.LocalConfig + 'android' + pathdelim + 'tomdroid.cfg') then begin // showmessage('did not find ' + Sett.LocalConfig + 'android' + pathdelim + 'tomdroid.cfg'); exit(False); end; ConfigFile := TINIFile.Create(Sett.LocalConfig + 'android' + pathdelim + 'tomdroid.cfg'); ConfigFile.ReadSections(ComboBox1.Items); FreeandNil(ConfigFile); Result := True; end; function TFormTomdroid.SaveCurrentProfile(const JustDelete : boolean = false) : boolean; var ConfigFile : TINIFile; Profile : string; begin Profile := EditProfileName.Text; ConfigFile := TINIFile.Create(Sett.LocalConfig + 'android' + pathdelim + 'tomdroid.cfg'); if ConfigFile.SectionExists(Profile) then ConfigFile.EraseSection(Profile); if JustDelete then exit(True); ConfigFile.WriteString(Profile, 'IP', EditIPAddress.Text); if CheckSavePassword.Checked then begin ConfigFile.WriteString(Profile, 'Password', EditPassword.Text); ConfigFile.WriteString(Profile, 'SavePassword', 'true'); end; ConfigFile.WriteString(Profile, 'ServerID', LabelServerID.Caption); freeandnil(ConfigFile); Result := True; end; procedure TFormTomdroid.FormShow(Sender: TObject); begin //debugln('Tomdroid screen OnShow event'); left := (screen.Width div 2) - (width div 2); top := (screen.Height div 2) - (height div 2); Memo1.Clear; StringGridReport.Clear; ClearFields(); ReadConfig; ButtonSaveProfile.Enabled := False; ButtonDelete.Enabled := False; ButtonSync.Enabled := False; ButtonJoin.Enabled := False; end; procedure TFormTomdroid.ButtonSaveProfileClick(Sender: TObject); begin SaveCurrentProfile(); ButtonSaveProfile.Enabled := False; ReadConfig(); end; procedure TFormTomdroid.ButtonHelpClick(Sender: TObject); begin //MainUnit.MainForm.ShowHelpNote('tomdroid.note'); // change the bloody name ! Er, why ? SearchForm.ShowHelpNote('tomdroid.note'); end; procedure TFormTomdroid.ButtonDeleteClick(Sender: TObject); begin SaveCurrentProfile(True); ReadConfig(); ClearFields(); Memo1.Clear; StringGridReport.clear; end; procedure TFormTomdroid.LoadProfile(Profile : string); var ConfigFile : TINIFile; begin ConfigFile := TINIFile.Create(Sett.LocalConfig + 'android' + pathdelim + 'tomdroid.cfg'); if ConfigFile.SectionExists(Profile) then begin EditProfileName.Text := Profile; ProfileName := Profile; EditIPAddress.Text := ConfigFile.readstring(Profile, 'IP', 'Oh, an Error occurred'); IPAddress := EditIPAddress.Text; EditPassword.Text := ConfigFile.readstring(Profile, 'Password', ''); Password := EditPassword.Text; CheckSavePassword.Checked := ('true' = ConfigFile.readstring(Profile, 'SavePassword', '')); LabelServerID.Caption := ConfigFile.readstring(Profile, 'ServerID', 'ERROR - profile has no server ID'); ButtonSync.Enabled := IDLooksOK(LabelServerID.Caption); end else showmessage('WTF ? Cannot find profile in config ' + Profile); freeandnil(ConfigFile); ButtonSaveProfile.Enabled := False; ButtonJoin.Enabled := False; ButtonDelete.Enabled := True; end; procedure TFormTomdroid.ComboBox1Select(Sender: TObject); begin LoadProfile(combobox1.items[combobox1.ItemIndex]); end; // Responds to changes to any of the three EditBoxes procedure TFormTomdroid.EditProfileNameChange(Sender: TObject); begin if (EditProfileName.Text <> '') and (EditIPAddress.Name <> '') and (EditPassword.Text <> '') then begin ButtonJoin.Enabled := True; ButtonDelete.Enabled := False; // A Join is OK if we have no existing config, a Sync is definitly not if FileExists(Sett.LocalConfig + 'android' + pathdelim + 'tomdroid.cfg') then ButtonSync.Enabled := True; end; end; { --------------- S C R E E N F U N C T I O N S ---------------------------} RESOURCESTRING rsSelectProfile = 'Select a profile'; procedure TFormTomdroid.ClearFields(); begin ComboBox1.Text := rsSelectProfile; EditProfileName.Text := ''; EditIPAddress.Text := ''; EditPassword.Text := ''; CheckSavePassword.Checked := false; CheckBoxTestRun.Checked := false; LabelServerID.Caption := ''; end; procedure TFormTomdroid.EnableButtons(const Enable : boolean); begin ButtonClose.Enabled := Enable; // ButtonSaveProfile.Enabled := Enable; ButtonDelete.Enabled := Enable; ButtonSync.Enabled := Enable; ButtonHelp.Enabled := Enable; ButtonJoin.Enabled:= Enable; end; { --------------- S Y N C R E L A T E D F U N C T I O N S ----------------} procedure TFormTomdroid.ButtonSyncClick(Sender: TObject); begin ButtonClose.Enabled := False; // Todo - prevent a sync proceeding if its a new name in the edit box, that is, does not match the config file. // Compare the profile in config file with one in edit boxes, any change, fail !! DoSync(); ButtonClose.Enabled := True; end; RESOURCESTRING rsSetUpNewSync ='Setting up a new sync ....'; rsFailedToConnect = 'Failed to connect.'; rsTalkingToDevice = 'OK, talking to device. Wait for it ....'; rsNoTomdroid = 'Unable to find Tomdroid sync dir on that device.'; rsInstallTomdroid = 'Install Tomdroid, config filesync, and run a sync'; rsNoConnection = 'Failed to establish a connection. '; rsFixConnection = 'If you are sure its there, check settings.'; rsConnectionGood = 'Connection is looking Good.'; procedure TFormTomdroid.DoNewSync(); var Tick1, Tick2, Tick3, Tick4 : QWord; begin Memo1.clear; StringGridReport.Clear; EnableButtons(False); Memo1.append(rsSetUpNewSync); Application.ProcessMessages; try ASync := TSync.Create(); ASync.DebugMode:=CheckBoxDebugMode.Checked; ASync.TestRun := CheckBoxTestRun.Checked; ASync.ProceedFunction:=@Proceed; ASync.NotesDir:= Sett.NoteDirectory; ASync.ConfigDir := Sett.LocalConfig; ASync.SyncAddress := EditIPAddress.Text; // ASync.LocalServerID := LabelServerID.Caption; // Only do this for Tomdroid Use! ASync.RepoAction:= RepoJoin; ASync.Password:= EditPassword.Text; Tick1 := GetTickCount64(); if SyncNetworkError = Async.SetTransport(SyncAndroid) then begin memo1.append(rsFailedToConnect + ' ' + ASync.ErrorString); exit(); end; Memo1.Append(rsTalkingToDevice); Application.ProcessMessages; Tick2 := GetTickCount64(); case ASync.TestConnection() of SyncNoRemoteDir : begin Memo1.append(rsNoTomdroid ); Memo1.append(rsInstallTomdroid); Memo1.Append(ASync.Errorstring); exit(); end; SyncNetworkError : begin Memo1.Append(rsNoConnection + ' ' + ASync.ErrorString); memo1.append(rsFixConnection); exit(); end; SyncReady : ; else begin showmessage(ASync.ErrorString); exit(); end; end; // If to here, sync should be enabled and know about remote files it might need. Memo1.append(rsConnectionGood); Memo1.append(rsNextBitSlow); Application.ProcessMessages; Tick3 := GetTickCount64(); ASync.StartSync(); LabelServerID.Caption := ASync.LocalServerID; Tick4 := GetTickCount64(); DisplaySync(); memo1.Append('Set=' + inttostr(Tick2 - Tick1) + 'mS Test=' + inttostr(Tick3 - Tick2) + 'mS Sync=' + inttostr(Tick4 - Tick3) + 'mS '); ShowReport(); AdjustNoteList(); finally ASync.Free; EnableButtons(True); end; if not CheckBoxTestRun.Checked then // don't write a config if its only a test run. ButtonSaveProfile.Enabled := NeedToSave(); end; procedure TFormTomdroid.AdjustNoteList(); var DeletedList, DownList : TStringList; Index : integer; begin DeletedList := TStringList.Create; DownList := TStringList.Create; with ASync.RemoteMetaData do begin for Index := 0 to Count -1 do begin if Items[Index]^.Action = SyDeleteLocal then DeletedList.Add(Items[Index]^.ID); if Items[Index]^.Action = SyDownload then DownList.Add(Items[Index]^.ID); end; end; if (DeletedList.Count > 0) or (DownList.Count > 0) then SearchForm.ProcessSyncUpdates(DeletedList, DownList); FreeandNil(DeletedList); FreeandNil(DownList); end; procedure TFormTomdroid.ButtonJoinClick(Sender: TObject); begin if ProfileName <> '' then begin if (ProfileName = EditProfileName.Text) then if IDYES <> Application.MessageBox(pchar(rsChangeExistingSync), pchar(rsNotRecommend), MB_ICONQUESTION + MB_YESNO) then exit; end; EnableButtons(False); DoNewSync(); ButtonSaveProfile.Enabled := True; // NeedToSave(); ButtonDelete.Enabled := True; ButtonSync.Enabled := True; end; // Following resourcestrings defined in syncUtils.pas procedure TFormTomdroid.DisplaySync(); var UpNew, UpEdit, Down, DelLoc, DelRem, Clash, DoNothing, Errors : integer; begin ASync.ReportMetaData(UpNew, UpEdit, Down, DelLoc, DelRem, Clash, DoNothing, Errors); Memo1.Append(rsNewUploads + inttostr(UpNew)); Memo1.Append(rsEditUploads + inttostr(UpEdit)); Memo1.Append(rsDownloads + inttostr(Down)); Memo1.Append(rsLocalDeletes + inttostr(DelLoc)); Memo1.Append(rsRemoteDeletes + inttostr(DelRem)); Memo1.Append(rsClashes + inttostr(Clash)); Memo1.Append(rsDoNothing + inttostr(DoNothing)); end; procedure TFormTomdroid.ShowReport(); var Index : integer; Rows : integer = 0; begin StringGridReport.Clean; with ASync.RemoteMetaData do begin for Index := 0 to Count -1 do begin if Items[Index]^.Action <> SyNothing then begin StringGridReport.InsertRowWithValues(Rows , [ASync.RemoteMetaData.ActionName(Items[Index]^.Action) , Items[Index]^.Title, Items[Index]^.ID]); inc(Rows); end; end end; StringGridReport.AutoSizeColumn(0); StringGridReport.AutoSizeColumn(1); if Rows = 0 then Memo1.Append(rsNoNotesNeededSync); Memo1.Append(inttostr(ASync.RemoteMetaData.Count) + rsNotesWereDealt); end; function TFormTomdroid.NeedToSave() : boolean; begin Result := (ProfileName <> EditProfileName.Text) or (IPAddress <> EditIPAddress.Text) or (Password <> EditPassword.Text); end; RESOURCESTRING rsCheckingForExistingSync = 'Checking for an existing sync ....'; // rsTalkingToDevice = 'OK, talking to device. Wait for it ....'; rsNotExistingRepo = 'That''s not an existing Repo, maybe click "Join" ?'; rsNotCorrectProfile = 'This is not correct profile for that device'; rsFailedToFindConnection_1 = 'Failed to find an existing connection.'; rsFailedToFindConnection_2 = 'If you are sure there should be an existing connection, check settings.'; rsFailedToFindConnection_3 = 'Otherwise, try joining a new connection.'; rsHaveValidSync = 'Looking Good. Last sync date '; function TFormTomdroid.DoSync() : boolean; var Tick1, Tick2, Tick3, Tick4 : DWord; begin Memo1.clear; StringGridReport.Clear; EnableButtons(False); Memo1.append(rsCheckingForExistingSync); Application.ProcessMessages; try ASync := TSync.Create(); ASync.DebugMode:=CheckBoxDebugMode.Checked; ASync.TestRun := CheckBoxTestRun.Checked; ASync.ProceedFunction:=@Proceed; ASync.NotesDir:= Sett.NoteDirectory; ASync.ConfigDir := Sett.LocalConfig; ASync.SyncAddress := EditIPAddress.Text; ASync.LocalServerID := LabelServerID.Caption; // Only do this for Tomdroid ! ASync.RepoAction:= RepoUse; ASync.Password:= EditPassword.Text; Tick1 := GetTickCount64(); if SyncNetworkError = Async.SetTransport(SyncAndroid) then begin // this just pings remote dev memo1.append(rsFailedToConnect + ASync.ErrorString); exit(false); end; Memo1.Append(rsTalkingToDevice); Application.ProcessMessages; Tick2 := GetTickCount64(); case ASync.TestConnection() of // SyncXMLError, SyncNoRemoteWrite, SyncNoRemoteDir : SyncNoLocal : begin Memo1.Append(ASync.ErrorString); Memo1.Append('Sync is cancelled'); exit(False); end; // That may be caused by a previous failure to complete a Join or New, look for bad notes perhaps ? SyncNoRemoteRepo : begin Memo1.Append(rsNotExistingRepo); exit(False); end; SyncMisMatch : begin Memo1.Append(rsNotCorrectProfile); exit(False); end; SyncNetworkError : begin Memo1.Append(rsFailedToFindConnection_1 + ASync.ErrorString); memo1.append(rsFailedToFindConnection_2); memo1.append(rsFailedToFindConnection_3); exit(false); end; SyncReady : ; else begin showmessage(ASync.ErrorString); exit(False); end; end; // If to here, sync should be enabled and know about remote files it might need. Memo1.append(rsHaveValidSync + ASync.LocalLastSyncDateSt); Memo1.append(rsNextBitSlow); Application.ProcessMessages; Tick3 := GetTickCount64(); ASync.StartSync(); Tick4 := GetTickCount64(); DisplaySync(); memo1.Append('Set=' + inttostr(Tick2 - Tick1) + 'mS Test=' + inttostr(Tick3 - Tick2) + 'mS Sync=' + inttostr(Tick4 - Tick3) + 'mS '); ShowReport(); AdjustNoteList(); finally ASync.Free; EnableButtons(True); end; ButtonSaveProfile.Enabled := NeedToSave(); result := True; end; function TFormTomdroid.Proceed(const ClashRec : TClashRecord) : TSyncAction; var SDiff : TFormSDiff; Res : integer; begin result := SyDownload; SDiff := TFormSDiff.Create(self); SDiff.RemoteFilename := ClashRec.ServerFileName; SDiff.LocalFilename := ClashRec.LocalFileName; Res := SDiff.ShowModal; case Res of mrYes : Result := SyDownLoad; mrNo : Result := SyUpLoadEdit; mrNoToAll : Result := SyAllLocal; mrYesToAll : Result := SyAllRemote; mrAll : Result := SyAllNewest; mrClose : Result := SyAllOldest; end; SDiff.Free; Application.ProcessMessages; // so dialog goes away while remainder are being processed. end; end. tomboy-ng_0.34-1/source/backupview.pas0000644000175000017500000002136714145033507017573 0ustar dbannondbannonunit BackupView; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ A unit to manage the Backup capability of tomboy-ng. It allows viewing, deleting or restoring a backed up note. Note, in Tomboy speak, Backup means backup of deleted or overwritten by sync process. History 2018/07/03 Finished the recver a backup note code 2018/08/14 Update the last-metadata-change-date instead of last-change-date when restoring a Backup file. See Sync spec. 2018/08/16 We now update both last-metadata-change-date AND last-change-date when restoring a backup file. 2018/08/27 Now change the ID of a deleted (but not overwritten) Note to avoid Sync issues 2019/05/19 Display strings all (?) moved to resourcestrings 2020/05/11 Restructure to do the backup note display and fiddling here. 2020/07/25 Tweak layout and select first note if there is one shown in the list. } {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, Note_Lister, ResourceStr; type { TFormBackupView } TFormBackupView = class(TForm) ButtonOpen: TButton; ButtonRecover: TButton; ButtonDelete: TButton; ButtonOK: TButton; ListBox1: TListBox; Memo1: TMemo; Panel1: TPanel; procedure ButtonDeleteClick(Sender: TObject); procedure ButtonOpenClick(Sender: TObject); procedure ButtonRecoverClick(Sender: TObject); procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormShow(Sender: TObject); procedure ListBox1SelectionChange(Sender: TObject; User: boolean); private BUNoteLister : TNoteLister; //ExistsInRepo : boolean; //NeedUpDate : boolean; function RefreshBackup(): integer; procedure UpdateDetails(ID: string); public //FileName : string; //NoteTitle : string; //NotesChanged : boolean; end; var FormBackupView: TFormBackupView; implementation {$R *.lfm} { TFormBackupView } uses settings, LazFileUtils, LCLType, MainUnit, // For SingleNoteMode() tb_utils, SearchUnit; // access the notelister object procedure TFormBackupView.FormCreate(Sender: TObject); begin ButtonOpen.Enabled := False; ButtonRecover.Enabled := False; ButtonDelete.Enabled := False; BUNoteLister := nil; end; procedure TFormBackupView.FormDestroy(Sender: TObject); begin BUNoteLister.Free; end; procedure TFormBackupView.FormShow(Sender: TObject); begin if RefreshBackup() = 0 then Memo1.Append('We found no backup notes') else ListBox1.ItemIndex:=0; end; function TFormBackupView.RefreshBackup() : integer; begin ListBox1.Clear; Memo1.Clear; if BUNoteLister <> nil then BUNoteLister.free; BUNoteLister := TNoteLister.Create; BUNoteLister.WorkingDir:= sett.NoteDirectory + 'Backup' + PathDelim; BUNoteLister.IndexNotes(); BUNoteLister.LoadStrings(ListBox1.Items); result := BUNoteLister.Count(); end; procedure TFormBackUpView.UpdateDetails(ID : string); begin Memo1.Clear; Memo1.Append('Title :'); Memo1.Append(BUNoteLister.GetTitle(ID)); Memo1.Append('Filename :'); Memo1.Append(ID); Memo1.Append('Last change ' + BUNoteLister.GetLastChangeDate(ID)); if FileExistsUTF8(Sett.NoteDirectory + ID) then begin Memo1.Append(rsNewerVersionExits); //ExistsInRepo := True; end else Memo1.Append(rsNotPresent); Memo1.Append(inttostr(ListBox1.SelCount) + ' notes selected'); ButtonOpen.Enabled := (ListBox1.SelCount = 1); ButtonRecover.Enabled := (ListBox1.SelCount = 1); ButtonDelete.Enabled := (ListBox1.SelCount > 0); end; procedure TFormBackupView.ListBox1SelectionChange(Sender: TObject; User: boolean); begin UpdateDetails(string(ListBox1.Items.Objects[ListBox1.ItemIndex])); end; procedure TFormBackupView.ButtonDeleteClick(Sender: TObject); var Index : integer = 0; begin while Index < ListBox1.Count do begin if ListBox1.Selected[Index] then if not DeleteFileUTF8(Sett.NoteDirectory + 'Backup' + PathDelim + string(ListBox1.Items.Objects[Index])) then Showmessage(rsCannotDelete + Sett.NoteDirectory + 'Backup' + PathDelim + string(ListBox1.Items.Objects[Index])); inc(Index); end; RefreshBackup(); Memo1.Append(rsNotesDeleted); end; procedure TFormBackupView.ButtonOpenClick(Sender: TObject); // Note : we only allow one at a time, multiselect will disable View begin MainUnit.MainForm.SingleNoteMode(Sett.NoteDirectory + 'Backup' + PathDelim + string(ListBox1.Items.Objects[ListBox1.ItemIndex]), False, True); end; // OK, overwriting an existing file is not an issue (as long as its not open). // However, if we are looking at a note that was deleted, it might be listed in // the Local Manifest as a deleted file. That will confuse the next sync. // So, lets just give those sort of notes a new ID. procedure TFormBackupView.ButtonRecoverClick(Sender: TObject); // Note : we only allow one at a time, multiselect will disable Recover var AForm : TForm; InString : string; InFile, OutFile: TextFile; NewFName : string; GUID : TGUID; FileName : string; ExistsInRepo : boolean; begin FileName := string(ListBox1.Items.Objects[ListBox1.ItemIndex]); ExistsInRepo := FileExistsUTF8(Sett.NoteDirectory + FileName); if ExistsInRepo then if IDYES <> Application.MessageBox(pchar(rsOverwriteNote), pchar(rsNoteAlreadyInRepo), MB_ICONQUESTION + MB_YESNO) then exit(); if SearchForm.NoteLister.IsThisNoteOpen(FileName, AForm) then begin showmessage(rsNoteOpen); exit(); end; if ExistsInRepo then begin if not RenameFileUTF8(Sett.NoteDirectory + FileName, Sett.NoteDirectory + 'Backup' // Move target note to backup with temp name + PathDelim + FileName + 'TMP') then begin showmessage(rsCopyFailed); exit; end; end else begin // Give the a non existing note a new name so that no issues about it being in delete section of Manifest. CreateGUID(GUID); NewFName := copy(GUIDToString(GUID), 2, 36) + '.note'; if RenameFile(Sett.NoteDirectory + 'Backup' + PathDelim + Filename, Sett.NoteDirectory + 'Backup' + PathDelim + NewFName) then FileName := NewFName else Showmessage(rsRenameFailed + ' ' + FileName); end; // OK, if to here, user really wants it back, no reason why not. AssignFile(InFile, Sett.NoteDirectory + 'Backup' + PathDelim + Filename); // We'll copy and update dates at same time, wether exists or not AssignFile(OutFile, Sett.NoteDirectory + Filename); try try Reset(InFile); Rewrite(OutFile); while not eof(InFile) do begin readln(InFile, InString); if (Pos('', InString) > 0) or (Pos('', InString) > 0) then begin if (Pos('', InString) > 0) then writeln(OutFile, ' ' + TB_GetLocalTime() + '') else writeln(OutFile, ' ' + TB_GetLocalTime() + ''); end else writeln(OutFile, InString); end; finally CloseFile(OutFile); CloseFile(InFile); end; SearchForm.NoteLister.IndexThisNote(copy(GUIDToString(GUID), 2, 36)); // why GUID, not 'Filename' ? // OK, lets deal with the copy of target that we put in backup. If ExistsInRepo then if not RenameFileUTF8(Sett.NoteDirectory + 'Backup' + PathDelim + FileName + 'TMP', Sett.NoteDirectory + 'Backup' + PathDelim + FileName) then begin showmessage('Failed to move temp backup file'); end; //NeedUpDate := True; except on E: EInOutError do showmessage('File handling error occurred. Details: ' + E.Message); end; // reindexing triggered from FormClose RefreshBackup(); Memo1.Append(rsRecoverOK); end; procedure TFormBackupView.FormClose(Sender: TObject; var CloseAction: TCloseAction); begin SearchForm.RefreshMenus(mkRecentMenu); SearchForm.ButtonRefresh.enabled := True; end; end. tomboy-ng_0.34-1/source/backupview.lfm0000644000175000017500000000705614145033507017565 0ustar dbannondbannonobject FormBackupView: TFormBackupView Left = 541 Height = 472 Top = 259 Width = 587 Caption = 'View, recover or delete Backup Files' ClientHeight = 472 ClientWidth = 587 OnClose = FormClose OnCreate = FormCreate OnDestroy = FormDestroy OnShow = FormShow LCLVersion = '2.1.0.0' object Memo1: TMemo AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Panel1 Left = 5 Height = 168 Top = 270 Width = 575 Anchors = [akLeft, akRight, akBottom] BorderSpacing.Left = 5 BorderSpacing.Right = 7 BorderSpacing.Bottom = 5 Lines.Strings = ( 'Memo1' ) TabOrder = 0 end object Panel1: TPanel AnchorSideLeft.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 0 Height = 29 Top = 443 Width = 587 Anchors = [akLeft, akRight, akBottom] ClientHeight = 29 ClientWidth = 587 TabOrder = 1 object ButtonOpen: TButton AnchorSideLeft.Control = Panel1 AnchorSideTop.Control = Panel1 AnchorSideBottom.Control = Panel1 AnchorSideBottom.Side = asrBottom Left = 1 Height = 27 Hint = 'Open and view the whole note' Top = 1 Width = 100 Anchors = [akTop, akLeft, akBottom] Caption = 'View' OnClick = ButtonOpenClick TabOrder = 0 end object ButtonRecover: TButton AnchorSideLeft.Control = ButtonOpen AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel1 AnchorSideBottom.Control = Panel1 AnchorSideBottom.Side = asrBottom Left = 101 Height = 27 Hint = 'Restore this note to main repo' Top = 1 Width = 100 Anchors = [akTop, akLeft, akBottom] Caption = 'Recover' OnClick = ButtonRecoverClick TabOrder = 1 end object ButtonDelete: TButton AnchorSideLeft.Control = ButtonRecover AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel1 AnchorSideBottom.Control = Panel1 AnchorSideBottom.Side = asrBottom Left = 201 Height = 27 Hint = 'Really, totally delete this note.' Top = 1 Width = 100 Anchors = [akTop, akLeft, akBottom] Caption = 'Delete' OnClick = ButtonDeleteClick TabOrder = 2 end object ButtonOK: TButton AnchorSideTop.Control = Panel1 AnchorSideRight.Control = Panel1 AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Panel1 AnchorSideBottom.Side = asrBottom Left = 472 Height = 27 Hint = 'My work here is done.' Top = 1 Width = 114 Anchors = [akTop, akRight, akBottom] Caption = 'Close' ModalResult = 1 TabOrder = 3 end end object ListBox1: TListBox AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Memo1 Left = 5 Height = 260 Hint = 'Use Ctrl or Shift to select multiple entries' Top = 5 Width = 577 Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Left = 5 BorderSpacing.Top = 5 BorderSpacing.Right = 5 BorderSpacing.Bottom = 5 ItemHeight = 0 MultiSelect = True OnSelectionChange = ListBox1SelectionChange ParentShowHint = False ScrollWidth = 575 ShowHint = True TabOrder = 2 TopIndex = -1 end end tomboy-ng_0.34-1/source/index.lfm0000644000175000017500000000140414145033507016523 0ustar dbannondbannonobject FormIndex: TFormIndex Left = 388 Height = 222 Top = 152 Width = 466 Caption = 'Heading in this Note' ClientHeight = 222 ClientWidth = 466 OnActivate = FormActivate OnShow = FormShow LCLVersion = '2.1.0.0' object ListBox1: TListBox Left = 0 Height = 188 Top = 34 Width = 466 Align = alClient ItemHeight = 0 OnClick = ListBox1Click ScrollWidth = 464 TabOrder = 0 TopIndex = -1 end object Panel1: TPanel Left = 0 Height = 34 Top = 0 Width = 466 Align = alTop Caption = 'Single lines, all Huge, Large Bold or Large' TabOrder = 1 end object Label1: TLabel Left = 206 Height = 19 Top = 98 Width = 47 Caption = 'Label1' ParentColor = False end end tomboy-ng_0.34-1/source/commonmark.pas0000644000175000017500000003563514145033507017601 0ustar dbannondbannonunit commonmark; {$mode objfpc}{$H+} { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html Exports a note in a subset of commonmark Create the object, optionally give it a directory to look in (and set DoPOFile ?). Call GetMDcontent() with an ID (that is, a filename without extension) and a created list to fill in with content. Has some limitations that relate, to some extent, to the MarkDown/CommonMark. 1) Monospace may be presented as either "leading spaces" or wrapped in BackTicks. The Leading Space model is used where the whole line (ie para) is mono, we add four spaces and strip out any other markup in the line. Looks better for blocks. Backticks are used where the mono is in line. It can have extra markup but has to have backticks closest to text, does not work here ... So, summary, blocks of Mono cannot show any other markup. 2) Large or Huge font (in tomboy) is only honoured if on a line by itself, become heading lines. Any in line Large or Huge is discarded. Small is preserved but cannot be displayed in github flavour of MD. 3) Only bullet cha allowed in MD list here is * (officially others allowed but not here) 4) When bullets (lists) mix, lists get priority, the mono drops back to inline mono. 5) Cannot do highlight (but I try to preserve it during a Tb->GH->TB cycle). HISTORY 2020-12-22 Extracted from the NextCloud Notes Branch 2020-??-?? Moved the Normalising code into a stand alone unit. 2021/06/15 Format lines that are all mono differenly so they show as a block. 2021/06/29 Merged this file back to tomboy-ng 2021/07/22 Make GetMDcontent more tolerent of passed ID/FFN 2021/07/30 Now use someutuls fro tb_util instead of implementing itself. Must sync to TB-NG 2021/07/30 Use the RemoveNoteMetaData( from TT_Utils, need merge TT_utils with TB_Utils 2021/08/19 Rewrite ProcessMarkup to use ST.Replace() approach 2021/09/28 Enabled multilevel bullets 2021/10/17 Rewrite most of monospace code. } interface uses Classes, SysUtils; type { TExportCommon } TExportCommon = class private {returns -1 if there is not a tag starting at index (1 based), else ret length of tag if there is a tag but its not the one we want. Ret 0 if right tag found.} function CheckForTag(index: integer; const Tag, St: string): integer; function ConvertBullets(Str: string): string; function ConvertMono(var InSt: string): boolean; function FindInStringList(const StL: TStringList; const FindMe: string): integer; // Make content suitable to write out as a PO file, no merging is going to happen ! procedure ProcessHeadings(StL: TStringList); procedure ProcessMarkUp(StL: TStringList); public DebugMode : boolean; NotesDir : string; // dir were we expect to find our TB notes // Takes a note ID (no extension) or a FFN inc path and .note // and fills out the passed StringList that must have been created) // with a commonmark version of the note. // returns an empty list on error. function GetMDcontent(ID : string; STL : TstringList) : boolean; end; implementation uses LazFileUtils{$ifdef LCL}, lazlogger {$endif}, laz2_DOM, laz2_XMLRead, notenormal, tb_utils; function TExportCommon.GetMDcontent(ID : string; STL : TStringList): boolean; var Normaliser : TNoteNormaliser; begin if FileExists(ID) then StL.LoadFromFile(ID) else if FileExists(NotesDir + ID + '.note') then StL.LoadFromFile(NotesDir + ID + '.note') else exit(False); // OK, now first line contains the title but some lines may have tags wrong side of \n, so Normalise Normaliser := TNoteNormaliser.Create; Normaliser.NormaliseList(StL); Normaliser.Free; StL.Delete(0); STL.Insert(0, GetTitleFromFFN(NotesDir + ID + '.note', False)); RemoveNoteMetaData(STL); ProcessHeadings(StL); // Makes Title big too ! ProcessMarkUp(StL); // ConvertMonoBlocks(STL); result := (Stl.Count > 2); end; function TExportCommon.FindInStringList(const StL : TStringList; const FindMe : string) : integer; var I : integer = 0; begin while i < StL.Count -1 do begin if pos(FindMe, StL.strings[i]) > 0 then exit(i); inc(i); end; result := -1; end; {We have to deal with two sorts of mono, full line where we apply 4 spaces to left and in-line where we use back ticks. A four leading space line can have additional spaces and they are preserved. The 'four' is my choice, when converting back, I'll assume, if there are at least four its mono, tag it up and remove first four spaces. No other codes are allowed on that line including backticks. A full line mono is a line that has text, has the mono html tags at beginning and end of line. But other tags and whitespace are allowed between the start and mono tag and between the and end of line. github will only display other font styles with mono if we use back tick and then only if the other tags appear, initiall, before the backtick, thus **`bold mono`** As the backtick looks very ugly in a block, I will use it only in-line and therefore leading space mono will need to be stripped of any other enhancements. } function TExportCommon.CheckForTag(index : integer; const Tag, St : string) : integer; begin if (St.Length < Index) or (St[Index] <> '<') then exit(-1); if copy(St, Index, Tag.Length) = Tag then exit(0); // OK, so it should be a tag but not the one we want. Result := 1; while (St.Length >= (Index + Result)) do begin if St[Index+Result] = '>' then exit(Result+1); inc(Result); end; result := -1; end; function TExportCommon.ConvertMono(var InSt : string) : boolean; var St : string; RetValue, i : integer; begin result := false; if pos('', InSt) > 0 then begin // Lists have priority over Mono InSt := InSt.Replace('', '`', [rfReplaceAll]); InSt := inSt.Replace('', '`', [rfReplaceAll]); end; if (pos('', InSt) = 0) or (pos('', inSt) = 0) then exit; St := InSt; i := 1; while St.Length >= i do if St[i] = ' ' then inc(i) else break; // whitespace allowed and retained RetValue := CheckForTag(i, '', St); // start with first non-space we find while RetValue > 0 do begin St := St.Remove(i, RetValue); // Remove any tags that appear before RetValue := CheckForTag(i, '', St); end; if RetValue <> 0 then begin InSt := InSt.Replace('', '`', [rfReplaceAll]); InSt := inSt.Replace('', '`', [rfReplaceAll]); exit; end; // OK, we now have a leading mono tag, i points to its start, add 11 for next char after tag i := St.IndexOf('<', i+11-1) +1; // we know there is at least one there. RetValue := CheckForTag(i, '', St); // one based while RetValue > 0 do begin // a non-target tag, remove St := St.Remove(i-1, RetValue); // zero based RetValue := St.IndexOf('<', i) +1; // 0 based. Can we find another ? if RetValue > 0 then begin // i remains one based. i := RetValue; RetValue := CheckForTag(i, '', St); end; end; // OK, here i should be pointing to , add tag length and clear away any trailing tags // i := pos('', St) + 12; // must still be there. i := i + 12; // length tag RetValue := CheckForTag(i, '', St); // only interested in pos or neg numbers while RetValue > 0 do begin St := St.Remove(i-1, RetValue); // remove is zero based. RetValue := CheckForTag(i-1, '', St); // Kek ? why -1 ????? end; if St.Length < i then begin St := St.Replace('', '', [rfReplaceAll]); St := St.Replace('', '', [rfReplaceAll]); InSt := ' ' + St; // yes, we passed all the tests, change to leading space mono Result := true; // ToDo - should i remove any tags between and ? end else begin InSt := InSt.Replace('', '`', [rfReplaceAll]); InSt := inSt.Replace('', '`', [rfReplaceAll]); end; //writeln(InSt); end; // This version uses the CommonMark model of noting heading with ---- ===== on line underneath procedure TExportCommon.ProcessHeadings(StL : TStringList); var i : integer = 1; // Skip first two lines because they are title and the ==== markup. PosI, L : integer; AddedHeading : Boolean = false; begin // We arrive here with a clean title in first st, lets mark it up as really big. StL.Insert(1, '==========='); repeat inc(i); if not AddedHeading then begin // this adds a blank line between paras, MD style StL.Insert(i, ''); inc(i); end; AddedHeading := False; if (StL.Strings[i] = '') or (StL.strings[i][1] <> '<') then continue; if copy(Stl.Strings[i], 1, length('')) = '' then begin PosI := pos('', Stl.Strings[i]); if PosI = 0 then continue; L := length(Stl.Strings[i]); if PosI -1 + length('') = L then begin StL.insert(i, copy(Stl.Strings[i], length('')+1, L - length(''))); StL.Delete(i+1); inc(i); StL.Insert(i, '--------'); AddedHeading := True; end; end; if copy(Stl.Strings[i], 1, length('')) = '' then begin PosI := pos('', Stl.Strings[i]); if PosI = 0 then continue; L := length(Stl.Strings[i]); if PosI -1 + length('') = L then begin StL.insert(i, copy(Stl.Strings[i], length('')+1, L - length(''))); StL.Delete(i+1); inc(i); StL.Insert(i, '========'); AddedHeading := True; end; end; until I >= StL.Count-1; end; // This version does heading in the leading ### model (* procedure TExportNote.ProcessHeadings(StL : TStringList); var i : integer = -1; PosI, L : integer; //Blar : string; begin repeat inc(i); if (StL.Strings[i] = '') or (StL.strings[i][1] <> '<') then continue; if copy(Stl.Strings[i], 1, length('')) = '' then begin //blar := Stl.Strings[i]; PosI := pos('', Stl.Strings[i]); if PosI = 0 then continue; L := length(Stl.Strings[i]); if PosI -1 + length('') = L then begin StL.insert(i, '### ' + copy(Stl.Strings[i], length('')+1, L - length(''))); StL.Delete(i+1); end; end; if copy(Stl.Strings[i], 1, length('')) = '' then begin //blar := Stl.Strings[i]; PosI := pos('', Stl.Strings[i]); if PosI = 0 then continue; L := length(Stl.Strings[i]); if PosI -1 + length('') = L then begin StL.insert(i, '## ' + copy(Stl.Strings[i], length('')+1, L - length(''))); StL.Delete(i+1); end; end; until I >= StL.Count-1; end; *) { must convert upto level 6 bullets to md. We use 3 spaces, ahead of marker to indicate each level. In the xml, each level is indicated by an additional wrap of CONTENT. Must start with the deepest bullet and work back up. } function TExportCommon.ConvertBullets(Str : string) : string; var Pre, Post, Spaces : string; i : integer = 5; j : integer; begin Result := Str; while i >= 0 do begin Pre := ''; Post := ''; Spaces := ''; for j := 0 to i do begin Pre := Pre + ''; Post := Post + ''; end; for j := 1 to (i*3) do Spaces := Spaces + ' '; Result := Result.Replace(Pre, Spaces + '* '); Result := Result.Replace(Post, ''); dec(i); end end; procedure TExportCommon.ProcessMarkUp(StL : TStringList); var StIndex : integer; TempSt: string; DeleteNext : boolean = false; // no blank lines following Monospace begin StIndex := -1; while StIndex < StL.Count -1 do begin inc(StIndex); if DeleteNext and (Stl[StIndex] = '') then begin Stl.Delete(StIndex); DeleteNext := False; dec(StIndex); continue; end; if (length(StL.Strings[StIndex]) < 2) then continue; // no room for a tag in there. TempSt := StL.Strings[StIndex]; DeleteNext := ConvertMono(TempSt); TempSt := TempSt.Replace('', '**', [rfReplaceAll]); TempSt := TempSt.Replace('', '**', [rfReplaceAll]); TempSt := TempSt.Replace('', '*', [rfReplaceAll]); TempSt := TempSt.Replace('', '*', [rfReplaceAll]); // TempSt := TempSt.Replace('', '`', [rfReplaceAll]); // TempSt := TempSt.Replace('', '`', [rfReplaceAll]); TempSt := TempSt.Replace('', '', [rfReplaceAll]); TempSt := TempSt.Replace('', '', [rfReplaceAll]); TempSt := TempSt.Replace('', '~~', [rfReplaceAll]); TempSt := TempSt.Replace('', '~~', [rfReplaceAll]); TempSt := TempSt.Replace('', '', [rfReplaceAll]); TempSt := TempSt.Replace('', '', [rfReplaceAll]); TempSt := TempSt.Replace('', '', [rfReplaceAll]); TempSt := TempSt.Replace('', '', [rfReplaceAll]); TempSt := ConvertBullets(TempSt); // TempSt := TempSt.Replace('', '* '); // TempSt := TempSt.Replace('', ''); TempSt := RestoreBadXMLChar(TempSt); StL.Insert(StIndex, TempSt); StL.Delete(StIndex + 1); end; end; end. tomboy-ng_0.34-1/source/autostart.pas0000644000175000017500000001053414145033507017453 0ustar dbannondbannonunit autostart; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ A unit to set and unset auto start of the tomboy-ng application on Windows and Linux. 2019/05/24 Display strings all (?) moved to resourcestrings 2020/05/18 Windows binaries no longer have 32 or 64 as part of binary name } {$mode objfpc}{$H+} interface uses Classes, SysUtils; type { TAutoStartCtrl } TAutoStartCtrl = class Private procedure AutoOff(AppName : string); // don't need appname Linux or windows, maybe MacOS ? procedure AutoOn(AppName: string); {$ifdef WINDOWS} function WindowsDirectory(CSIDL : integer): string; {$endif} Public ErrorMessage : string; // If set, trouble Will Roberinson ! TargetName : string; // Whatever we need copy, link or what ever to LinkName : string; // What we put in destination LinkDestination : string; // Directory we put the above. constructor Create(AppName : string; StartIt : boolean); destructor Destroy; override; end; implementation uses LazLogger, LazFileUtils, FileUtil, LazUTF8 {$ifdef WINDOWS}, Windows, ShlObj, ActiveX, ComObj, ExtCtrls{$endif}; { TAutoStartCtrl } {$ifdef WINDOWS} function TAutoStartCtrl.WindowsDirectory(CSIDL : integer) : string; var DirArray : array[0..MAX_PATH] of Char; PIDL : PItemIDList; begin SHGetSpecialFolderLocation(0, CSIDL, PIDL) ; SHGetPathFromIDList(PIDL, DirArray) ; Result := DirArray; // CSIDL_PROGRAM_FILES -> Where the tomboy-ng directory containg exe is. // CSIDL_STARTUP -> Where we put our shortcut (or remove it from) // CSIDL_APPDATA -> top of ~/AppData\Roaming ...... (not needed here) // CSIDL_DESKTOPDIRECTORY -> User's desktop. end; {$endif} procedure TAutoStartCtrl.AutoOn(AppName : string); {$ifdef WINDOWS} Var IObject : IUnknown; ISLink : IShellLink; IPFile : IPersistFile; {$endif} begin {$ifdef LINUX} // Just copy the desktop file, too easy. if not DirPathExists(LinkDestination) then ForceDirectory(LinkDestination); if FileExistsUTF8(TargetName) then CopyFile(TargetName, LinkDestination + LinkName) else ErrorMessage := 'Cannot find ' + TargetName; {$endif} {$ifdef WINDOWS} // Typically makes a link to c:\Programe Files\tomboy-ng\tomboy-ng64.exe in // C:\Users\dbann\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Startup\. if not FileExistsUTF8(TargetName) then begin ErrorMessage := 'Cannot find ' + TargetName; exit; end; IObject := CreateComObject(CLSID_ShellLink) ; ISLink := IObject as IShellLink; IPFile := IObject as IPersistFile; ISLink.SetPath(pChar(TargetName)); IsLink.SetWorkingDirectory(pChar(ExtractFilePath(TargetName))); IPFile.Save(PWChar(WideString(LinkDestination + LinkName)), false); // ErrorMessage := TargetName + ' --- ' + LinkDestination + LinkName; {$endif} end; procedure TAutoStartCtrl.AutoOff(AppName : string); begin if FileExistsUTF8(LinkDestination + LinkName) then DeleteFileUTF8(LinkDestination + LinkName); end; constructor TAutoStartCtrl.Create(AppName: string; StartIt: boolean); (* {$ifdef WINDOWS}var CPU : string;{$endif} *) begin inherited create; ErrorMessage := ''; {$ifdef LINUX} TargetName := '/usr/share/applications/' + AppName + '.desktop'; LinkDestination := AppendPathDelim(GetEnvironmentVariableUTF8('HOME')) + '.config/autostart'; LinkName := '/' + AppName + '.desktop'; {$endif} {$ifdef WINDOWS} (* CPU := {$i %FPCTARGETCPU%}; if CPU = 'i386' then CPU := '32' else CPU := '64'; } *) TargetName := WindowsDirectory(CSIDL_PROGRAM_FILES) + '\' + AppName + '\' + AppName + '.exe'; LinkDestination := WindowsDirectory(CSIDL_STARTUP); LinkName := '\' + AppName + '.lnk'; {$endif} if StartIt then AutoOn(AppName) else AutoOff(AppName); end; destructor TAutoStartCtrl.Destroy; begin inherited Destroy; end; end. tomboy-ng_0.34-1/source/libnotify.pas0000644000175000017500000002722314145033507017427 0ustar dbannondbannon{ libnotify binding for Free Pascal Copyright (C) 2011 Ido Kanner idokan at@at gmail dot.dot com This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. } unit libnotify; {$mode fpc}{$PACKRECORDS C} interface uses ctypes, glib2, gdk2pixbuf; const NOTIFY_LIBRARY = 'libnotify'; // Should be part of GTK but it is not binded to FPC :( type GVariant = record end; GfreeFunc = procedure(data : gpointer); cdecl; { notification.h } const (** * NOTIFY_EXPIRES_DEFAULT: * * The default expiration time on a notification. *) NOTIFY_EXPIRES_DEFAULT = -1; (** * NOTIFY_EXPIRES_NEVER: * * The notification never expires. It stays open until closed by the calling API * or the user. *) NOTIFY_EXPIRES_NEVER = 0; type P_NotifyNotificationPrivate = ^T_NotifyNotificationPrivate; T_NotifyNotificationPrivate = record end; PNotifyNotificationPrivate = P_NotifyNotificationPrivate; NotifyNotificationPrivate = T_NotifyNotificationPrivate; P_NotifyNotification = ^T_NotifyNotification; T_NotifyNotification = record parent_object : TGObject; priv : PNotifyNotificationPrivate; end; PNotifyNotification = P_NotifyNotification; TNotifyNotification = T_NotifyNotification; TNotificationProc = procedure (Notification : PNotifyNotification); cdecl; P_NotifyNotificationClass = ^T_NotifyNotificationClass; T_NotifyNotificationClass = record parent_class : TGObjectClass; // Signals Notification : TNotificationProc; end; PNotifyNotificationClass = P_NotifyNotificationClass; TNotifyNotificationClass = T_NotifyNotificationClass; function notify_notification_get_type : GType; cdecl; external NOTIFY_LIBRARY; function m_notify_type_notification : GType; cdecl; inline; function M_NOTIFY_NOTIFICATION(o : pointer) : PGTypeInstance; cdecl; inline; function M_NOTIFY_NOTIFICATION_CLASS(k : Pointer) : Pointer; cdecl; inline; function M_NOTIFY_IS_NOTIFICATION(o : Pointer) : Boolean; cdecl; inline; function M_NOTIFY_IS_NOTIFICATION_CLASS(k : pointer) : Boolean; cdecl; inline; function M_NOTIFY_NOTIFICATION_GET_CLASS(o : Pointer) : PGTypeClass; cdecl; inline; const (** * NotifyUrgency: * @NOTIFY_URGENCY_LOW: Low urgency. Used for unimportant notifications. * @NOTIFY_URGENCY_NORMAL: Normal urgency. Used for most standard notifications. * @NOTIFY_URGENCY_CRITICAL: Critical urgency. Used for very important notifications. * * The urgency level of the notification. *) NOTIFY_URGENCY_LOW = 0; NOTIFY_URGENCY_NORMAL = 1; NOTIFY_URGENCY_CRITICAL = 2; type NotifyUrgency = cint; (** * NotifyActionCallback: * @notification: * @action: * @user_data: * * An action callback function. *) NotifyActionCallback = procedure(notification : PNotifyNotification; action : PChar; user_data : gpointer); cdecl; (* /** * NOTIFY_ACTION_CALLBACK: * @func: The function to cast. * * A convenience macro for casting a function to a #NotifyActionCallback. This * is much like G_CALLBACK(). */ #define NOTIFY_ACTION_CALLBACK(func) ((NotifyActionCallback)(func)) *) function notify_notification_new(summary, body, icon : PChar) : PNotifyNotification; cdecl; external NOTIFY_LIBRARY; function notify_notification_update(notification : PNotifyNotification; summary, body, icon : PChar) : gboolean; cdecl; external NOTIFY_LIBRARY; function notify_notification_show(notification : PNotifyNotification; error : PPGError) : gboolean; cdecl; external NOTIFY_LIBRARY; procedure notify_notification_set_timeout(notification : PNotifyNotification; timeout : gint); cdecl; external NOTIFY_LIBRARY; procedure notify_notification_set_category(notification : PNotifyNotification; category : PChar); cdecl; external NOTIFY_LIBRARY; procedure notify_notification_set_urgency(notification : PNotifyNotification; urgency : NotifyUrgency); cdecl; external NOTIFY_LIBRARY; procedure notify_notification_set_icon_from_pixbuf( notification : PNotifyNotification; icon : PGdkPixbuf); cdecl; external NOTIFY_LIBRARY; procedure notify_notification_set_image_from_pixbuf( notification : PNotifyNotification; pixbuf : PGdkPixbuf); cdecl; external NOTIFY_LIBRARY; procedure notify_notification_set_hint_int32(notification : PNotifyNotification; key : PChar; value : gint); cdecl; external NOTIFY_LIBRARY; procedure notify_notification_set_hint_uint32(notification : PNotifyNotification; key : PChar; value : guint); cdecl; external NOTIFY_LIBRARY; procedure notify_notification_set_hint_double(notification : PNotifyNotification; key : PChar; value : gdouble); cdecl; external NOTIFY_LIBRARY; procedure notify_notification_set_hint_string(notification : PNotifyNotification; key : PChar; value : PChar); cdecl; external NOTIFY_LIBRARY; procedure notify_notification_set_hint_byte(notification : PNotifyNotification; key : PChar; value : guchar); cdecl; external NOTIFY_LIBRARY; procedure notify_notification_set_hint_byte_array( notification : PNotifyNotification; key : PChar; value : Pguchar; len : gsize); cdecl; external NOTIFY_LIBRARY; procedure notify_notification_set_hint(notification : PNotifyNotification; key : PChar; value : GVariant); cdecl; external NOTIFY_LIBRARY; procedure notify_notification_set_app_name(notification : PNotifyNotification; app_name : PChar); cdecl; external NOTIFY_LIBRARY; procedure notify_notification_clear_hints(notification : PNotifyNotification); cdecl; external NOTIFY_LIBRARY; procedure notify_notification_add_action(notification : PNotifyNotification; action, label_ : PChar; callback : NotifyActionCallback; user_data : gpointer; free_funch : GFreeFunc); cdecl; external NOTIFY_LIBRARY; procedure notify_notification_clear_actions(notification : PNotifyNotification); cdecl; external NOTIFY_LIBRARY; function notify_notification_close(notification : PNotifyNotification; error : PPGError) : gboolean; cdecl; external NOTIFY_LIBRARY; function notify_notification_get_closed_reason( notification : PNotifyNotification) : gint; cdecl; external NOTIFY_LIBRARY; { notify-enum-types.h } (* enumerations from "notification.h" *) function notify_urgency_get_type : GType; cdecl; external NOTIFY_LIBRARY; function M_NOTIFY_TYPE_URGENCY : GType; cdecl; inline; { notify-features.h } (* compile time version *) const NOTIFY_VERSION_MAJOR = 0; NOTIFY_VERSION_MINOR = 7; NOTIFY_VERSION_MICRO = 3; (* check whether a version equal to or greater than * major.minor.micro is present. *) function M_NOTIFY_CHECK_VERSION(major, minor, micro : cint) : Boolean; cdecl; inline; { notify.h } function notify_init(app_name : PChar) : gboolean; cdecl; external NOTIFY_LIBRARY; procedure notify_uninit; cdecl; external NOTIFY_LIBRARY; function notify_is_initted : gboolean; cdecl; external NOTIFY_LIBRARY; function notify_get_app_name : PChar; cdecl; external NOTIFY_LIBRARY; procedure notify_set_app_name(app_name : PChar); cdecl; external NOTIFY_LIBRARY; function notify_get_server_caps : PGList; cdecl; external NOTIFY_LIBRARY; function notify_get_server_info(ret_name, ret_vendor, ret_version : PPChar) : gboolean; cdecl; external NOTIFY_LIBRARY; implementation function m_notify_type_notification : GType; cdecl; begin m_notify_type_notification := notify_notification_get_type; end; function M_NOTIFY_NOTIFICATION(o : pointer): PGTypeInstance; cdecl; begin // #define NOTIFY_NOTIFICATION(o) (G_TYPE_CHECK_INSTANCE_CAST ((o), NOTIFY_TYPE_NOTIFICATION, NotifyNotification)) M_NOTIFY_NOTIFICATION := G_TYPE_CHECK_INSTANCE_CAST(o, m_notify_type_notification); end; function M_NOTIFY_NOTIFICATION_CLASS(k: Pointer): Pointer; cdecl; begin //#define NOTIFY_NOTIFICATION_CLASS(k) (G_TYPE_CHECK_CLASS_CAST((k), NOTIFY_TYPE_NOTIFICATION, NotifyNotificationClass)) M_NOTIFY_NOTIFICATION_CLASS := G_TYPE_CHECK_CLASS_CAST(k, m_notify_type_notification); end; function M_NOTIFY_IS_NOTIFICATION(o: Pointer): Boolean; cdecl; begin // #define NOTIFY_IS_NOTIFICATION(o) (G_TYPE_CHECK_INSTANCE_TYPE ((o), NOTIFY_TYPE_NOTIFICATION)) M_NOTIFY_IS_NOTIFICATION := G_TYPE_CHECK_INSTANCE_TYPE(o, m_notify_type_notification); end; function M_NOTIFY_IS_NOTIFICATION_CLASS(k: pointer): Boolean; cdecl; begin // #define NOTIFY_IS_NOTIFICATION_CLASS(k) (G_TYPE_CHECK_CLASS_TYPE ((k), NOTIFY_TYPE_NOTIFICATION)) M_NOTIFY_IS_NOTIFICATION_CLASS := G_TYPE_CHECK_CLASS_TYPE(k, m_notify_type_notification); end; function M_NOTIFY_NOTIFICATION_GET_CLASS(o: Pointer): PGTypeClass; cdecl; begin // #define NOTIFY_NOTIFICATION_GET_CLASS(o) (G_TYPE_INSTANCE_GET_CLASS ((o), NOTIFY_TYPE_NOTIFICATION, NotifyNotificationClass)) M_NOTIFY_NOTIFICATION_GET_CLASS := G_TYPE_INSTANCE_GET_CLASS(o, m_notify_type_notification); end; function M_NOTIFY_TYPE_URGENCY: GType; cdecl; begin M_NOTIFY_TYPE_URGENCY := notify_urgency_get_type; end; function M_NOTIFY_CHECK_VERSION(major, minor, micro: cint): Boolean; cdecl; begin { #define NOTIFY_CHECK_VERSION(major,minor,micro) \ (NOTIFY_VERSION_MAJOR > (major) || \ (NOTIFY_VERSION_MAJOR == (major) && NOTIFY_VERSION_MINOR > (minor)) || \ (NOTIFY_VERSION_MAJOR == (major) && NOTIFY_VERSION_MINOR == (minor) && \ NOTIFY_VERSION_MICRO >= (micro))) } M_NOTIFY_CHECK_VERSION := ((NOTIFY_VERSION_MAJOR > major) or ((NOTIFY_VERSION_MAJOR = major) and (NOTIFY_VERSION_MINOR > minor)) or ((NOTIFY_VERSION_MAJOR = major) and (NOTIFY_VERSION_MINOR = minor) and (NOTIFY_VERSION_MICRO >= micro))); end; end. tomboy-ng_0.34-1/source/rollback.lrj0000644000175000017500000000237414145033507017225 0ustar dbannondbannon{"version":1,"strings":[ {"hash":50730251,"name":"tformrollback.caption","sourcebytes":[70,111,114,109,82,111,108,108,66,97,99,107],"value":"FormRollBack"}, {"hash":77089212,"name":"tformrollback.speedcancel.caption","sourcebytes":[67,97,110,99,101,108],"value":"Cancel"}, {"hash":37921584,"name":"tformrollback.speedrolltoopen.caption","sourcebytes":[79,112,101,110,105,110,103,32,66,97,99,107,117,112],"value":"Opening Backup"}, {"hash":107677856,"name":"tformrollback.speedrolltotitle.caption","sourcebytes":[84,105,116,108,101,32,67,104,97,110,103,101,32,66,97,99,107,117,112],"value":"Title Change Backup"}, {"hash":126620494,"name":"tformrollback.labelopn.caption","sourcebytes":[76,97,98,101,108,79,112,110],"value":"LabelOpn"}, {"hash":126631564,"name":"tformrollback.labelttl.caption","sourcebytes":[76,97,98,101,108,116,116,108],"value":"Labelttl"}, {"hash":88329237,"name":"tformrollback.labelopntitle.caption","sourcebytes":[76,97,98,101,108,79,112,110,84,105,116,108,101],"value":"LabelOpnTitle"}, {"hash":157534917,"name":"tformrollback.labelttltitle.caption","sourcebytes":[76,97,98,101,108,116,116,108,84,105,116,108,101],"value":"LabelttlTitle"}, {"hash":86477809,"name":"tformrollback.label1.caption","sourcebytes":[76,97,98,101,108,49],"value":"Label1"} ]} tomboy-ng_0.34-1/source/syncutils.pas0000644000175000017500000005100514145033507017460 0ustar dbannondbannonunit syncutils; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ A Unit to support the tomboy-ng sync unit HISTORY 2018/10/25 Much testing, support for Tomdroid. 2018/10/28 Added SafeGetUTCC.... 2018/06/05 Func. to support Tomboy's sync dir names, rev 431 is in ~/4/341 2019/06/07 Don't check for old sync dir model, for 0 its the same ! 2019/07/19 Added ability to escape ' and " selectivly, attributes ONLY 2020/04/24 Make debugln use dependent on LCL, now can be FPC only unit 2020/08/01 Can now handle 'Zulu' datestrs, ones without timezone, with 'Z' 2021/08/31 Added sha to TNoteInfo 2021/09/12 Taught GetNoteLastChangeSt() to also get create date. 2021/09/27 Added function to return text name for TSyncTransport Type } {$mode objfpc}{$H+} interface uses Classes, SysUtils, dateutils, LazLogger; type TSyncTransport=(SyncFile, // Sync to locally available dir, things like smb: mount, google drive etc SyncGitHub, // sends markdown notes to/from github. SyncAndroid, // Simple one to one Android Device SyncFileAndroid); // Android sync using mounted file system //SyncNextCloud, // Sync to NextCloud using Nextcloud Notes type TSyncAction=(SyUnset, // initial state, should not be like this at end. SyNothing, // This note, previously sync'ed has not changed. SyUploadNew, // This a new local note, upload it. SyUploadEdit, // A previously synced note, edited locally, upload. SyDownload, // A new or edited note from elsewhere, download. SyDeleteLocal, // Synced previously but no longer present on server, delete locally SyDeleteRemote, // Marked as having been deleted locally, so remove from server. SyClash, // Edited both locally and remotly, policy or user must decide. SyError, SyAllRemote, // Clash Decision - Use remote note for all subsquent clashes SyAllLocal, // Clash Decision - Use local note for all subsquent clashes SyAllNewest, // Clash Decision - Use newest note for all subsquent clashes SyAllOldest); // Clash Decision - Use oldest note for all subsquent clashes // Indicates the readyness of a sync connection type TSyncAvailable=(SyncNotYet, // Initial state. SyncReady, // We are ready to sync, looks good to go. SyncNoLocal, // We don't have a local manifest, only an error if config thinks there should be one. SyncNoRemoteMan, // No remote manifest, an uninitialized repo perhaps ? SyncNoRemoteRepo, // Filesystem is OK but does not look like a repo, maybe no serverID. SyncBadRemote, // Has either Manifest or '0' dir but not both. SyncNoRemoteDir, // Perhaps sync device is not mounted, Tomdroid not installed ? SyncNoRemoteWrite, // no write permission, do not proceed! SyncMismatch, // Its a repo, Captain, but not as we know it. SyncXMLError, // Housten, we have an XML error in a manifest ! SyncBadError, // Some other error, must NOT proceed. SyncNetworkError, // Remove server/device not responding SyncCredentialError); // Unsuitable user:password type TRepoAction = ( RepoJoin, // Join (and use) an existing Repo RepoNew, // Create (and use) a new repo in presumably a blank dir RepoUse, // Go ahead and use this repo to sync RepoForce, // Force join or create, even if existing credentuals don't work RepoTest); // Just have a look, maybe call SetTransport ? type PNoteInfo=^TNoteInfo; TNoteInfo = record ID : ANSIString; // The 36 char ID LastChangeGMT : TDateTime; // Compare less or greater than but not Equal ! CreateDate : ANSIString; LastChange : ANSIString; // leave as strings, need to compare and TDateTime uses real Rev : Integer; // Not used for uploads, Trans knows how to inc its own. Deleted: Boolean; SID : longint; // Short ID, clumbsy alt to the GUID/UUID we should use Action : TSyncAction; Title : ANSIString; Sha : ANSIString; // The sha of an uploaded note. Stored in local manifest, Github mode. end; type { ---------- TNoteInfoList ---------} { TNoteInfoList } TNoteInfoList = class(TList) private function Get(Index: integer): PNoteInfo; public ServerID : string; // Partially implemented, don't rely yet .... LastSyncDateSt : string; // Partially implemented, don't rely yet .... LastSyncDate : TDateTime; // Partially implemented, don't rely yet .... LastRev : integer; // Partially implemented, don't rely yet .... destructor Destroy; override; function Add(ANote : PNoteInfo) : integer; function FindID(const ID : ANSIString) : PNoteInfo; function ActionName(Act : TSyncAction) : string; procedure DumpList(const Wherefrom : string); property Items[Index: integer]: PNoteInfo read Get; default; end; { ------------- TClashRecord ------------- } { A couple of types used to manage the data involved in handling a sync clash. } type TClashRecord = record Title : ANSIString; NoteID : ANSIString; //ServerLastChange : ANSIString; //LocalLastChange : ANSIString; ServerFileName : string; LocalFileName : string; end; type TProceedFunction = function(const ClashRec : TClashRecord): TSyncAction of object; type TProgressProcedure = procedure(const St : string) of object; { takes a path to the server and a rev number and returns a Tomboy style sync dir. or, if NoteID (without '.note') is supplied, a FullNoteName } function GetRevisionDirPath (ServerPath : string; Rev : integer; NoteID : string = '') : string; { Returns True if this Sync Dir is in correct (ie Tomboy or tomboy-ng later than may 2019 mode) place. eg revision 431 should be in $SYNCDIR/4/431 but might be in 0/431 } function UsingRightRevisionPath(ServerPath : string; Rev : integer) : boolean; // Takes a normal Tomboy DateTime string and converts it to UTC, ie zero offset function ConvertDateStrAbsolute(const DateStr : string) : string; // Returns the LCD string, '' and setting Error to other than '' if something wrong function GetNoteLastChangeSt(const FullFileName : string; out Error : string; CDateInstead : boolean = false) : string; { ret true if it really has removed the indicated file. Has proved necessary to do this on two end user's windows boxes. Writes debuglns if it has initial problems, returns F and sets ErrorMsg if fails.} function SafeWindowsDelete(const FullFileName : string; var ErrorMsg : string) : boolean; function SyncTransportName(TheType : TSyncTransport) : string; RESOURCESTRING rsNewUploads = 'New Uploads '; rsEditUploads = 'Edit Uploads '; rsDownloads = 'Downloads '; rsLocalDeletes = 'Local Deletes '; rsRemoteDeletes = 'Remote Deletes '; rsClashes = 'Clashes '; rsDoNothing = 'Do Nothing '; rsSyncERRORS = 'ERRORS (see console log) '; rsNoNotesNeededSync = 'No notes needed syncing. You need to write more.'; rsNotesWereDealt = ' notes were dealt with.'; rsChangeExistingSync = 'Change existing sync connection ?'; rsNotRecommend = 'Generally not recommended.'; rsNextBitSlow = 'Next bit can be a bit slow, please wait'; { -------------- implementation ---------------} implementation uses laz2_DOM, laz2_XMLRead, LazFileUtils, tb_utils; function SyncTransportName(TheType : TSyncTransport) : string; begin Result := ''; case TheType of SyncFile : result := 'SyncFile'; SyncGitHub : result := 'SyncGithub'; SyncAndroid : result := 'SyncAndroid'; SyncFileAndroid : result := 'SyncFileAndroid'; end; end; function SafeWindowsDelete(const FullFileName : string; var ErrorMsg : string) : boolean; begin // This whole block is here because of issue #132 where windows seemed to have problems // moving, deleting a note before a new version is copied over. Is the problem // that windows deletefileUTF8() is not settings its return value correctly ?? if not DeleteFile(FullFileName) then begin ErrorMsg := SysErrorMessage(GetLastOSError); {$ifdef LCL}Debugln{$else}writeln{$endif}('Failed using DeleteFileUTF8 - file name is :' + FullFilename); {$ifdef LCL}Debugln{$else}writeln{$endif}('OS Error Msg : ' + ErrorMsg); if not FileExistsUTF8(FullFileName) then debugln('But, FileExists says its gone, proceed !') else begin {$ifdef LCL}Debugln{$else}writeln{$endif}('I can confirm its still there .'); {$ifdef LCL}Debugln{$else}writeln{$endif}('Trying a little sleep...'); sleep(10); if not DeleteFileUTF8(FullFileName) then begin if not FileExistsUTF8(FullFileName) then {$ifdef LCL}Debugln{$else}writeln{$endif}('DeleteFileUTF8 says it failed but FileExists says its gone, proceed !') else exit(false); end; end; end; Result := true; end; function GetNoteLastChangeSt(const FullFileName : string; out Error : string; CDateInstead : boolean = false) : string; var Doc : TXMLDocument; Node : TDOMNode; // LastChange : string; begin if not FileExistsUTF8(FullFileName) then begin Error := 'ERROR - File not found, cannot read note change date for ' + FullFileName; exit(''); end; try ReadXMLFile(Doc, FullFileName); if CDateInstead then Node := Doc.DocumentElement.FindNode('create-date') else Node := Doc.DocumentElement.FindNode('last-change-date'); Result := Node.FirstChild.NodeValue; finally Doc.free; // TODO - xml errors are NOT caught in calling process end; end; { ---------------- TNoteInfoList ---------------- } function TNoteInfoList.Add(ANote : PNoteInfo) : integer; begin result := inherited Add(ANote); end; { This will be quite slow with a big list notes, consider an AVLTree ? } function TNoteInfoList.FindID(const ID: ANSIString): PNoteInfo; var Index : longint; begin Result := Nil; for Index := 0 to Count-1 do begin if Items[Index]^.ID = ID then begin Result := Items[Index]; exit() end; end; end; function TNoteInfoList.ActionName(Act: TSyncAction): string; begin Result := ' Unknown '; case Act of SyUnset : Result := ' Unset '; SyNothing : Result := ' Nothing '; SyUploadNew : Result := ' UploadNew '; // we differentiate in case of a write to remote fail. SyUpLoadEdit : Result := ' UpLoadEdit '; SyDownload: Result := ' Download '; SyDeleteLocal : Result := ' DeleteLocal '; SyDeleteRemote : Result := ' DeleteRemote '; SyError : Result := ' ** ERROR **'; SyClash : Result := ' Clash '; SyAllLocal : Result := ' AllLocal '; SyAllRemote : Result := ' AllRemote '; SyAllNewest : Result := ' AllNewest '; SyAllOldest : Result := ' AllOldest '; end; while length(result) < 15 do Result := Result + ' '; end; procedure TNoteInfoList.DumpList(const Wherefrom: string); var P : PNoteInfo; St : string; begin debugln(''); debugln('----------- List MetaData ' + Wherefrom + ' -------------'); for P in self do begin St := ' ' + inttostr(P^.Rev); while length(St) < 5 do St := St + ' '; debugln('ID=' + copy(P^.ID, 1, 9) + St + ActionName(P^.Action) + ' ' + P^.Title + ' sha=' + copy(P^.Sha, 1, 9)); debugln(' CDate=' + P^.CreateDate + ' LCDate=' + P^.LastChange); end; debugln('-------------------------------------------------------'); (* for I := 0 to Count -1 do begin St := ' ' + inttostr(Items[i]^.Rev); while length(St) < 5 do St := St + ' '; // St := Meta.ActionName(Meta.Items[i]^.Action); debugln('ID=' + copy(Items[I]^.ID, 1, 9) + St + ActionName(Items[i]^.Action) + ' ' + Items[I]^.Title + ' sha=' + copy(Items[I]^.Sha, 1, 9)); debugln(' CDate=' + Items[i]^.CreateDate + ' LCDate=' + Items[i]^.LastChange); end; *) end; destructor TNoteInfoList.Destroy; var I : integer; begin for I := 0 to Count-1 do dispose(Items[I]); inherited; end; function TNoteInfoList.Get(Index: integer): PNoteInfo; begin Result := PNoteInfo(inherited get(Index)); end; function GetRevisionDirPath(ServerPath: string; Rev: integer; NoteID : string = ''): string; begin result := appendpathDelim(appendpathdelim(serverPath) + inttostr(Rev div 100) + pathDelim + inttostr(rev)); if NoteID <> '' then result := result + NoteID + '.note'; end; function UsingRightRevisionPath(ServerPath: string; Rev: integer): boolean; var FullDirName : string; begin FullDirname := GetRevisionDirPath(ServerPath, Rev); // debugln('Right sync Dir is ' + FullDirName); Result := DirectoryExists(FullDirName); // we hope its in 'wrong' place .... // Just to be carefull ... {FullDirname := appendpathdelim(serverPath) + '0' + pathDelim + inttostr(rev); if DirectoryExists(FullDirName) then begin debugln('ERROR, Sync Repo has two sync directories for rev no ' + inttostr(rev)); debugln('We will use ' + GetRevisionDirPath(ServerPath, Rev)); end; } //result := true; end; // Takes a normal Tomboy DateTime string and converts it to UTC, ie zero offset function ConvertDateStrAbsolute(const DateStr : string) : string; var Temp : TDateTime; begin if DateStr = '' then exit(''); // Empty string // A date string should look like this - 2018-01-27T17:13:03.1230000+11:00 33 characters ! // but on Android, its always 2018-01-27T17:13:03.1230000+00:00 ie GMT absolute if length(DateStr) <> 33 then begin {$ifdef LCL}Debugln{$else}writeln{$endif}('ERROR ConvertDateStrAbsolute received invalid date string - [' + DateStr + ']'); exit(''); end; Temp := TB_GetGMTFromStr(DateStr) {- GetLocalTimeOffset()}; Result := FormatDateTime('YYYY-MM-DD',Temp) + 'T' + FormatDateTime('hh:mm:ss.zzz"0000+00:00"',Temp); end; { This function is used if we get a datetime str in UTC format, no time zone specified, just a 'Z'. The time is already in GMT. Gnote gives us 6 decimal places after second but we can cope with nany. Must have yyyy-mm-ddThh:mm:ssZ and opt .nnn.. between 'ss and 'Z' } (* function GetZuluDateTime(const DateStr: ANSIString): TDateTime; var Tstr : string = ''; MilliSeconds : TDateTime = 0.0; Places : integer; begin result := 0.0; if pos('Z', DateStr) < 1 then exit(0); if pos('.', DateStr) > 0 then begin // we make no assumption about number of decimal places in mSec Places := pos('Z', DateStr) - pos('.', DateStr) -1; if Places > 3 then Places := 3; if Places > 0 then begin Tstr := copy(DateStr, pos('.', DateStr)+1, Places); // note, only 3 places of mSec are read if TStr <> '' then try while Places < 3 do begin TStr := TStr + '0'; inc(Places); end; debugln('TStr = ' + TStr); if not TryEncodeTimeInterval(0, 0, 0, strtoint(TStr), MilliSeconds) then // Hour, Min, Sec, mSec, outVar {$ifdef LCL}Debugln{$else}writeln{$endif}('Fail on interval encode '); except on EConvertError do begin {$ifdef LCL}Debugln{$else}writeln{$endif}('FAIL on converting time interval ' + DateStr); {$ifdef LCL}Debugln{$else}writeln{$endif}('Hour ', copy(DateStr, 29, 2), ' minutes ', copy(DateStr, 32, 2)); end; end; end; end; try if not TryEncodeDateTime( strtoint(copy(DateStr, 1, 4)), // Year strtoint(copy(DateStr, 6, 2)), // Month strtoint(copy(DateStr, 9, 2)), // Day strtoint(copy(DateStr, 12, 2)), // Hour strtoint(copy(DateStr, 15, 2)), // Minutes strtoint(copy(DateStr, 18, 2)), // Seconds 0, Result) then {$ifdef LCL}Debugln{$else}writeln{$endif}('Fail on date time encode '); except on EConvertError do begin {$ifdef LCL}Debugln{$else}writeln{$endif}('FAIL on converting date time ' + DateStr); exit(0.0); end; end; Result := Result + milliSeconds; end; *) (* function GetGMTFromStr(const DateStr: ANSIString): TDateTime; var TimeZone : TDateTime; begin if DateStr = '' then exit(0); // Empty string // A date string should look like this - 2018-01-27T17:13:03.1230000+11:00 33 characters ! // But from GNote looks like this 2018-01-27T17:13:03.123000Z 27 char, Zulu time, one less dec second digit, its GMT if length(DateStr) <> 33 then begin {$ifdef LCL}Debugln{$else}writeln{$endif}('ERROR received invalid date string - [' + DateStr + ']'); exit(0); end; try if not TryEncodeTimeInterval( strtoint(copy(DateStr, 29, 2)), // Hour strtoint(copy(DateStr, 32, 2)), // Minutes 0, // Seconds 0, // mSeconds TimeZone) then {$ifdef LCL}Debugln{$else}writeln{$endif}('Fail on interval encode '); except on EConvertError do begin {$ifdef LCL}Debugln{$else}writeln{$endif}('FAIL on converting time interval ' + DateStr); {$ifdef LCL}Debugln{$else}writeln{$endif}('Hour ', copy(DateStr, 29, 2), ' minutes ', copy(DateStr, 32, 2)); end; end; try if not TryEncodeDateTime(strtoint(copy(DateStr, 1, 4)), // Year strtoint(copy(DateStr, 6, 2)), // Month strtoint(copy(DateStr, 9, 2)), // Day strtoint(copy(DateStr, 12, 2)), // Hour strtoint(copy(DateStr, 15, 2)), // Minutes strtoint(copy(DateStr, 18, 2)), // Seconds strtoint(copy(DateStr, 21, 3)), // mSeconds Result) then {$ifdef LCL}Debugln{$else}writeln{$endif}('Fail on date time encode '); except on EConvertError do begin {$ifdef LCL}Debugln{$else}writeln{$endif}('FAIL on converting date time ' + DateStr); exit(0.0); end; end; try if DateStr[28] = '+' then Result := Result - TimeZone else if DateStr[28] = '-' then Result := Result + TimeZone else {$ifdef LCL}Debugln{$else}writeln{$endif}('******* Bugger, we are not parsing DATE String ********'); except on EConvertError do begin {$ifdef LCL}Debugln{$else}writeln{$endif}('FAIL on calculating GMT ' + DateStr); exit(0.0); end; end; { writeln('Date is ', DatetoStr(Result), ' ', TimetoStr(Result)); } end; *) (* function SafeGetUTCfromStr(const DateStr : string; out DateTime : TDateTime; out ErrorMsg : string) : boolean; begin ErrorMsg := ''; if length(DateStr) = 33 then // This is the Tomboy standard DateTime := TB_GetGMTFromStr(DateStr) else if pos('Z', DateStr) > 0 then DateTime := GetZuluDateTime(DateStr) // Gnote does this else begin ErrorMsg := 'Date String wrong length'; DateTime := 0.0; exit(False); end; // if to here, we have at least tried to convert it. if DateTime < 1.0 then begin ErrorMsg := 'Invalid Date String'; exit(False); end; if (DateTime > (now() + 36500)) or (DateTime < (Now() - 36500)) then begin ErrorMsg := 'Date beyond expected range'; DateTime := 0.0; exit(False); end; // TDateTime has integer part, no. of days, fraction part is fraction of day. // 100years ago or in future - Fail ! exit(True); end; *) end. tomboy-ng_0.34-1/source/tomdroidfile.lrj0000644000175000017500000000411314145033507020106 0ustar dbannondbannon{"version":1,"strings":[ {"hash":104566852,"name":"tformtomdroidfile.caption","sourcebytes":[84,111,109,100,114,111,105,100],"value":"Tomdroid"}, {"hash":4863637,"name":"tformtomdroidfile.buttonclose.caption","sourcebytes":[67,108,111,115,101],"value":"Close"}, {"hash":90721265,"name":"tformtomdroidfile.panel1.caption","sourcebytes":[80,97,110,101,108,49],"value":"Panel1"}, {"hash":256418561,"name":"tformtomdroidfile.label1.caption","sourcebytes":[84,111,109,100,114,111,105,100,32,83,121,110,99,32,45,32,98,101,32,97,119,97,114,101,32,111,102,32,108,105,109,105,116,97,116,105,111,110,115,32,33],"value":"Tomdroid Sync - be aware of limitations !"}, {"hash":90721266,"name":"tformtomdroidfile.panel2.caption","sourcebytes":[80,97,110,101,108,50],"value":"Panel2"}, {"hash":212229150,"name":"tformtomdroidfile.checkboxtestrun.caption","sourcebytes":[84,101,115,116,32,82,117,110],"value":"Test Run"}, {"hash":75222933,"name":"tformtomdroidfile.labeladvice.caption","sourcebytes":[65,100,118,105,99,101],"value":"Advice"}, {"hash":43742593,"name":"tformtomdroidfile.labeladvice1.caption","sourcebytes":[76,97,98,101,108,65,100,118,105,99,101,49],"value":"LabelAdvice1"}, {"hash":43742594,"name":"tformtomdroidfile.labeladvice2.caption","sourcebytes":[76,97,98,101,108,65,100,118,105,99,101,50],"value":"LabelAdvice2"}, {"hash":194459653,"name":"tformtomdroidfile.label6.caption","sourcebytes":[85,112,108,111,97,100,32,109,101,97,110,115,32,102,114,111,109,32,116,111,109,98,111,121,45,110,103,32,116,111,32,65,110,100,114,111,105,100,32,68,101,118,105,99,101],"value":"Upload means from tomboy-ng to Android Device"}, {"hash":372803,"name":"tformtomdroidfile.buttonsync.caption","sourcebytes":[83,121,110,99],"value":"Sync"}, {"hash":322608,"name":"tformtomdroidfile.buttonhelp.caption","sourcebytes":[72,101,108,112],"value":"Help"}, {"hash":333310,"name":"tformtomdroidfile.buttonjoin.caption","sourcebytes":[74,111,105,110],"value":"Join"}, {"hash":204117436,"name":"tformtomdroidfile.buttonoldssh.caption","sourcebytes":[85,115,101,32,111,108,100,32,83,83,72,32,109,111,100,101,108],"value":"Use old SSH model"} ]} tomboy-ng_0.34-1/source/transgithub.pas0000644000175000017500000021015214145033507017755 0ustar dbannondbannonunit transgithub; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ } { A class that provides transport for a tomboy-ng to github sync. -------------- P E R S O N A L A C C E S S T O K E N S ------------------ https://github.com/settings/tokens to generate a Person Access Token From a logged in to github page, click my pretty picture, top right. Then 'Settings'. on left sidebar, click 'Developer", "Personal Access Token". } { Normal Sync Cycle for GitHub Sync eg, as driven by SyncGui.ManualSync --------------------------------------------------------------------- Create ASync Assign Proceed and Progress methods Assign various config data Async.RepoAction := RepoUse Async.SetTransport Assigns and configures Transport ASync.TestConnection Reads Local Manifest, setting LocalServerID and LocalLastSyncDates Calls Transport.TestTransport Might make new serverID Creates RemoteNotes data structure Contacts github, confirming UID and Token work, a ServerID can be found. Scans remote dir indexing all files found in /, /Notes and /Meta Reads Remote Manifest, filling RemoteNotes out with details of all remote notes. Compares ServerIDs ASync.StartSync Calls LoadRemoteRepo which calls GitHubSync.GetRemoteNotes which does nothing. Calls GitHubSync.AssignActions which Iterates over RemoteNotes adding every entry into RemoteMetaData making some initial Action guesses. Iterates over NoteLister (both Note List and Notebook List) adding all entries not already in RemoteMetaData, firming up Actions as it goes. Calls CheckRemoteDeletes and CheckLocalDeletes that further refines Actions in RemoteMetaData based on information from LocalManifest. Asks the user to resolve any clashes Calls DoDownloads, DoDeletes and DoUpLoads which call Transport to do actual file work. Calls DoDeletesLocal. Calls Transport.DoRemoteManifest to write and upload a remote manifest. Calls WriteLocalManifest Easy Peasy ! The above glosses over error handling and, importantly, how data such as last change dates is shuffled around to ensure its in RemoteNotes when we write out remote manifests. Downloading a Note. RemoteNotes will already know CData and Notebooks from reading remote manifest. DownLoadANote will write a temp file in Note format. It first calls Downloader() which returns with a string containg note content as JSON Base64 encoded. We decode and drop into s stringlist. We pass that to Importer thats converts to xml. HISTORY : 2021/09/20 - Changed to using JSONTools, tidier, safer, easier to read code. 2021/09/25 - fixed how notebook lists are stored in RemoteNotes, as JSON array, not JSON data 2021/09/27 - Implement selective sync. } {x$define DEBUG} {$mode ObjFPC}{$H+} interface uses Classes, SysUtils, {fpjson, jsonparser, }syncutils {$ifndef TESTRIG}, trans{$endif}; type TFileFormat = ( ffNone, // Format not, at this stage specified ffEncrypt, // File is encrypted ffMarkDown); // File is in MarkDown, CommonMark type PGitNote=^TGitNote; TGitNote = record FName : string; // eg README.txt, Meta/serverid, Notes/.md Sha : string; // The SHA, we always have this. Title : string; // Last known note title. LCDate: string; // The Last Change Date of the note. Always can get that. CDate : string; // The create Date, we may not know it if its a new note. Format : TFileFormat; // How the file is saved at github, md only at present Notebooks : string; // empty OK, else [] or ["notebook1", "notebook2"] etc. Only needed for SyDownLoad end; type { TGitNoteList } TGitNoteList = class(TFPList) private procedure DumpList(wherefrom : string); function Get(Index: integer): PGitNote; { Inserts just one field into GitNoteList. FName should include remote path and extension (ie Notes/ABC.md). Does not do format but might need to ...} procedure InsertData(const FName, Field, Data: string); public constructor Create(); destructor Destroy; override; // Adds an item, found in the remote dir scan JSON, to the // RemoteNotes list, does NOT check for duplicates. Only gets // Name (that is, FileName maybe with dir prepended) and sha. //function AddJItem(jItm: TJSONData; Prefix: string): boolean; // Adds a new item to List, Notes and files in Meta require prefix added before being passed here procedure AddNewItem(const FName, Sha: string); function Add(AGitNote : PGitNote) : integer; // Adds or updates record, FName being key. procedure Add(const FName, Sha: string); // Selectivly inserts the supplied data into GitNoteList. // Always use most fields but don't use LCD if the sha do not match. procedure InsertData(const GitRec : TGitNote); // Returns true and sets sha if note is in List. Ignores trailing / in FName. // If the Note exists in the list but its sha is not set, ret True but sha is empty function FNameExists(FName: string; out Sha: string): boolean; { Tries to find the list item, first tries RNotesDir+ID+.md and then tries as if ID is FFname. Returns a pointer to a GitNote record or nil if not found. } function Find(const ID: string): PGitNote; property Items[Index: integer]: PGitNote read Get; default; end; type { TGitHub } { TGitHubSync } {$ifdef TESTRIG} TGitHubSync = class {$else} TGithubSync = class(TTomboyTrans) {$endif} private { Private : Initialised in TestConnection which calls ScanRemoteRepo to put an ID and sha entry in, then ReadRemoteManifest to fill in cdate, format, title and notebooks. AssignAction will add locally know notes and and actions.} RemoteNotes : TGitNoteList; { Hold name of SelectiveSync Notebook, eg SyncGithub, set during a Join (depending on remote repo, a New (depending on if we have a Notebook by that name) or in a Use its loaded from RemoteManifest and cannot be changed. The actual name to trigger all this is a constant in implementation section of transgithub. } SelectiveSync : string; SelectiveNotebookIDs : TstringList; // May contain FNames of notes that are members of SelectiveSync notebook. Do not create or free. HeaderOut : string; // Very ugly global to get optional value back from Downloader // ToDo : do better than this Davo // A general purpose downloader, results in JSON, if downloading a file we need // to pass the Strings through ExtractContent() to do JSON and base64 stuff. // This method may set ErrorMessage, it might need resetting afterwards. // The two optional parameter must be used together and extract one header value. function Downloader(URL: string; out SomeString: String; const Header: string =''): boolean; //procedure DumpJSON(const St: string; WhereFrom: string = ''); { Returns the LCDate string from the commit history. We ask for just the most recent commit and find the datestring in the json. Expects a full file name, something like 'Notes/6EC64290-4348-4716-A892-41C9DE4AEC4C.md' - should work for any format.} function GetNoteLCD(FFName: string): string; { Used only by AssignActions, scans over NoteLister's notes adding any it finds present in NoteLister but not yet in RMData. We might exclude notes not members of the SyncGithub notebook if SelectiveSync contains that name. The list of local notes who are members of SyncGithub might be nil is no local SyncGithub. Note : we don't copy records from RMetaData to RemoteNotes is TestRun. } function MergeNotesFromNoteLister(RMData: TNoteInfoList; TestRun: boolean ): boolean; // Reads the (json) remote manifest, adding cdate, format and Notebooks to RemoteNotes. // Assumes RemoteNotes is created, comms tested. Ret false if cannot find remote // manifest. All a best effort approach, a github created note will not be listed. function ReadRemoteManifest(): boolean; // Generic Putting / Posting Method. Put = False means Post. If an FName is provided // then its a file upload, record the sha in RemoteNotes. function SendData(const URL, BodyJSt: String; Put: boolean; FName: string = ''): boolean; // Returns URL like https://api.github.com/repos/davidbannon/tb_test/contents (true) // Or like https://github.com/davidbannon/tb_test/blob/main/ (false) // Requires UserName, RemoteRepoName, API version does not have trailing / function ContentsURL(API: boolean): string; // Returns content asociated with Key at either toplevel (no third parameter) or // one level down under the ItemNo indexed toplevel Key. First top level key is zero. function ExtractJSONField(const data, Field: string; Level1: string = ''; Level2: string = ''): string; function GetServerId() : string; // Creates a file at remote using contents of List. RemoteFName may be // something like Meta/serverid for example. Checks RemoteNotes to see if // file already exists and does update node if it does. No dir is defaulted to. function SendFile(RemoteFName: string; STL: TstringList): boolean; // Makes a new remote repo if it does not exist, if called when repo // does exist, will check that a serverID is present and just return false // If the ServerID is NOT present, will make one and return true function MakeRemoteRepo() : boolean; // Gets just an ID, uses NotesDir to load that into commonmark and then passes // the resulting string to SendFile. Also works for NoteBooks ?? function SendNote(ID: string): boolean; // Scans the top level of the repo and then Notes and Meta recording in me and // RemoteNotes the filename and sha for every remote file it finds. function ScanRemoteRepo() : boolean; // Returns true if it has written temp file named ID.note-temp in Note format in the // NotesDir. Assumes it can write in NotesDir. If FFName provided, saves there instead. // FFName, if provided, must include path and extension and must be writable. function DownloadANote(const NoteID: string; FFName: string = ''): boolean; public //UserName : string; //RemoteRepoName : string; // eg tb_test, tb_notes TokenExpires : string; // Will have token expire date after TestTransport() {$ifdef TESTRIG} // These are all defined in trans, need to provide them is in TestRig mode RemoteServerRev : integer; ServerID : string; ErrorString : string; Password : string; ANewRepo : boolean; ProgressProcedure : TProgressProcedure; RemoteAddress : string; {$endif} (* ------------- Defined in parent class ---------------- Password : string; // A password for those Transports that need one. DebugMode : boolean; ANewRepo : Boolean; // Indicates its a new repo, don't look for remote manifest. ErrorString : string; // Set to '' is no errors. NotesDir, ConfigDir : string; // Local notes directory RemoteAddress : string; // A url to network server or 'remote' file directory for FileSync ServerID : string; { The current server ID. Is set with a successful TestTransport call. } RemoteServerRev : integer; { The current Server Rev, before we upload. Is set with a successful TestTransport call. } *) constructor Create(); destructor Destroy; override; // --------------- Methods required to be here by Trans ---------------- { GitHub - tries to contact Github, testing UserName, Token and tries to scan the remote files putting ID and SHA into RemoteNotes. If WriteNewID is true, tries to create repo first. Does no fill in LCD, will need to be done, note by note later. Might return SyncNetworkError, SyncNoRemoteMan, SyncReady, SyncCredentialError } function TestTransport(const WriteNewServerID: boolean = False): TSyncAvailable; {$ifndef TESTRIG} override;{$endif} { Github : Checks Temp dir, should empty it, ret TSyncReady or SyncBadError Sets RemoteAddress (so must have username available) } function SetTransport() : TSyncAvailable; {$ifndef TESTRIG} override;{$endif} { Github : This is just a stub here, does nothing. We populate RemoteNotes in AssignAction()} function GetRemoteNotes(const NoteMeta : TNoteInfoList; const GetLCD : boolean) : boolean; {$ifndef TESTRIG} override;{$endif} { GitHub : after downloading a note we record its LCDate in RemoteNotes because it will be needed to write the remote manifest a bit later } function DownloadNotes(const DownLoads: TNoteInfoList): boolean; {$ifndef TESTRIG} override;{$endif} function DeleteNote(const ID : string; const ExistRev : integer) : boolean; {$ifndef TESTRIG} override;{$endif} {Github : we expect a list of plain IDs, we update the GUI Progress indicator here. Pass SendNote an ID, downstream look after updating RemoteNotes sha data but we set the LCDate (in RemoteNotes) here. } function UploadNotes(const Uploads: TStringList): boolean; {$ifndef TESTRIG} override;{$endif} {GitHub : Has to make Meta/mainfest.json and README.md. ignores RevNo and the passed manifest, We must have the RemoteMetaData which tells us which notes apply, CDate, LCD etc. Notebooks comes from NoteLister. Must be called after syncing done so it can copy SHA data to RemoteMetaData. Make just a flat index but in future, some sort of notebook organisation. Generate suitable content, upload it, README.md to Github. } function DoRemoteManifest(const RemoteManifest : string; MetaData : TNoteInfoList = nil) : boolean; {$ifndef TESTRIG} override;{$endif} { Github - Downloads indicated note to temp dir, returns FFname is OK The downloaded file should be reusable in this session if its later needed } function DownLoadNote(const ID : string; const RevNo : Integer) : string; {$ifndef TESTRIG} override;{$endif} { Public - but not defined in Trans. Gets passed both Remote and Local MetaData lists, makes changes to only Remote. Relies on RemoteNotes, LocalMeta and NoteLister to fill in all details (inc Action) of all notes that are currently on remote server. Then scans over NoteLister adding any notes it finds that are not already in RemoteMetaData and marks them as SyUploads. Also adds the new NoteLister notes to RemoteNotes if NOT a TestRun.} function AssignActions(RMData, LMData: TNoteInfoList; TestRun: boolean): boolean; procedure Test(); end; // ============================================================================= implementation uses {$if (FPC_FULLVERSION>=30200)} opensslsockets, {$endif} // only available in FPC320 and later {$ifdef LCL} lazlogger, {$endif} // trying to not be dependent on LCL fphttpclient, httpprotocol, base64, LazUTF8, LazFileUtils, fpopenssl, ssockets, {ssockets,} DateUtils, fileutil, CommonMark, import_notes, Note_Lister, TB_Utils, jsontools, ResourceStr; const GitBaseURL='https://github.com/'; BaseURL='https://api.github.com/'; RNotesDir='Notes/'; RMetaDir='Meta/'; RemoteRepoName='tb_notes'; {$ifdef TESTRIG} NotesDir='/home/dbannon/Pascal/GithubAPI/notes/'; UserName='davidbannon'; DebugMode=true; {$endif} TempDir='Temp/'; // see also UserName (eg davidbannon) and RemoteRepoName (eg tb_test) // ================================ TGitNoteList =============================== function TGitNoteList.Get(Index: integer): PGitNote; begin Result := PGitNote(inherited get(Index)); end; procedure TGitNoteList.DumpList(wherefrom: string); var i : integer = 0; {Notebooks,} Format : string = ''; begin SayDebugSafe(''); if Wherefrom <> '' then SayDebugSafe('-------- TransGithub RemoteNotes ' + Wherefrom + '----------'); while i < count do begin case Items[i]^.Format of ffNone : Format := 'not set'; ffEncrypt : Format := 'Encrypt'; ffMarkDown : format := 'Markdown'; end; SayDebugSafe('List - FFName=[' + Items[i]^.FName + '] Sha=' + Items[i]^.Sha + ' LCDate=' + Items[i]^.LCDate); SaydebugSafe(' CDate=' + Items[i]^.CDate + ' Format=' + Format + ' Title=' + Items[i]^.Title + ' Notebooks=' + Items[i]^.Notebooks); inc(i); end; end; constructor TGitNoteList.Create(); begin inherited Create; end; destructor TGitNoteList.Destroy; var i : integer; begin for I := 0 to Count-1 do begin dispose(Items[I]); end; inherited Destroy; end; procedure TGitNoteList.AddNewItem(const FName, Sha: string); var PNote : PGitNote; begin new(PNote); PNote^.FName := Fname; PNote^.Title := ''; PNote^.LCDate := ''; PNote^.CDate := ''; PNote^.Format := ffNone; PNote^.Notebooks := ''; PNote^.sha := Sha; add(PNote); end; function TGitNoteList.Add(AGitNote: PGitNote): integer; begin result := inherited Add(AGitNote); end; procedure TGitNoteList.Add(const FName, Sha: string); var PNote : PGitNote; i : integer = 0; begin while i < count do begin if Items[i]^.FName = FName then begin Items[i]^.Sha := Sha; exit; end; inc(i); end; // OK, must be a new entry new(PNote); PNote^.FName := FName; PNote^.Sha := Sha; PNote^.Title := ''; PNote^.LCDate := ''; PNote^.CDate := ''; PNote^.Format := ffNone; Add(PNote); end; procedure TGitNoteList.InsertData(const FName, Field, Data : string); var //i : integer = 0; P : PGitNote; begin for p in self do begin if p^.FName = FName then begin case Field of 'title' : p^.Title := Data; 'lcdate' : p^.LCDate := Data; 'sha' : p^.Sha := Data; 'cdate' : p^.CDate := Data; // 'format' : p^.Format := Data; 'notebooks' : p^.Notebooks := Data; otherwise SayDebugSafe('TGitNoteList.InserData(s,s,s) asked to insert into nonexisting field : ' + Field); end; exit; end; end; SayDebugSafe('GitHub.InsertData(s,s,s) : Failed to find ' + FName + ' to insert data'); end; procedure TGitNoteList.InsertData(const GitRec : TGitNote); var i : integer = 0; begin if GitRec.FName = '' then begin SayDebugSafe('TGitNoteList.InsertData ERROR received a record with blank FName, Title is ' + GitRec.Title); exit; end; while i < count do begin if Items[i]^.FName = GitRec.FName then begin Items[i]^.Title := GitRec.Title; Items[i]^.CDate := GitRec.CDate; Items[i]^.Format := GitRec.Format; Items[i]^.Notebooks := GitRec.Notebooks; if Items[i]^.Sha = GitRec.Sha then Items[i]^.LCDate := GitRec.LCDate else Items[i]^.LCDate := ''; // note has been edited in Github web interface if Items[i]^.CDate = '' then Items[i]^.CDate := TheNoteLister.GetLastChangeDate(extractFileName(GitRec.FName)); // Leave LCDate as it is, we may fix it with a download later. For now, its not useful. // We could get the commit date (a zulu date) but not sure its worthwhile at this stage. exit; end; inc(i); end; SayDebugSafe('GitHub.InsertData : Failed to find ' + GitRec.FName + ' to insert data'); end; function TGitNoteList.FNameExists(FName: string; out Sha: string): boolean; var i : integer = 0; begin Sha := ''; if FName[length(FName)] = '/' then FName := FName.remove(length(FName)-1); // its part of a URL so don't reverse for windows ! while i < count do begin if Items[i]^.FName = FName then begin Sha := Items[i]^.Sha; exit(True); end; inc(i); end; debugln('TGitNoteList.FNameExists WARNING ? did not find ID=[' + FName +']'); result := False; end; function TGitNoteList.Find(const ID : string): PGitNote; var i : integer = 0; begin while i < count do begin if Items[i]^.FName = RNotesDir + ID + '.md' then // first, assume its a note exit(Items[i]); if Items[i]^.FName = ID then // but also try as if its a FFName exit(Items[i]); inc(i); end; Result := Nil; end; // =========================== T G i t H u b ================================ // ---------------- P U B L I C M E T H O D S ie from Trans ----------------- function TGitHubSync.TestTransport(const WriteNewServerID: boolean): TSyncAvailable; { If we initially fail to find offered user account, try defunkt so we can tell if its a network error or username one. } var St : string; begin Result := SyncNotYet; ErrorString := ''; {$ifdef DEBUG} debugln('TGithubSync.TestTransport - WriteNewServerID is ', booltostr(WriteNewServerID, true)); {$endif} if ANewRepo and WriteNewServerID then // Will fail ? if repo already exists. MakeRemoteRepo(); if RemoteNotes <> Nil then RemoteNotes.Free; RemoteNotes := TGitNoteList.Create(); if ProgressProcedure <> nil then ProgressProcedure(rsTestingCredentials); //debugln('TGithubSync.TestTransport - about to get auth-token-expire'); //debugln('URL=' + BaseURL + 'users/' + UserName); if DownLoader(BaseURL + 'users/' + UserName, ST, 'github-authentication-token-expiration') then begin // So, does nominated user account exist ? if ExtractJSONField(ST, 'login') = UserName then begin // "A" valid username TokenExpires := HeaderOut; //SayDebugSafe('Confirmed login OK'); if TokenExpires = '' then begin ErrorString := 'Username exists but Token Failure'; exit(SyncCredentialError); // Token failure end; // If to here, we have a valid username and a valid Password but don't know if they work together if ProgressProcedure <> nil then progressProcedure(rsLookingServerID); ServerID := GetServerId(); //debugln('TGithubSync.TestTransport : serverID is ' + ServerID); if ServerID = '' then begin ErrorString := 'Failed to get a ServerID, does Token have Repo Scope ?'; exit(SyncNoRemoteRepo) end else begin if ProgressProcedure <> nil then progressProcedure(rsScanRemote); if not ScanRemoteRepo() then exit(SyncBadRemote); // puts only remote filenames and sha in RemoteNotes if (not ReadRemoteManifest()) then begin if (not ANewRepo) and (not WriteNewServerID) then // do not expect a remote manifest in ANewRepo mode. // But if we have had an aborted New process, might mave serverid but no manifest exit(SyncNoRemoteMan) else ANewRepo := True; end; // we MUST detect here where a user is trying to add SelectiveSync to an existing non-selective repo = ERROR. // If remote is already selective, thats OK, it stays that way. If the remote is not selective but readable, // and local system is selective, ERROR. But if we appear to be building a new repo, we will go with // whatever the local system does. { I have two vars, SelectiveSync will hold name of selective NB RemoteManifest has one set. Even if local system does not have that NB (and therefore has no notes suitable). Else its empty. Secondly, we have SelectiveNotebookIDs, a pointer to the local selective NB's list of notes. If there is no local selective NB, then SelectiveNotebookIDs is nil. And we should skip all local files. If the remote repo is not selective but local one is, thats an ERROR. The exception being if the remote repo is being constructed, has serverID perhaps but no remotemanifest, ANewRepo is true, then we follow local policy. REMEMBER - SelectiveNotebookIDs might be nil ! } if TheNoteLister.GetNotesInNoteBook(SelectiveNotebookIDs, SyncTransportName(SyncGithub)) and (SelectiveSync = '') and (not ANewRepo) then begin ErrorString := 'Local is Selective, remote is NOT'; SayDebugSafe(ErrorString + ' probably need build a new remote repo, please read documentation'); exit(SyncMismatch) end; if (SelectiveSync = '') and assigned(SelectiveNotebookIDs) then // Use local 'cos its a new repo. SelectiveSync := SyncTransportName(SyncGithub); {$ifdef DEBUG} debugln('TGitHubSync.TestTransport SelectiveSync=' + SelectiveSync); if not assigned(SelectiveNotebookIDs) then debugln('TGitHubSync.TestTransport SelectiveNotebookIDs not assigned.'); {$endif} Result := SyncReady; if ProgressProcedure <> nil then ProgressProcedure('TestTransport Happy, SelectiveSync=' + SelectiveSync); end; end else SayDebugSafe('TGithubSync.TestTransport - Spoke to Github but did not confirm login'); end else begin if DownLoader(BaseURL + 'users/defunkt', ST) then begin ErrorString := ErrorString + ' Username is not valid : ' + UserName; exit(SyncCredentialError); end else begin // here probably because of a bad token, lets rewrite the error message if pos('401', ErrorString) > 0 then ErrorString := ' ' + rsGithubTokenExpired; exit(SyncNetworkError); end; end; end; function TGitHubSync.SetTransport(): TSyncAvailable; begin if DebugMode then saydebugSafe('TGithubSync.SetTransport - called'); if not directoryexists(NotesDir + TempDir) then ForceDirectory(NotesDir + TempDir); if directoryexists(NotesDir + TempDir) and DirectoryIsWritable(NotesDir + TempDir) then begin result := SyncReady; if not DeleteDirectory(NotesDir + TempDir, True) then Saydebugsafe('TGithubSync.SetTransport ERROR, failed to clear out Temp dir'); // by clearing the Temp dir, we know any files in there later on arrived in // this session and can be safely re-used eg, ones pulled down for clash handling. end else begin SayDebugSafe('Cannot use dir : ' + NotesDir + TempDir); exit(SyncBadError); end; RemoteAddress := GitBaseURL + UserName + '/' + RemoteRepoName; end; function TGitHubSync.DownloadNotes(const DownLoads: TNoteInfoList): boolean; var I : integer; DownCount : integer = 0; FullFileName : string; begin Result := True; if not DirectoryExists(NotesDir + TempDir) then exit(SayDebugSafe('TGithubSync.DownloadNotes - ERROR, no temp dir ' + NotesDir + TempDir)); if ProgressProcedure <> nil then ProgressProcedure(rsDownloadNotes); if not DirectoryExists(NotesDir + 'Backup') then if not ForceDirectory(NotesDir + 'Backup') then begin ErrorString := 'Failed to create Backup directory.'; exit(False); end; for I := 0 to DownLoads.Count-1 do begin if DownLoads.Items[I]^.Action = SyDownLoad then begin if FileExists(NotesDir + Downloads.Items[I]^.ID + '.note') then // First make a Backup copy if not CopyFile(NotesDir + Downloads.Items[I]^.ID + '.note', NotesDir + 'Backup' + PathDelim + Downloads.Items[I]^.ID + '.note') then begin ErrorString := 'GitHub.DownloadNotes Failed to copy file to Backup ' + NotesDir + Downloads.Items[I]^.ID + '.note'; exit(False); end; FullFileName := NotesDir + TempDir + Downloads.Items[I]^.ID + '.note'; if not FileExists(FullFileName) then Result := DownloadANote(Downloads.Items[I]^.ID, FullFileName) // OK, now download the file, else Result := True; // we must have downloaded it to resolve clash if Result and fileexists(FullFileName) then begin // to be sure, to be sure deletefile(NotesDir + Downloads.Items[I]^.ID + '.note'); renamefile(FullFileName, NotesDir + Downloads.Items[I]^.ID + '.note'); end else begin ErrorString := 'GitHub.DownloadNotes Failed to download ' + FullFileName; exit(SayDebugSafe('TGithubSync.DownloadNotes - ERROR, failed to down to ' + FullFileName)); end; inc(DownCount); if (DownCount mod 5 = 0) then if ProgressProcedure <> nil then ProgressProcedure(rsDownLoaded + ' ' + inttostr(DownCount) + ' notes'); end; end; end; function TGitHubSync.DeleteNote(const ID: string; const ExistRev: integer ): boolean; // https://docs.github.com/en/rest/reference/repos#delete-a-file var Response : TStringList; Client: TFPHttpClient; BodyStr, Sha : string; RFName : string; begin Result := false; RFName := RNotesDir + ID + '.md'; if not (RemoteNotes.FNameExists(RFName, Sha) and (Sha <> '')) then begin // Try for an ID first. RFName := ID; if not (RemoteNotes.FNameExists(RFName, Sha) and (Sha <> '')) then // Failing an ID, we try "as is". exit(SayDebugSafe('TGitHubSync.DeleteNote ERROR did not find sha for ' + ID)); end; BodyStr := '{ "message": "update upload", "sha" : "' + Sha + '" }'; Client := TFPHttpClient.create(nil); Response := TStringList.create; try Client.AddHeader('User-Agent','Mozilla/5.0 (compatible; fpweb)'); Client.AddHeader('Content-Type','application/json; charset=UTF-8'); Client.AddHeader('Accept', 'application/json'); Client.AllowRedirect := true; Client.UserName:=UserName; Client.Password:=Password; client.RequestBody := TRawByteStringStream.Create(BodyStr); Client.Delete(ContentsURL(True) + '/' + RFName, Response); Result := (Client.ResponseStatusCode = 200); if not Result then begin saydebugsafe('TGitHubSync.DeleteNote : Delete returned ' + inttostr(Client.ResponseStatusCode)); saydebugsafe('URL=' + ContentsURL(true) + '/' + RFName); saydebugsafe(' ------------- Delete Response ------------'); saydebugsafe(Response.text); saydebugsafe(' ------------- Delete Response End ------------'); end; finally Response.free; Client.RequestBody.Free; Client.Free; end; end; function TGitHubSync.GetRemoteNotes(const NoteMeta: TNoteInfoList; const GetLCD: boolean): boolean; begin if (RemoteNotes = Nil) or (NoteMeta = Nil) then exit(SayDebugSafe('TGitHubSync.GetRemoteNotes ERROR getRemoteNotes called with nil list')); result := True; end; function TGitHubSync.UploadNotes(const Uploads: TStringList): boolean; var St : string; NoteCount : integer = 0; begin {$ifdef DEBUG} RemoteNotes.DumpList('TGitHubSync.UploadNotes : About to upload ' + inttostr(UpLoads.Count) + ' notes'); {$endif} if ProgressProcedure <> nil then ProgressProcedure(rsUpLoading + ' ' + inttostr(Uploads.Count)); for St in Uploads do begin if not SendNote(St) then exit(false); inc(NoteCount); if NoteCount mod 5 = 0 then if ProgressProcedure <> nil then ProgressProcedure(rsUpLoaded + ' ' + inttostr(NoteCount) + ' notes'); RemoteNotes.InsertData(RNotesDir + St + '.md', 'lcdate', TheNoteLister.GetLastChangeDate(St)); // ToDo : that has hardwired assumpltion about markdown end; result := true; end; function TGitHubSync.DoRemoteManifest(const RemoteManifest: string; MetaData: TNoteInfoList): boolean; var P : PNoteInfo; // an item from RemoteMetaData PGit : PGitNote; // an item from local data structure, RemoteNotes Readme, manifest : TStringList; St, Notebooks : string; begin // Note : we do not use the supplied XML RemoteManifest, we build our own json one. Result := false; Readme := TstringList.Create; Manifest := TstringList.Create; Readme.Append('## My tomboy-ng Notes'); // * [Note Title](https://github.com/davidbannon/tb_demo/blob/main/Notes/287CAB9C-A75F-4FAF-A3A4-058DDB1BA982.md) Manifest.Append('{' + #10' "selectivesync" : "' + EscapeJSON(SelectiveSync) + '",'#10' "notes" : {'); try if MetaData = nil then exit(SayDebugSafe('TGithubSync.DoRemoteManifest ERROR, passed a nil metadata list')); for P in MetaData do begin if P^.Action in [ SyNothing, SyUploadNew, SyUploadEdit, SyDownload, SyClash ] then begin // SyClash ? I don't think so ..... // These notes will be the ones that end up on GitHub after we finish. PGit := RemoteNotes.Find(P^.ID); if PGit = nil then exit(SayDebugSafe('TGitHubSync.DoRemoteManifest - ERROR, failed to find ID from RemoteMetaData in RemoteNotes')); Readme.Append('* [' + P^.Title + '](' + ContentsURL(False) + PGit^.FName + ')'); if P^.Action = SyDownload then NoteBooks := PGit^.Notebooks else NoteBooks := TheNoteLister.NotebookJArray(P^.ID + '.note'); Manifest.Append(' "' + P^.ID + '" : {'#10 + ' "title" : "' + EscapeJSON(P^.Title) + '",'#10 + ' "cdate" : "' + P^.CreateDate + '",'#10 + ' "lcdate" : "' + PGit^.LCDate + '",'#10 + ' "sha" : "' + PGit^.Sha + '", '#10 + ' "format" : "md",'#10 + ' "notebooks" : '+ NoteBooks + #10 + ' },'); // should be empty string or eg ["one", "two"] end; end; // Remove that annoying trailing comma from last block if manifest.count > 0 then begin St := manifest[manifest.count-1]; if St[St.Length] = ',' then begin delete(St, St.Length, 1); manifest.Delete(manifest.count-1); manifest.append(St); end; end; Readme.append(''); Readme.append('*** ' + rsMetaDirWarning + ' ***'); Manifest.Append(' }'#10 + '}'#10); for PGit in RemoteNotes do // Put all the SHAs we know about into RemoteMetaData (for local manifest); if PGit^.Sha <> '' then begin P := MetaData.FindID(extractFileNameOnly(PGit^.FName)); if P <> nil then P^.Sha := PGit^.Sha; end; if not SendFile(RMetaDir + 'manifest.json', Manifest) then SayDebugSafe('TGitHubSync.DoRemoteManifest ERROR, failed to write remote manifest'); if not SendFile('README.md', Readme) then SayDebugSafe('TGitHubSync.DoRemoteManifest ERROR, failed to write remote README'); result := true; finally Manifest.Free; Readme.Free; end; end; function TGitHubSync.DownLoadNote(const ID: string; const RevNo: Integer): string; begin if DownloadANote(ID, NotesDir + TempDir + ID + '.note') then Result := NotesDir + TempDir + ID + '.note' else Result := ''; end; // ToDo : work through this better, are we risking race conditions here ? const Seconds5 = 0.00005; // Very roughly, 5 seconds function TGitHubSync.MergeNotesFromNoteLister(RMData : TNoteInfoList; TestRun: boolean) : boolean; var PGit : PGitNote; RemRec: PNoteInfo; NLister : PNote; i : integer; begin if (SelectiveSync <> '') and (not Assigned(SelectiveNotebookIDs)) then // Something in SelectiveSync but no local NB, no uploads possible exit(false); for i := 0 to TheNoteLister.GetNoteCount() -1 do begin // OK, now whats in NoteLister but not RemoteNotes ? NLister := TheNoteLister.GetNote(i); // debugln('TGitHubSync.MergeNotesFromNoteLister considering Title=' + NLister^.Title); if NLister = nil then exit(SayDebugSafe('TGitHubSync.AssignActions ERROR - not finding NoteLister Content')); // if I can be sure it really does sort the (NoteLister's) list with SelectiveNotebookIDs.sorted := true. // Calling SelectiveNotebookIDs.Sort does not seem to work ?? // we know we can safely poke at SelectiveNotebookIDs if SelectiveSync is not empty. if (SelectiveSync <> '') and (FindInStringList(SelectiveNotebookIDs, NLister^.ID) < 0) then continue; // Look for items in NoteLister that do not currently exist in RemoteMetaData. If we find one, // we will add it to both RemoteMetaData and RemoteNodes (because its needed to store sha on upload) // debugln('TGitHubSync.MergeNotesFromNoteLister Adding Title=' + NLister^.Title); if RMData.FindID(extractfilenameonly(NLister^.ID)) = nil then begin if not TestRun then begin new(PGit); PGit^.FName := RNotesDir + extractfilenameonly(NLister^.ID) + '.md'; // ToDo : Careful, assumes markdown PGit^.Sha := ''; PGit^.Notebooks := ''; PGit^.CDate := NLister^.CreateDate; PGit^.LCDate := NLister^.LastChange; PGit^.Format := ffMarkDown; RemoteNotes.Add(PGit); end; new(RemRec); RemRec^.ID := extractfilenameonly(NLister^.ID); RemRec^.LastChange := NLister^.LastChange; RemRec^.CreateDate := NLister^.CreateDate; RemRec^.Sha := ''; RemRec^.Title := NLister^.Title; RemRec^.Action := SyUploadNew; RemRec^.Deleted := False; RemRec^.Rev := 0; RemRec^.SID := 0; RMData.Add(RemRec); end { else debugln('TGithubSync.AssignActions - skiping because its already in RemoteNotes')}; end; Result := true; end; function TGitHubSync.AssignActions(RMData, LMData: TNoteInfoList; TestRun: boolean): boolean; var PGit : PGitNote; RemRec, LocRec : PNoteInfo; I : integer; //NLister : PNote; pNBook: PNoteBook; LCDate, CDate : string; begin // RMData should be empty, LMData will be empty if its a Join. Result := True; {$ifdef DEBUG} debugln('=================================================================='); debugln(' A S S I G N A C T I O N S '); debugln('=================================================================='); RMData.DumpList('TGithubSync.AssignActions.start RemoteMD'); LMData.DumpList('TGithubSync.AssignActions.start LocalMD'); RemoteNotes.DumpList('TGithubSync.AssignActions.start RemoteNotes'); {$endif} for PGit in RemoteNotes do begin // First, put an entry in RemoteMetaData for every remote note. if copy(PGit^.FName, 1, length(RNotesDir)) <> RNotesDir then continue; // Every note we see in this loop exists remotely. But may not exist locally. new(RemRec); RemRec^.ID := extractFileNameOnly(PGit^.FName); LocRec := LMData.FindID(RemRec^.ID); // Nil is OK, just means the note is not in LocalMetaData RemRec^.CreateDate := PGit^.CDate; RemRec^.LastChange := PGit^.LCDate; // We may not have this, if note was edited in github RemRec^.Deleted := false; RemRec^.Rev := 0; RemRec^.SID := 0; RemRec^.Title := TheNoteLister.GetTitle(RemRec^.ID); // We 'prefer' the local title, remote one may be different if RemRec^.Title = '' then RemRec^.Title := TheNoteLister.GetNotebookName(RemRec^.ID); // Maybe its a template ? RemRec^.Action := SyUnset; if RemRec^.Title = '' then begin // Not in Notelister, must be new or locally deleted //debugln('TGithubSync.AssignActions setting ' + RemRec^.ID + ' to Download #1'); RemRec^.Action := SyDownLoad; // May get changed to SyDeleteRemote RemRec^.Title := PGit^.Title; // One we prepared earlier, from remote manifest {$ifdef DEBUG} //SayDebugSafe('TGithubSync.AssignActions RemRec^.Title = ' + RemRec^.Title); //SayDebugSafe('TGithubSync.AssignActions PGit^.Title = ' + PGit^.Title); {$endif} end else begin // OK, it exists at both ends, now we need to look closely. //debugln('TGithubSync.AssignActions - Possibe clash LMData.LastSyncDate UTC= ' + FormatDateTime('YYYY MM DD : hh:mm', LMData.LastSyncDate )); if LMData.LastSyncDate < 1.0 then begin // Not valid // if LastSyncDate is 0.0, a Join. An ID that exists at both ends is a clash. No local manifest to help here. // But we have one more trick. If the remote note has a valid LCDate in RemoteNotes, it came from a -ng // (ie, not a Github edit). We can compare the date string to the local one and if they match, all good. if (PGit^.LCDate <> '') and (TheNoteLister.GetLastChangeDate(RemRec^.ID) = PGit^.LCDate) then RemRec^.Action := SyNothing else RemRec^.Action := SyClash; // OK, we tried but this one goes through to keeper. //debugln('TGithubSync.AssignActions - found possible JOIN clash, now its ' + RMData.ActionName(RemRec^.Action)); //debugln('PGit^.LCDate = ' + PGit^.LCDate + ' and TheNoteLister.GetLastChangeDate = ' + LocalLastChangeDate(RemRec^.ID + '.note')); end else begin // Normal sync, we have a local manifest. if (TB_GetGMTFromStr(TheNoteLister.GetLastChangeDate(RemRec^.ID)) - Seconds5) > LMData.LastSyncDate then RemRec^.Action := SyUploadEdit; // changed since last sync ? Upload it ! if LocRec = Nil then begin // ?? If it exists at both ends we must have uploaded it ?? dispose(RemRec); ErrorString := 'TGitHubSync.AssignActions ERROR, ID not found in LocalMetaData, might need to force a Join.'; exit(SayDebugSafe(ErrorString)); end else if PGit^.Sha <> LocRec^.Sha then begin // Ah, its been changed remotely if RemRec^.Action = SyUnset then begin //debugln('TGithubSync.AssignActions setting ' + RemRec^.ID + ' to Download #2'); //debugln('PGit^.Sha=' + PGit^.Sha + ' and LocRec^.Sha=' + LocRec^.Sha); RemRec^.Action := SyDownLoad // Good, only remotely end else begin RemRec^.Action := SyClash; // There is a problem to solve elsewhere. //debugln('TGitHubSync.AssignActions - assigning clash'); //debugln('sha from remote=' + PGit^.Sha + ' and local=' + LocRec^.Sha); end; end; end; //debugln('TGithubSync.AssignActions - Possibe clash becomes ' + RMData.ActionName(RemRec^.Action)); end; if RemRec^.Action = SyUnset then RemRec^.Action := SyNothing; RMData.Add(RemRec); end; {$ifdef DEBUG} RMData.DumpList('TGithubSync.AssignActions RemoteMD - Before scanning NoteLister'); {$endif} MergeNotesFromNoteLister(RMData, TestRun); // OK, just need to check over the Notebooks now, notebooks are NOT listed in NoteLister.Notelist ! for i := 0 to TheNoteLister.NotebookCount() -1 do begin pNBook := TheNoteLister.GetNoteBook(i); if (SelectiveSync <> '') and (SelectiveSync <> pNBook^.Name) then // only interested in SyncGithub template here.... continue; if RMData.FindID(extractfilenameonly(pNBook^.Template)) = nil then begin ErrorString := ''; CDate := GetNoteLastChangeSt(NotesDir + pNBook^.Template, ErrorString, True); LCDate := GetNoteLastChangeSt(NotesDir + pNBook^.Template, ErrorString, False); if ErrorString <> '' then exit(SayDebugSafe('Failed to find dates in template ' + pNBook^.Template)); if not TestRun then begin new(PGit); PGit^.FName := RNotesDir + extractfilenameonly(pNBook^.Template) + '.md'; // ToDo : Careful, assumes markdown PGit^.Sha := ''; PGit^.Notebooks := ''; PGit^.CDate := CDate; PGit^.LCDate := LCDate; PGit^.Format := ffMarkDown; RemoteNotes.Add(PGit); end; new(RemRec); RemRec^.ID := extractfilenameonly(pNBook^.Template); RemRec^.LastChange := LCDate; RemRec^.CreateDate := CDate; RemRec^.Sha := ''; RemRec^.Title := pNBook^.Name; RemRec^.Action := SyUploadNew; RemRec^.Deleted := False; RemRec^.Rev := 0; RemRec^.SID := 0; RMData.Add(RemRec); end {else debugln('TGithubSync.AssignActions - skiping because its already in RemoteNotes')}; end; {$ifdef DEBUG} RMData.DumpList('TGithubSync.AssignActions.End RemoteMD'); LMData.DumpList('TGithubSync.AssignActions.End LocalMD'); RemoteNotes.DumpList('TGithubSync.AssignActions.End RemoteNotes'); {$endif} end; procedure TGitHubSync.Test(); var ST : string; begin if Downloader(ContentsURL(True)+'/'+RNotesDir, ST) then begin // Github appears to be happy with Notes and Notes/ ? debugln('---------------------------------------------'); debugln(St); debugln('---------------------------------------------'); end else debugln('Downloader Failed'); end; // ==================== P R I V A T E M E T H O D S ========================= function TGitHubSync.GetNoteLCD(FFName : string) : string; var St : string; URL : string; begin Result := ''; // This call brings back an array, '[one-record]', note its not the Contents URL ! URL := BaseURL + 'repos/' + UserName + '/' + RemoteRepoName + '/'; if DownLoader(URL + 'commits?path=' + FFName + '&per_page=1&page=1', ST) then begin if St[1] = '[' then begin delete(St, 1, 1); end else SayDebugSafe('GitHub.GetNoteLCD - Error, failed to remove from array'); if St[St.Length] = ']' then begin delete(St, St.Length, 1); end else SayDebugSafe('GetNoteLCD - Error, failed to remove [ from array'); Result := ExtractJSONField(St, 'date', 'commit', 'author'); if (Result = '') or (Result[1] = 'E') then // E for ERROR SayDebugSafe('TGitHubSync.GetNoteLCD ERROR failed to find commit date in JSON ' + St + ' for file ' + FFName); end; end; function TGitHubSync.SendNote(ID: string): boolean; var STL : TStringList; CM : TExportCommon; begin STL := TStringList.Create; CM := TExportCommon.Create; try CM.NotesDir := NotesDir; CM.GetMDcontent(ID, STL); if STL.Count < 1 then exit(False); Result := SendFile(RNotesDir + ID + '.md', STL); finally CM.Free; STL.Free; end; end; function TGitHubSync.SendFile(RemoteFName: string; STL: TstringList): boolean; // Public only in test mode var Sha : string = ''; BodyStr : string; begin if RemoteNotes = nil then exit(false); if RemoteNotes.FNameExists(RemoteFName, Sha) and (Sha <> '') then begin // Existing file mode BodyStr := '{ "message": "update upload", "sha" : "' + Sha + '", "content": "' + EncodeStringBase64(STL.Text) + '" }'; if Sha = '' then exit(False); end else begin // New file mode BodyStr := '{ "message": "initial upload", "content": "' + EncodeStringBase64(STL.Text) + '" }'; end; Result := SendData(ContentsURL(True) + '/' + RemoteFName, BodyStr, true, RemoteFName); end; function TGitHubSync.MakeRemoteRepo(): boolean; var GUID : TGUID; STL: TstringList; begin // https://docs.github.com/en/rest/reference/repos#create-a-repository-for-the-authenticated-user {$ifdef DEBUG} SayDebugSafe('TGitHubSync.MakeRemoteRepo called'); {$endif} Result := SendData(BaseURL + 'user/repos', '{ "name": "' + RemoteRepoName + '", "auto_init": true, "private": true" }', False); if (not Result) and (GetServerId() <> '') then exit(false); {$ifdef DEBUG} SayDebugSafe('TGitHubSync.MakeRemoteRepo creating new ServerID'); {$endif} CreateGUID(GUID); STL := TstringList.Create; try ServerID := copy(GUIDToString(GUID), 2, 36); // it arrives here wrapped in {} STL.Add(ServerID); Result := SendFile(RMetaDir + 'serverid', STL); // Now, RemoteNotes does not exist at this stage !! // URL=https://api.github.com/repos/davidbannon/tb_test/contents/Meta/serverid finally STL.Free; end; {$ifdef DEBUG} SayDebugSafe('TGitHubSync.MakeRemoteRepo returning ' + booltostr(Result, True)); {$endif} //RemoteServerRev := -1; end; function TGitHubSync.ScanRemoteRepo(): boolean; var Node, ANode : TJsonNode; St, Sha : string; function ReadDir(Dir : string) : boolean; begin Result := True; if (Dir <> '') and (not RemoteNotes.FNameExists(Dir, Sha)) then exit; if Downloader(ContentsURL(True) + Dir, ST) then begin // St now contains a full dir listing as JSON array Node := TJsonNode.Create; try if Node.TryParse(St) then begin for ANode in Node do if ANode.Exists('name') and ANode.Exists('sha') then RemoteNotes.AddNewItem(Dir + ANode.Find('name').asString, ANode.Find('sha').asString) else exit(SayDebugSafe('TGitHubSync.ScanRemoteRepo - ERROR Invalid J data = ' + St)); end else exit(SayDebugSafe('TGitHubSync.ScanRemoteRepo - ERROR Invalid J data = ' + St)); finally Node.Free; end; end else exit(SayDebugSafe('TGitHubSync.ScanRemoteRepo - Download ERROR ' + Dir)); end; begin Result := ReadDir('') and ReadDir(RNotesDir) and ReadDir(RMetaDir); {$ifdef DEBUG} RemoteNotes.DumpList('TGitHubSync.ScanRemoteRepo RemoteNotes after Scan.'); {$endif} end; constructor TGitHubSync.Create(); begin ProgressProcedure := nil; // It gets passed after create. RemoteNotes := Nil; SelectiveNotebookIDs := nil; end; destructor TGitHubSync.Destroy; begin if RemoteNotes <> Nil then RemoteNotes.Free; inherited Destroy; end; function TGitHubSync.DownloadANote(const NoteID: string; FFName: string): boolean; var NoteSTL : TStringList; St : string; Importer : TImportNotes; PGit : PGitNote; begin Importer := Nil; NoteSTL := Nil; Result := True; {$ifdef DEBUG}Saydebugsafe('TGithubSync.DownloadANote');{$endif} try PGit := RemoteNotes.Find(RNotesDir + NoteID + '.md'); // ToDo : assumes markdown if PGit = nil then exit(SayDebugSafe('TGithubSync.DownloadANote - ERROR, cannot find ID in RemoteNotes = ' + RNotesDir + NoteID + '.md')); if PGit^.LCDate = '' then begin // maybe because note was edited in github and remote manifest LCD was unusable PGit^.LCDate := GetNoteLCD(PGit^.FName); // debugln(' TGithubSync.DownloadANote gethub edited note has date of ' + PGit^.LCDate); // TEST THIS !!!! end; if not Downloader(ContentsURL(True) + '/' + RNotesDir + NoteID + '.md', ST) then exit(SayDebugSafe('TGithubSync.DownloadANote ERROR, failed to download note : ' + NoteID)); {$ifdef DEBUG}Saydebugsafe('TGithubSync.DownloadANote downloaded OK ' + NoteID);{$endif} NoteSTL := TStringList.Create; NoteSTL.Text := DecodeStringBase64(ExtractJSONField(ST, 'content')); {$ifdef DEBUG}Saydebugsafe('TGithubSync.DownloadANote decoded');{$endif} if NoteSTL.Count > 0 then begin Importer := TImportNotes.Create; { if length(PGit^.Notebooks) > 5 then Saydebugsafe('TGithubSync.DownloadANote Using Notebook = ' + PGit^.Notebooks); } Importer.NoteBook := PGit^.Notebooks; {$ifdef DEBUG}Saydebugsafe('TGithubSync.DownloadANote about to import');{$endif} Importer.MDtoNote(NoteSTL, PGit^.LCDate, PGit^.CDate); {$ifdef DEBUG}Saydebugsafe('TGithubSync.DownloadANote imported');{$endif} // writeln(NoteSTL.TEXT); if FFName = '' then NoteSTL.SaveToFile(NotesDir + NoteID + '.note-temp') else NoteSTL.SaveToFile(FFname); {$ifdef DEBUG}Saydebugsafe('TGithubSync.DownloadANote file saved');{$endif} end else Result := false; finally if Importer <> Nil then Importer.Free; if NoteSTL <> Nil then NoteSTL.Free; //STL.Free; end; {$ifdef DEBUG}Saydebugsafe('TGithubSync.DownloadANote finished');{$endif} end; function TGitHubSync.ReadRemoteManifest(): boolean; var St : string; Node, ANode, NotesNode : TJsonNode; PGit : PGitNote; begin if RemoteNotes.Find(RMetaDir + 'manifest.json') = nil then exit(SayDebugSafe('Remote manifest not present, maybe a new repo ?')); if not Downloader(ContentsURL(True) + '/' + RMetaDir + 'manifest.json', ST) then exit(SayDebugSafe('GitHub.ReadRemoteMainfest : Failed to read the remote manifest file')); {$ifdef DEBUG} RemoteNotes.DumpList('TGithubSync.ReadRemoteManifest - Before ReadRemoteManifest'); {$endif} Node := TJsonNode.Create; try // content is in the "content" field, Base64 encoded. if not Node.TryParse(DecodeStringBase64(ExtractJSONField(ST, 'content'))) then exit(SayDebugSafe('TGitHubSync.ReadRemoteManifest ERROR invalid JSON : ' + ST)); if Node.Exists('selectivesync') then SelectiveSync := Node.Find('selectivesync').AsString; NotesNode := Node.Find('notes'); if NotesNode = nil then exit(SayDebugSafe('TGitHubSync.ReadRemoteManifest ERROR invalid JSON, notes not present : ' + ST)); for ANode in NotesNode do begin if ANode.Exists('title') and ANode.exists('lcdate') and ANode.Exists('cdate') and ANode.Exists('format') and ANode.Exists('sha') and ANode.Exists('notebooks') then begin PGit := RemoteNotes.Find(ANode.Name); // note, we pass an ID withoout path, Find adds Path internally if PGit = nil then exit(SayDebugSafe('TGitHubSync.ReadRemoteManifest ERROR invalid JSON, FName not present in RemoteNotes : ' + ANode.AsString)); //PGit^.FName := ANode.Name; PGit^.Title := ANode.Find('title').AsString; PGit^.CDate := ANode.Find('lcdate').AsString; if ANode.Find('format').AsString = 'md' then PGit^.Format := ffMarkDown else PGit^.Format := ffEncrypt; if PGit^.Sha = ANode.Find('sha').AsString then PGit^.LCDate := ANode.Find('lcdate').AsString; PGit^.Notebooks := ANode.Find('notebooks').AsJSON.Remove(0,12); // "notebooks" : ["Notebook1","Notebook2", "Notebook3"] // PGit^.Notebooks := ANode.Find('notebooks').AsArray.AsJson; end; end; finally Node.free; end; {$ifdef DEBUG} RemoteNotes.DumpList('TGithubSync.ReadRemoteManifest - After ReadRemoteManifest'); {$endif} end; function TGitHubSync.GetServerId(): string; var St : string; begin Result := ''; if Downloader(ContentsURL(True) + '/' + RMetaDir + 'serverid', ST) then Result := DecodeStringBase64(self.ExtractJSONField(ST, 'content')); Result := Result.Replace(#10, ''); Result := Result.Replace(#13, ''); //debugln('TGithubSync.GetServerId = [' + Result + ']'); end; function TGitHubSync.Downloader(URL: string; out SomeString: String; const Header: string): boolean; var Client: TFPHttpClient; begin //InitSSLInterface; // curl -i -u $GH_USER https://api.github.com/repos/davidbannon/libappindicator3/contents/README.note Client := TFPHttpClient.Create(nil); Client.UserName := UserName; Client.Password := Password; // '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'; Client.AddHeader('User-Agent','Mozilla/5.0 (compatible; fpweb)'); Client.AddHeader('Content-Type','application/json; charset=UTF-8'); Client.AllowRedirect := true; SomeString := ''; try try SomeString := Client.Get(URL); except on E: ESocketError do begin ErrorString := 'Github.Downloader ' + E.Message; exit(SayDebugSafe(ErrorString)); end; on E: EInOutError do begin ErrorString := 'Github Downloader - InOutError ' + E.Message; exit(SayDebugSafe(ErrorString)); end; on E: ESSL do begin ErrorString := 'Github.Downloader -SSLError ' + E.Message; exit(SayDebugSafe(ErrorString)); end; on E: Exception do begin ErrorString := 'GitHub.Downloader Exception ' + E.Message + ' downloading ' + URL; case Client.ResponseStatusCode of 401 : ErrorString := ErrorString + ' 401 Maybe your Token has expired or password is invalid ??'; 404 : ErrorString := ErrorString + ' 404 File not found ' + URL; end; exit(SayDebugSafe(ErrorString)); end; end; with Client.ResponseHeaders do begin if Header <> '' then begin if IndexOfName(Header) <> -1 then HeaderOut := ValueFromIndex[IndexOfName(Header)] else HeaderOut := ''; end; end; finally Client.Free; end; result := true; end; function TGitHubSync.SendData(const URL, BodyJSt: String; Put: boolean; FName: string): boolean; var Client: TFPHttpClient; Response : TStringStream; begin Result := false; //SayDebugSafe('TGitHubSync.SendData - Posting to ' + URL); Client := TFPHttpClient.Create(nil); Client.AddHeader('User-Agent','Mozilla/5.0 (compatible; fpweb)'); Client.AddHeader('Content-Type','application/json; charset=UTF-8'); Client.AddHeader('Accept', 'application/json'); Client.AllowRedirect := true; Client.UserName:=UserName; Client.Password:=Password; client.RequestBody := TRawByteStringStream.Create(BodyJSt); Response := TStringStream.Create(''); try try if Put then begin client.Put(URL, Response); //DumpJSON(Response.DataString, 'SendData just after PUT'); if FName <> '' then // if FName is provided, is uploading a file // RemoteNotes.Add(FName, ExtractJSONField(Response.DataString, 'sha', 0)); RemoteNotes.Add(FName, ExtractJSONField(Response.DataString, 'sha', 'content')); end else client.Post(URL, Response); // don't use FormPost, it messes with the Content-Type value if (Client.ResponseStatusCode = 200) or (Client.ResponseStatusCode = 201) then Result := True else begin SayDebugSafe('GitHub.SendData : Post ret ' + inttostr(Client.ResponseStatusCode)); SayDebugSafe(Client.ResponseStatusText); end; except on E:Exception do begin ErrorString := 'GitHub.SendData - bad things happened : ' + E.Message; exit(SayDebugSafe(ErrorString)); end; end; finally Client.RequestBody.Free; Client.Free; Response.Free; end; end; function TGitHubSync.ContentsURL(API: boolean): string; begin if API then Result := BaseURL + 'repos/' + UserName + '/' + RemoteRepoName + '/contents' else Result := GITBaseURL + UserName + '/' + RemoteRepoName + '/blob/main/'; end; // -------------------- J S O N T O O L S ------------------------------------ // Returns content asociated with Field at either toplevel or if there are up to // two level names, that field down up to two fields down. Level1 is upper .... function TGitHubSync.ExtractJSONField(const data, Field : string; Level1 : string = ''; Level2 : string = '') : string; var Node, ANode : TJsonNode; begin result := ''; Node := TJsonNode.Create; ANode := Node; // Don't change Node, free will not be able to find it. try if not Node.TryParse(data) then exit('Failed to parse data'); if Level1 <> '' then ANode := ANode.Find(Level1); if ANode = nil then exit('ERROR - field not found 1 : ' + Level1); if Level2 <> '' then ANode := ANode.Find(Level2); if ANode = nil then exit('ERROR - field not found 2 : ' + Level2); ANode := ANode.Find(Field); if ANode = nil then result := 'ERROR - field not found 3 : ' + Field else result := ANode.AsString; finally Node.Free; end; end; (* WARNING this uses FPjson, needs to be rewritten before use. procedure TGitHubSync.DumpJSON(const St: string; WhereFrom: string); var jData : TJSONData; begin if Wherefrom <> '' then SayDebugSafe('------------ Dump from ' + Wherefrom + '-------------'); JData := GetJSON(St); SayDebugSafe('---------- JSON ------------'); SayDebugSafe(jData.FormatJSON); SayDebugSafe('----------------------------'); JData.Free; end; *) end. // ============================================================================= // ============================================================================= // ============================================================================= { Notebook Syntax - --------------- A note not in any notebooks - A notebook template - system:template system:notebook:MacStuff A note in a notebook - system:notebook:MacStuff } // ========================= J S O N R E S P O N S E S ====================== (* ----------- Commit response ----------------- { "sha" : "fb1dfecbc50329c7bedfc9ae00ba522bc3bd8536", "node_id" : "MDY6Q29tbWl0Mzk0NTAzNTYxOmZiMWRmZWNiYzUwMzI5YzdiZWRmYzlhZTAwYmE1MjJiYzNiZDg1MzY=", "commit" : { "author" : { "name" : "blar", "email" : "blar", "date" : "2021-08-11T04:09:43Z" .... quite a lot more follows ... ..... *) (* ---------- This is the directory listing, in this case, of Notes. Note its ---------- an array, wrapped in [], one array element per file or dir found. We need only Name and sha. [{ "name" :"06c8c753-77df-4b0f-a855-3d1416ef0260.md", "path" :"Notes/06c8c753-77df-4b0f-a855-3d1416ef0260.md", "sha" :"f11b48e4204e442759d1250a39c6d4a683f634f3", "size" :6323, "url" :"https://api.github.com/repos/davidbannon/tb_test/contents/Notes/06c8c753-77df-4b0f-a855-3d1416ef0260.md?ref=main", "html_url":"https://github.com/davidbannon/tb_test/blob/main/Notes/06c8c753-77df-4b0f-a855-3d1416ef0260.md", "git_url" :"https://api.github.com/repos/davidbannon/tb_test/git/blobs/f11b48e4204e442759d1250a39c6d4a683f634f3", "download_url":"https://raw.githubusercontent.com/davidbannon/tb_test/main/Notes/06c8c753-77df-4b0f-a855-3d1416ef0260.md?token=ABP76MGKOA3EL4QAG5VQSVLBIRS3Q", "type":"file", "_links" : { "self":"https://api.github.com/repos/davidbannon/tb_test/contents/Notes/06c8c753-77df-4b0f-a855-3d1416ef0260.md?ref=main", "git" :"https://api.github.com/repos/davidbannon/tb_test/git/blobs/f11b48e4204e442759d1250a39c6d4a683f634f3", "html":"https://github.com/davidbannon/tb_test/blob/main/Notes/06c8c753-77df-4b0f-a855-3d1416ef0260.md" } }, .... .... ] *) (* ----------------- Remote Manifest ------------------ { "notes" : { "903C31B1-229E-44E6-8FA3-EAAD53ED3E77" : { "title" : "Man Pages", "cdate" : "2021-08-01T19:13:24.7238449+10:00", "lcdate" : "2021-08-04T20:13:10.1153643+10:00", "sha" : "1c3b3dd579f8e46481fd5b5c93044d1c50448f4c", "format" : "md", "notebooks" : ["template", "Man Pages"] }, "B4B75FFE-996B-4D9A-B978-71D55427C7F1" : { "title" : "Installing LazarusCross Compiler", "cdate" : "2018-01-29T11:21:07.8490000+11:00", "lcdate" : "2021-09-15T11:42:00.4447428+10:00", "sha" : "96d4a70f065a92e099e4129f8bc9d3f3e568e4bc", "format" : "md", "notebooks" : [] }, ..... ..... } *) tomboy-ng_0.34-1/source/markdown.lfm0000644000175000017500000000464614145033507017251 0ustar dbannondbannonobject FormMarkdown: TFormMarkdown Left = 248 Height = 462 Top = 159 Width = 821 Caption = 'FormMarkdown' ClientHeight = 462 ClientWidth = 821 OnActivate = FormActivate OnShow = FormShow LCLVersion = '2.1.0.0' object Memo1: TMemo AnchorSideLeft.Control = Owner AnchorSideTop.Control = Panel1 AnchorSideTop.Side = asrBottom AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = ButtonClose Left = 0 Height = 387 Top = 50 Width = 821 Anchors = [akTop, akLeft, akRight, akBottom] Lines.Strings = ( 'Memo1' ) ScrollBars = ssAutoVertical TabOrder = 0 end object Panel1: TPanel AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom Left = 0 Height = 50 Top = 0 Width = 821 Anchors = [akTop, akLeft, akRight] Caption = 'Markdown Exporter' Font.Height = 20 ParentFont = False TabOrder = 1 end object ButtonClose: TButton AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 746 Height = 25 Top = 437 Width = 75 Anchors = [akRight, akBottom] Caption = 'Close' OnClick = ButtonCloseClick TabOrder = 2 end object ButtonCopyAll: TButton AnchorSideRight.Control = ButtonClose AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 671 Height = 25 Top = 437 Width = 75 Anchors = [akRight, akBottom] Caption = 'Copy All' OnClick = ButtonCopyAllClick TabOrder = 3 end object ButtonSave: TButton AnchorSideRight.Control = ButtonCopyAll AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 596 Height = 25 Top = 437 Width = 75 Anchors = [akRight, akBottom] Caption = 'Save' OnClick = ButtonSaveClick TabOrder = 4 end object Label1: TLabel AnchorSideRight.Control = ButtonSave AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 393 Height = 19 Top = 441 Width = 190 Anchors = [akRight, akBottom] BorderSpacing.Right = 13 BorderSpacing.Bottom = 2 Caption = 'Press Ctrl-A, Ctrl-C to copy' ParentColor = False end object SaveDialog1: TSaveDialog Left = 510 Top = 306 end end tomboy-ng_0.34-1/source/mainunit.lfm0000644000175000017500000006065014145033507017250 0ustar dbannondbannonobject MainForm: TMainForm Left = 653 Height = 263 Hint = 'If the yellow tomboy-ng icon is visible in your System Tray, you can dismiss this window.' Top = 194 Width = 460 Caption = 'tomboy-ng' ClientHeight = 263 ClientWidth = 460 OnClose = FormClose OnCreate = FormCreate OnDestroy = FormDestroy OnKeyDown = FormKeyDown OnResize = FormResize OnShow = FormShow LCLVersion = '2.3.0.0' object ImageNotesDirTick: TImage AnchorSideTop.Control = LabelNotesFound Left = 24 Height = 18 Top = 70 Width = 18 Picture.Data = { 1754506F727461626C654E6574776F726B477261706869631E02000089504E47 0D0A1A0A0000000D494844520000001200000012080600000056CE8E57000000 32695458744465736372697074696F6E000100000078DA4B5448CE484DCE56C8 4D2CCA5648CC4B514854482ECA2F2E060B000095390A3495891EA60000000473 424954080808087C0864880000019749444154388DA5D0CF2BE4711CC7F1E730 6D0C22318C0B6DC248898C03263F929264C6CCC9D59FE0B6873D3BC9EDFBF163 E4A01C8861C45CA444324A0AED8E3DEC2E11B71529F39DF9BEF7C0C6C14EBE5F EFEBFBDDE3FD7ABFC16A69E4382384ED21BA2D1B28F22AB6D8F1EB48E3297FD0 70675840B2CBAB586BF0D2AA27E0EA37516CFC348BD85C1B2CF81248FF03E28C 3083C27C98FC05BEF4DD213E1D298BB28C22D334629BA4C57B811E3090CA5D8E D0709846D0C872C7880705F1C4B94551691E010A16F93AF088F4DE228E39862D 2168B83C71EE030652B1C526CA1A43F12AE38329A4ED1C1D45DDFF271505256B 6C664ED3F5469AC2A6EF4F695C1BCCA6DDE88CB03898443AAF4939236828F2FE F572E719F1E948DB392914D569A18C29DA6B0FF8E14B207E1DA93BE4973D440F 0A6A0F38090AF2799B68FA07BC9CE7280A33D67E49322848D70D46D10AE18E2B 8CFE07C41E62E87DD073D92669A9D9E7DBC023E24F220103693E238146BE2908 008DACC22546BD17E84141DC3162E691D7E926F054ED715CBACEF4872000149F 50D4BF67F42F557996F53F6FF18A0000000049454E44AE426082 } end object ImageNotesDirCross: TImage AnchorSideTop.Control = LabelNotesFound Left = 8 Height = 18 Top = 70 Width = 18 Picture.Data = { 1754506F727461626C654E6574776F726B47726170686963F402000089504E47 0D0A1A0A0000000D494844520000001200000012080600000056CE8E57000000 32695458744465736372697074696F6E000100000078DA4B5448CE484DCE56C8 4D2CCA5648CC4B514854482ECA2F2E060B000095390A3495891EA60000000473 424954080808087C0864880000026D49444154388D9D53CF4B5451183D6FE6DD F7DB99FBE65DB3D060A468DFA2A085B46C13D4AA558B3641EBA06DCBFE84DECD C47E410BCD858D36686AA66262669458915112280646A64433BE79EF6B31EF99 9A8ED2D95DEEC7B9E79CEF5C2086CFA1E13FE073300050004072384702FDF94A AAD2F55D0D6F5CF9B12F02E4A2F455AFA25E9AD3CB2DB86502DD0EEB08206835 95A35E873DF0DDDAEA7C0E5670D8ED95548E2A105470580F00A095E3D48CEE7C 8B20A80C8F862C7D58BAE0BB90D43DB5F5FE92E2510441EF3467B98DE3F4E681 E609C3FC1042500841E3A639E373346E26911C0DA3A6315D81A008825E1AD627 C971EC9FD72487376C19E3413C3865585F24C7D1F8A1FCA4617D8C20A8024123 A631255D1CD8D5BFE4B0FA6DBD584655FA1BDD5E941CE7A775FB6B0441EB1034 68E98392A3AE568E559B2EB4A2AD75FE8E73584C738A20A8A478D4676B8F2587 B127C9863217E982C3BAD62188504F0104F53A5A6FD29BED48EDCA4438DC1868 27D4F89806D014B0E38A82FCBED5F82E0E4E1AD65C6267C43416129BAF0C6BDE 77D1B437094766CC345F27C1F6D95A41BA308BB6D6992CE08569CEFA1CB95A4A D880A50F54E2150F5AFA9074ABC1FA1C5ABFAD1783B867CF2C7D34B9DBAE0405 87B5278D1DADF664CB8AA50B6BD832C643085A87474F1CEDA1E4D5FFBA818E4C FADACF54EE6F635D34ECA45A727813A6F93E82A03525478FEAD4EB1B97ED59E5 CCA29AAD10EA6956739677ACFDD6089ADFEAF612A19E96D23CBC9B55CEE14E1E E876586749F1685ECD94DA385A6A912468E538F999657E95E151C1613D4AEC9D 1D0AD8CDB55438767135BAB71F2200B89F4D5DE061FAEC821A5CFE031665FE71 44225A800000000049454E44AE426082 } end object Label3: TLabel AnchorSideTop.Control = LabelNotesFound AnchorSideTop.Side = asrBottom Left = 56 Height = 19 Top = 95 Width = 196 BorderSpacing.Top = 6 Caption = 'Dictionary Config (optional)' end object Label4: TLabel AnchorSideTop.Control = Label3 AnchorSideTop.Side = asrBottom Left = 56 Height = 19 Top = 120 Width = 156 BorderSpacing.Top = 6 Caption = 'Sync Config (optional)' end object ImageSpellTick: TImage AnchorSideTop.Control = Label3 Left = 24 Height = 18 Top = 95 Width = 18 Picture.Data = { 1754506F727461626C654E6574776F726B477261706869631E02000089504E47 0D0A1A0A0000000D494844520000001200000012080600000056CE8E57000000 32695458744465736372697074696F6E000100000078DA4B5448CE484DCE56C8 4D2CCA5648CC4B514854482ECA2F2E060B000095390A3495891EA60000000473 424954080808087C0864880000019749444154388DA5D0CF2BE4711CC7F1E730 6D0C22318C0B6DC248898C03263F929264C6CCC9D59FE0B6873D3BC9EDFBF163 E4A01C8861C45CA444324A0AED8E3DEC2E11B71529F39DF9BEF7C0C6C14EBE5F EFEBFBDDE3FD7ABFC16A69E4382384ED21BA2D1B28F22AB6D8F1EB48E3297FD0 70675840B2CBAB586BF0D2AA27E0EA37516CFC348BD85C1B2CF81248FF03E28C 3083C27C98FC05BEF4DD213E1D298BB28C22D334629BA4C57B811E3090CA5D8E D0709846D0C872C7880705F1C4B94551691E010A16F93AF088F4DE228E39862D 2168B83C71EE030652B1C526CA1A43F12AE38329A4ED1C1D45DDFF271505256B 6C664ED3F5469AC2A6EF4F695C1BCCA6DDE88CB03898443AAF4939236828F2FE F572E719F1E948DB392914D569A18C29DA6B0FF8E14B207E1DA93BE4973D440F 0A6A0F38090AF2799B68FA07BC9CE7280A33D67E49322848D70D46D10AE18E2B 8CFE07C41E62E87DD073D92669A9D9E7DBC023E24F220103693E238146BE2908 008DACC22546BD17E84141DC3162E691D7E926F054ED715CBACEF4872000149F 50D4BF67F42F557996F53F6FF18A0000000049454E44AE426082 } end object ImageSpellCross: TImage AnchorSideTop.Control = Label3 Left = 8 Height = 18 Top = 95 Width = 18 Picture.Data = { 1754506F727461626C654E6574776F726B47726170686963F402000089504E47 0D0A1A0A0000000D494844520000001200000012080600000056CE8E57000000 32695458744465736372697074696F6E000100000078DA4B5448CE484DCE56C8 4D2CCA5648CC4B514854482ECA2F2E060B000095390A3495891EA60000000473 424954080808087C0864880000026D49444154388D9D53CF4B5451183D6FE6DD F7DB99FBE65DB3D060A468DFA2A085B46C13D4AA558B3641EBA06DCBFE84DECD C47E410BCD858D36686AA66262669458915112280646A64433BE79EF6B31EF99 9A8ED2D95DEEC7B9E79CEF5C2086CFA1E13FE073300050004072384702FDF94A AAD2F55D0D6F5CF9B12F02E4A2F455AFA25E9AD3CB2DB86502DD0EEB08206835 95A35E873DF0DDDAEA7C0E5670D8ED95548E2A105470580F00A095E3D48CEE7C 8B20A80C8F862C7D58BAE0BB90D43DB5F5FE92E2510441EF3467B98DE3F4E681 E609C3FC1042500841E3A639E373346E26911C0DA3A6315D81A008825E1AD627 C971EC9FD72487376C19E3413C3865585F24C7D1F8A1FCA4617D8C20A8024123 A631255D1CD8D5BFE4B0FA6DBD584655FA1BDD5E941CE7A775FB6B0441EB1034 68E98392A3AE568E559B2EB4A2AD75FE8E73584C738A20A8A478D4676B8F2587 B127C9863217E982C3BAD62188504F0104F53A5A6FD29BED48EDCA4438DC1868 27D4F89806D014B0E38A82FCBED5F82E0E4E1AD65C6267C43416129BAF0C6BDE 77D1B437094766CC345F27C1F6D95A41BA308BB6D6992CE08569CEFA1CB95A4A D880A50F54E2150F5AFA9074ABC1FA1C5ABFAD1783B867CF2C7D34B9DBAE0405 87B5278D1DADF664CB8AA50B6BD832C643085A87474F1CEDA1E4D5FFBA818E4C FADACF54EE6F635D34ECA45A727813A6F93E82A03525478FEAD4EB1B97ED59E5 CCA29AAD10EA6956739677ACFDD6089ADFEAF612A19E96D23CBC9B55CEE14E1E E876586749F1685ECD94DA385A6A912468E538F999657E95E151C1613D4AEC9D 1D0AD8CDB55438767135BAB71F2200B89F4D5DE061FAEC821A5CFE031665FE71 44225A800000000049454E44AE426082 } end object ImageSyncTick: TImage AnchorSideTop.Control = Label4 Left = 24 Height = 18 Top = 120 Width = 18 Picture.Data = { 1754506F727461626C654E6574776F726B477261706869631E02000089504E47 0D0A1A0A0000000D494844520000001200000012080600000056CE8E57000000 32695458744465736372697074696F6E000100000078DA4B5448CE484DCE56C8 4D2CCA5648CC4B514854482ECA2F2E060B000095390A3495891EA60000000473 424954080808087C0864880000019749444154388DA5D0CF2BE4711CC7F1E730 6D0C22318C0B6DC248898C03263F929264C6CCC9D59FE0B6873D3BC9EDFBF163 E4A01C8861C45CA444324A0AED8E3DEC2E11B71529F39DF9BEF7C0C6C14EBE5F EFEBFBDDE3FD7ABFC16A69E4382384ED21BA2D1B28F22AB6D8F1EB48E3297FD0 70675840B2CBAB586BF0D2AA27E0EA37516CFC348BD85C1B2CF81248FF03E28C 3083C27C98FC05BEF4DD213E1D298BB28C22D334629BA4C57B811E3090CA5D8E D0709846D0C872C7880705F1C4B94551691E010A16F93AF088F4DE228E39862D 2168B83C71EE030652B1C526CA1A43F12AE38329A4ED1C1D45DDFF271505256B 6C664ED3F5469AC2A6EF4F695C1BCCA6DDE88CB03898443AAF4939236828F2FE F572E719F1E948DB392914D569A18C29DA6B0FF8E14B207E1DA93BE4973D440F 0A6A0F38090AF2799B68FA07BC9CE7280A33D67E49322848D70D46D10AE18E2B 8CFE07C41E62E87DD073D92669A9D9E7DBC023E24F220103693E238146BE2908 008DACC22546BD17E84141DC3162E691D7E926F054ED715CBACEF4872000149F 50D4BF67F42F557996F53F6FF18A0000000049454E44AE426082 } end object ImageSyncCross: TImage AnchorSideTop.Control = Label4 Left = 8 Height = 18 Top = 120 Width = 18 Picture.Data = { 1754506F727461626C654E6574776F726B47726170686963F402000089504E47 0D0A1A0A0000000D494844520000001200000012080600000056CE8E57000000 32695458744465736372697074696F6E000100000078DA4B5448CE484DCE56C8 4D2CCA5648CC4B514854482ECA2F2E060B000095390A3495891EA60000000473 424954080808087C0864880000026D49444154388D9D53CF4B5451183D6FE6DD F7DB99FBE65DB3D060A468DFA2A085B46C13D4AA558B3641EBA06DCBFE84DECD C47E410BCD858D36686AA66262669458915112280646A64433BE79EF6B31EF99 9A8ED2D95DEEC7B9E79CEF5C2086CFA1E13FE073300050004072384702FDF94A AAD2F55D0D6F5CF9B12F02E4A2F455AFA25E9AD3CB2DB86502DD0EEB08206835 95A35E873DF0DDDAEA7C0E5670D8ED95548E2A105470580F00A095E3D48CEE7C 8B20A80C8F862C7D58BAE0BB90D43DB5F5FE92E2510441EF3467B98DE3F4E681 E609C3FC1042500841E3A639E373346E26911C0DA3A6315D81A008825E1AD627 C971EC9FD72487376C19E3413C3865585F24C7D1F8A1FCA4617D8C20A8024123 A631255D1CD8D5BFE4B0FA6DBD584655FA1BDD5E941CE7A775FB6B0441EB1034 68E98392A3AE568E559B2EB4A2AD75FE8E73584C738A20A8A478D4676B8F2587 B127C9863217E982C3BAD62188504F0104F53A5A6FD29BED48EDCA4438DC1868 27D4F89806D014B0E38A82FCBED5F82E0E4E1AD65C6267C43416129BAF0C6BDE 77D1B437094766CC345F27C1F6D95A41BA308BB6D6992CE08569CEFA1CB95A4A D880A50F54E2150F5AFA9074ABC1FA1C5ABFAD1783B867CF2C7D34B9DBAE0405 87B5278D1DADF664CB8AA50B6BD832C643085A87474F1CEDA1E4D5FFBA818E4C FADACF54EE6F635D34ECA45A727813A6F93E82A03525478FEAD4EB1B97ED59E5 CCA29AAD10EA6956739677ACFDD6089ADFEAF612A19E96D23CBC9B55CEE14E1E E876586749F1685ECD94DA385A6A912468E538F999657E95E151C1613D4AEC9D 1D0AD8CDB55438767135BAB71F2200B89F4D5DE061FAEC821A5CFE031665FE71 44225A800000000049454E44AE426082 } end object Label5: TLabel Left = 24 Height = 22 Top = 43 Width = 222 Caption = 'Welcome to tomboy-ng !' Font.Height = -18 Font.Name = 'Lucida Grande' ParentFont = False end object LabelNotesFound: TLabel AnchorSideTop.Control = Label5 AnchorSideTop.Side = asrBottom Left = 56 Height = 19 Top = 70 Width = 10 BorderSpacing.Top = 5 Caption = 'X' end object LabelError: TLabel AnchorSideTop.Control = Label4 Left = 24 Height = 19 Hint = 'Launch from commandline to see errors or see Config->SnapShot->Recover ...' Top = 155 Width = 11 BorderSpacing.Top = 35 Caption = 'X' Font.Height = -16 Font.Style = [fsBold] ParentFont = False ParentShowHint = False ShowHint = True OnClick = LabelErrorClick end object CheckBoxDontShow: TCheckBox AnchorSideTop.Control = Label4 AnchorSideTop.Side = asrBottom AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 16 Height = 21 Hint = 'You can reverse this from Settings' Top = 227 Width = 239 Anchors = [akLeft, akBottom] BorderSpacing.Top = 14 BorderSpacing.Bottom = 15 Caption = 'Don''t Show for normal startup' OnChange = CheckBoxDontShowChange TabOrder = 3 end object ButtMenu: TBitBtn AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner Left = 2 Height = 30 Top = 2 Width = 120 BorderSpacing.Left = 2 BorderSpacing.Top = 2 Caption = 'Menu' Glyph.Data = { 36090000424D3609000000000000360000002800000018000000180000000100 2000000000000009000064000000640000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000003232 3238333333050000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000000000002E2E2E163636 36F93C3C3CF0393939863737371C000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000000000003737377D8080 80F6DEDEDEFF727272FA3A3A3ADC000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000003434348D34343440555555033D3D3DEBD9D9 D9FFFFFFFFFF777777F536363672000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000003E3E3EEB464646F53B3B3BEB595959F2FFFF FFFFEEEEEEFF3A3A3AF630303010000000000000000000000000000000000000 000000000000000000004D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D 4DFF4D4D4DFF4D4D4DFF4D4D4DFF3E3E3EFFE8E8E8FFCDCDCDFFCECECEFFFFFF FFFF9E9E9EFC3E3E3EB100000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF474747FFEAEAEAFFFFFFFFFFFFFFFFFFFFFF FFFFACACACFC434343F5404040D0323232510000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF454545FFEDEDEDFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFCFCFCFFF383838F9323232420000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FFFFFFFFFFFFFFFFFF414141FFF0F0F0FFFFFFFFFFFFFFFFFFFFFF FFFFD8D8D8FF3E3E3EF43333334B000000000000000000000000000000000000 000000000000000000004D4D4DFFFAFAFAFFFAFAFAFFFAFAFAFFFAFAFAFFFAFA FAFFFAFAFAFFFAFAFAFFFAFAFAFF3F3F3FFFF2F2F2FFFFFFFFFFFFFFFFFFD9D9 D9FF3E3E3EF53434344E00000000000000000000000000000000000000000000 000000000000000000004D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D 4DFF4D4D4DFF4D4D4DFF4D4D4DFF383838FFF5F5F5FFFFFFFFFFDBDBDBFF3E3E 3EF6353535570000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFAFAFAFFFAFAFAFFFAFAFAFFFAFAFAFFFAFA FAFFFAFAFAFFFAFAFAFFFAFAFAFF3A3A3AFFF8F8F8FFE0E0E0FF424242F53636 365A000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FFFFFFFFFFFFFFFFFF383838FFDDDDDDFF424242FF3636365E0000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF363636FF494949FF454545FF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FFFFFFFFFFFFFFFFFFFFFFFFFF353535FFAEAEAEFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFDFDFDFFA9A9A9FFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FF000000FFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D 4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000 } OnClick = ButtMenuClick TabOrder = 0 end object LabelBadNoteAdvice: TLabel AnchorSideTop.Control = LabelError AnchorSideTop.Side = asrBottom Left = 24 Height = 19 Top = 186 Width = 148 BorderSpacing.Top = 12 Caption = 'LabelBadNoteAdvice' end object BitBtnQuit: TBitBtn AnchorSideLeft.Control = BitBtnHide AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = ButtMenu AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = ButtMenu AnchorSideBottom.Side = asrBottom Left = 197 Height = 30 Top = 2 Width = 261 Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Right = 2 Caption = 'Quit' OnClick = BitBtnQuitClick TabOrder = 2 end object BitBtnHide: TBitBtn AnchorSideLeft.Control = ButtMenu AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = ButtMenu AnchorSideBottom.Control = ButtMenu AnchorSideBottom.Side = asrBottom Left = 122 Height = 30 Top = 2 Width = 75 Anchors = [akTop, akLeft, akBottom] Caption = 'Hide' OnClick = BitBtnHideClick TabOrder = 1 end object ButtSysTrayHelp: TBitBtn AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 282 Height = 30 Top = 219 Width = 163 Anchors = [akRight, akBottom] BorderSpacing.Right = 15 BorderSpacing.Bottom = 14 Caption = 'SysTray Help' OnClick = ButtSysTrayHelpClick TabOrder = 4 end object TrayIcon: TTrayIcon Icon.Data = { 9E09000000000100010018180000010020008809000016000000280000001800 0000300000000100200000000000000900006400000064000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000001E9CC1021F9ABD0200000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000001E94B629138DB28F069ECDB700B2E7D40AA0CC9F2193B4280000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000001E9D C206127795760BBDF2D20EC3F8FF0FB9EDFF10B4E8FF0CB7EAFF04B8EEE31383 A37B1F9CC0050000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000000000001D92B2370788 AEAF17CDFFFD13B7E7FF0AB1E4FF0BB3E5FF0DADDAFF0BAEDEFF14ABDBFF0FBA EDFE0493BFC01E95B63600000000000000000000000000000000000000000000 0000000000000000000000000000000000001F9BBF0B147D9C840BC2F9DC11BE F3FF13B4E4FF10B3E3FF04AFE1FF00AAE2FF05A5D7FF06A5D5FF0CA8D6FF0FA5 D2FF13ABD7FF09AEE1EA118CAF8A1F9BBF0B0000000000000000000000000000 00000000000000000000000000001E90B2460893C1B70FC8FFFF11B3E5FF13B4 E2FF0AB1E1FF23B7E8FF4ECDF3FF75DDF8FF56D7F7FF46D2F4FF1AB2D5FF07A7 CDFF13A2D0FF12A0CCFF16A7D3FF0596C4C81D96BA4600000000000000000000 0000000000002099BC131285A69104C4FDE60CB9ECFF0DB3E3FF0BB3E0FF04A5 DEFF1EACE4FF11A3DDFF139CDAFF1795D6FF2E94D4FF338BD2FF377ECDFF2F88 C8FF0B97C0FF0F9AC5FF139CC7FF149DC5FF0BA7D7F00F93BA991F9ABD120000 00001E728A2A04A1D0C207C1F9FF0AB2E4FF08B4E2FF00A6DFFF149FDCFF69D2 F9FF7EE1F9FFBFEAF8FF86DDF0FF38C2E9FF00A4DEFF009ED8FF00B0E0FF3DCF F8FF4AD3FEFF1A9BC4FF0A8FB8FF1099C2FF119AC2FF13A3D0FF049FCDD21D74 8D2C10657C9405C0F8FF07B1E1FF03ABE0FF0094DBFF48B8EAF26FE0FDFF5BD3 F6FF59D1F6FF4ACDF5FF93E2FCFFF3FEFFFFF2FFFFFF9FE9FEFF58D3FAFF48CD F4FF41CCF7FF3CD4FFFF2FB8DFF31091B6FF0F96C1FF119AC2FF109FCCFF0A79 99B104A8D6E002ACE3FF0093DAFF1192D9F66DE0FCF45DD6F9FF64D5F7FF62D3 F7FF6FD7F7FF6CD6F7FF5AD0F4FF49CEF4FF4ECFF4FF52CFF5FF58CFF6FF4ECE F6FF4ACEF4FF3ECAF5FF30CCFAFF31D0FFF51899C1F60B92BAFF0D97C2FF0C9C C5ED0095D1E6007FD8FF4AC7F0E259DBFBFF58D2F6FF5DD3F5FF65D5F7FF73D8 F7FF6BD5F7FF7FDFF8FF73D6F8FF6BD4F7FF6BD5F7FF62D2F7FF5DD2F5FF51CE F6FF48CDF4FF40C9F5FF35C6F4FF27C4F3FF1FCDFFFF15BAEDE60089B5FF0295 C2EE0076CDE345DBFBFB46CEF7FF4DCEF6FF52CFF6FF63D5F8FF68D6F6FF72D8 F7FF72D9F8FF6DD6F8FF70DBFBFF74E0FFFF71D7F8FF66D5F7FF61D3F7FF57D2 F6FF4BCEF4FF43CBF5FF3DCBF4FF1FC4F8FF01B0E5FF61C9E9FFE4FFFFFD0080 B5EA2DC9F0A63CCBF5FF43CAF5FF52CEF7FF57D1F6FF5ED3F5FF62D5F6FF65D4 F0FF54C4E5FF4BB5D6FF4DA5C5FF59A9C1FF66DCFFFF6FD8F8FF57D1F5FF55CF F6FF52D0F6FF42CDF7FF20C1F1FF2BB5DEFFB3E8F9FFBCEDFEFFA7E5FCFF90E2 FDCD38C8F4442EC5F4FF3FCCF4FF4BCEF6FF53CDF2FF51C9EDFF3FBEDCFF2FB1 E5FF4AA8DCFF6291B4FF5E86ABFF3D4754FF68D7F6FF65D8FAFF61D4F5FF53D1 F7FF42CFF9FF22B5E6FF74CEE9FFCAF2FFFFA5E5FBFF8EDEF9FF87DDF8FF58CF F576CAFFFF0558FDFF572DBFF2F73AC4EBFF34B9DBFF1CA6D0FF44B2EEFF59B7 EAFF42A4ECFF3A8CD3FF7AB3CAFF7ADAF5FF68D9FDFF5DD3F5FF59D3F9FF3AC6 F2FF40BBE0FFBFECFBFFADE9FEFF8CDEF9FF7FDCF8FF70D6F5FB51FCFF704DFC FF050000000000000000B4FFFF1926BADFB828A5E1FF60BCF5FF5DB1E7FF4799 E6FF56ACE9FFB0F3F7FF76D6EFFF59D6FCFF5ED5F7FF56D3FBFF2FBAE2FF88D5 EDFFB8EEFFFF8FDFFAFF7FDBF8FF70D7F7FF43CBF5C478FFFF1D000000000000 0000000000000000000097877F596DB6EDEF66BBF5FF508EC4FF447BBAFF85D7 F2FF91F1F5FF51CEF4FF52D0F7FF64D8FAFF39C6EDFF54BFE2FFBAEDFFFF95E2 FBFF7DDBF7FF6CD7F7FF53CDF5F454FDFF5BC7FFFF0300000000000000000000 00002619A5029D96BA89918680FC81A3BBFF4B86CBFF5699C0FF8DF1F9FE44CE F4FF47CAF5FF51D2F8FF4BD1F9FF3ABBE0FF8DD7F1FFA0E8FEFF7BDAF8FF6DD5 F6FF5AD1F7FF35C4F2B0B8FFFF15000000000000000000000000000000000000 00004335A7052C1E82CCA4A68FFB9C8777FF84CCEAFF9EFFFF99A4FFFF0BC5FF FF3929C6F4DE31BFEBFF5CC2E2FFAAE9FFFF85DDFAFF6DD5F6FF5BD2F5FF3CC7 F3EB6AFFFF48FFFFFF0100000000000000000000000000000000000000000000 000000000000624BEE456F65A3DEC6C1C7ECFFFFFF3200000000000000000000 0000FFFFFF0D91FFFF9A7DDDFCFF68D4F6FF59D1F5FF3ECAF5FF54FDFF9AF9FF FF0E000000000000000000000000000000000000000000000000000000000000 000000000000000000006149FC31F0EAFF040000000000000000000000000000 00000000000000000000FFFFFF206BFFFF7766FFFF78DEFFFF21000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000 } Hint = 'tomboy-ng' OnClick = TrayIconClick Left = 368 Top = 128 end object ApplicationProperties1: TApplicationProperties Left = 368 Top = 64 end end tomboy-ng_0.34-1/source/editbox.lfm0000644000175000017500000021074714145033507017066 0ustar dbannondbannonobject EditBoxForm: TEditBoxForm Left = 515 Height = 505 Top = 238 Width = 695 Caption = 'EditBoxForm' ClientHeight = 505 ClientWidth = 695 Constraints.MinHeight = 200 Constraints.MinWidth = 200 OnActivate = FormActivate OnClose = FormClose OnCloseQuery = FormCloseQuery OnCreate = FormCreate OnDestroy = FormDestroy OnShow = FormShow LCLVersion = '2.3.0.0' object PanelReadOnly: TPanel AnchorSideLeft.Control = Owner AnchorSideTop.Control = KMemo1 AnchorSideTop.Side = asrBottom AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = PanelFind Left = 0 Height = 60 Top = 406 Width = 695 Anchors = [akLeft, akRight, akBottom] ClientHeight = 60 ClientWidth = 695 Color = clYellow ParentColor = False ParentFont = False TabOrder = 1 object Label2: TLabel Left = 8 Height = 23 Top = 16 Width = 98 Caption = 'Read Only' Font.Height = -20 Font.Style = [fsBold] ParentFont = False end object Label3: TLabel Left = 120 Height = 19 Top = 8 Width = 343 Caption = 'This note has been changed by the Sync Process' end object Label4: TLabel Left = 120 Height = 19 Top = 32 Width = 345 Caption = 'Please close it (and re-open if it was a download)' end end object PanelFind: TPanel AnchorSideLeft.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 0 Height = 39 Top = 466 Width = 695 Anchors = [akLeft, akRight, akBottom] BevelInner = bvLowered ClientHeight = 39 ClientWidth = 695 TabOrder = 2 OnEnter = PanelFindEnter object EditFind: TEdit Left = 8 Height = 28 Top = 5 Width = 136 OnChange = EditFindChange OnEnter = EditFindEnter OnExit = EditFindExit OnKeyDown = EditFindKeyDown OnKeyUp = EditFindKeyUp ParentShowHint = False ShowHint = True TabOrder = 0 Text = 'EditFind' end object LabelFindInfo: TLabel AnchorSideLeft.Control = LabelFindCount AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = EditFind AnchorSideBottom.Control = EditFind AnchorSideBottom.Side = asrCenter Left = 221 Height = 19 Top = 9 Width = 97 Anchors = [akLeft, akBottom] BorderSpacing.Left = 5 Caption = 'LabelFindInfo' end object LabelFindCount: TLabel AnchorSideLeft.Control = SpeedRight AnchorSideLeft.Side = asrBottom AnchorSideBottom.Control = PanelFind AnchorSideBottom.Side = asrBottom Left = 206 Height = 28 Top = 9 Width = 10 Anchors = [akTop, akLeft, akBottom] BorderSpacing.Left = 6 Caption = 'X' end object SpeedLeft: TSpeedButton AnchorSideLeft.Control = EditFind AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = EditFind AnchorSideBottom.Control = EditFind AnchorSideBottom.Side = asrBottom Left = 144 Height = 28 Top = 5 Width = 28 Anchors = [akTop, akLeft, akBottom] Glyph.Data = { 36090000424D3609000000000000360000002800000018000000180000000100 2000000000000009000064000000640000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000F7B29FF0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000107B 2AFF0E7B29FF0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000117D2BFF0F7C 2AFF0E7B28FF0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000127E2DFF107D2BFF0F7C 2AFF0D7B28FF0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000014802EFF127F2DFF117E2CFF0F7D 2AFF0E7C29FF0C7B27FF0B7B27FF0A7A25FF0A7925FF0A7925FF0A7925FF0A79 25FF0B7926FF0C7926FF00000000000000000000000000000000000000000000 0000000000000000000000000000158130FF14812EFF13802DFF117F2CFF107E 2BFF0E7D29FF0D7C28FF0C7B27FF0B7B26FF0B7A26FF0B7A26FF0B7926FF0B79 26FF0C7927FF0D7A27FF00000000000000000000000000000000000000000000 00000000000000000000178231FF158230FF15822FFF13812EFF12802DFF1080 2CFF0F7F2AFF0E7E29FF0D7D28FF0C7C28FF0C7B27FF0C7B27FF0C7A27FF0C7A 27FF0D7A28FF0E7A28FF00000000000000000000000000000000000000000000 000000000000178332FF178331FF168331FF15832FFF14822FFF13822EFF1181 2CFF10802CFF0F7F2AFF0E7E29FF0E7D29FF0D7D28FF0D7C28FF0E7C28FF0E7B 28FF0F7B29FF0F7B29FF00000000000000000000000000000000000000000000 00000000000000000000178432FF168431FF168431FF148430FF14832FFF1382 2EFF12812DFF10802CFF10802BFF0F7F2AFF0F7E2AFF0F7D2AFF0F7D2AFF0F7C 2AFF107C2AFF107C2BFF00000000000000000000000000000000000000000000 0000000000000000000000000000178532FF168531FF158531FF14842FFF1483 2FFF13832EFF12822DFF11812CFF11802CFF117F2CFF107F2BFF117E2CFF117E 2CFF127D2CFF127D2CFF00000000000000000000000000000000000000000000 000000000000000000000000000000000000178532FF168531FF158530FF1584 30FF14832FFF13832EFF13822EFF13812EFF12802DFF13802DFF137F2DFF137F 2DFF137E2DFF147E2EFF00000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000178632FF168531FF1685 31FF158430FF0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000178632FF1785 32FF168531FF0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000001885 32FF178532FF0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000188432FF0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000 } OnClick = SpeedLeftClick ShowHint = True ParentShowHint = False end object SpeedRight: TSpeedButton AnchorSideLeft.Control = SpeedLeft AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = EditFind AnchorSideBottom.Control = EditFind AnchorSideBottom.Side = asrBottom Left = 172 Height = 28 Top = 5 Width = 28 Anchors = [akTop, akLeft, akBottom] Glyph.Data = { 36090000424D3609000000000000360000002800000018000000180000000100 2000000000000009000064000000640000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000D7A27FF0000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000C7926FF0B7926FF00000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000B7926FF0A7925FF0A7825FF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000B7A26FF0A7925FF0A7925FF097824FF0000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000168030FF15802FFF147F2EFF127F2DFF117E2CFF0F7E 2AFF0E7D29FF0D7C28FF0C7B27FF0B7B26FF0A7A25FF0A7925FF0A7925FF0A79 25FF000000000000000000000000000000000000000000000000000000000000 00000000000000000000168130FF15812FFF14802FFF13802DFF117F2CFF107F 2BFF0F7E2AFF0E7D29FF0D7C28FF0C7B27FF0B7B26FF0B7A26FF0A7A26FF0B79 26FF0B7926FF0000000000000000000000000000000000000000000000000000 00000000000000000000168231FF168230FF14822FFF14812EFF12812DFF1180 2CFF107F2BFF0F7E2AFF0D7E29FF0D7D28FF0C7C27FF0C7B27FF0B7B27FF0C7A 27FF0C7A27FF0D7A27FF00000000000000000000000000000000000000000000 00000000000000000000178331FF168331FF158330FF14822FFF13822EFF1281 2DFF11812CFF10802BFF0F7F2AFF0E7E2AFF0E7D29FF0D7C28FF0D7C28FF0D7B 28FF0E7B28FF0E7B29FF0F7B2AFF000000000000000000000000000000000000 00000000000000000000178432FF178431FF168431FF158430FF14832FFF1383 2EFF12822EFF12812DFF11802CFF107F2BFF0F7F2BFF0F7E2AFF0F7D2AFF0F7C 2AFF0F7C2AFF107C2AFF00000000000000000000000000000000000000000000 00000000000000000000178432FF178532FF178531FF168531FF158430FF1484 2FFF14832FFF13832EFF12822DFF12812DFF11802CFF117F2CFF117E2CFF117D 2BFF117D2BFF0000000000000000000000000000000000000000000000000000 00000000000000000000188533FF188532FF178532FF168531FF168531FF1585 30FF158430FF148430FF14832FFF13822EFF13812EFF13802DFF137F2DFF137E 2DFF000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000014832FFF15822FFF14812FFF14802FFF0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000168331FF168230FF168130FF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000178331FF178331FF00000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000188332FF0000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000 } OnClick = SpeedRightClick ShowHint = True ParentShowHint = False end end object Panel1: TPanel AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom Left = 0 Height = 40 Top = 0 Width = 695 Anchors = [akTop, akLeft, akRight] ClientHeight = 40 ClientWidth = 695 TabOrder = 3 object SpeedButtonNotebook: TSpeedButton AnchorSideLeft.Control = SpeedButtonDelete AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel1 Left = 295 Height = 38 Hint = 'Manage Notebooks' Top = 1 Width = 38 Glyph.Data = { FE0A0000424DFE0A00000000000036000000280000001E0000001E0000000100 180000000000C80A000064000000640000000000000000000000E6E7E8E6E7E8 E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7 E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6 E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E80000E6E7E8E6E7E8E6E7E8E6 E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8 E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7 E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E80000E6E8E9E6E8E9E6E8E9E6E8E9E6E8 E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6 E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9 E6E8E9E6E8E9E6E8E9E6E8E90000E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9 E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8 E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7 E8E9E7E8E9E7E8E90000E7E8E9E7E8E9E7E8E9E7E8E9E6E7E8E4E5E6E1E2E3DD DEDFDBDCDDDBDCDDDBDCDDDBDCDDDBDCDDDBDCDDDBDCDDDBDCDDDBDCDDDBDCDD DBDCDDDBDCDDDBDCDDDBDCDDDCDDDEE0E1E2E3E4E5E6E7E8E7E8E9E7E8E9E7E8 E9E7E8E90000E7E9EAE7E9EAE7E9EAE7E9EAE5E7E8E1E3E4D9DADBC8CACBBEC0 C1BCBEBFBCBEBFBCBEBFBCBEBFBCBEBFBCBEBFBCBEBFBCBEBFBCBEBFBCBEBFBC BEBFBCBEBFBEC0C1C5C6C7D6D8D9E0E2E3E4E6E7E7E9EAE7E9EAE7E9EAE7E9EA 0000E8E9EAE8E9EAE8E9EAE8E9EAE6E7E8E0E1E2D1D2D39EA1A08288847D8280 7D82807D82807C817F7C817F7C817F7C817F7B807E7B807E7B807E7B807E7A80 7D7F84829A9C9CC7C8C9DDDEDFE5E6E7E8E9EAE8E9EAE8E9EAE8E9EA0000E8E9 EAE8E9EAE8E9EAE8E9EAE6E7E8E2E3E4D9D9DA848A87DBDCDBF2F2F2F2F2F2F2 F2F2F2F2F2F1F2F2F1F2F2F1F2F2F1F2F2F1F2F2F1F2F2F1F2F2F1F2F2DDDEDE 808582D3D4D5E0E1E2E5E6E7E8E9EAE8E9EAE8E9EAE8E9EA0000E9EAEBE9EAEB E9EAEBE9EAEBE8E9EAE6E7E8E2E3E4808784FEFEFEFEFEFEFDFDFDFAFAFAFAFA FAFAFAFAFAFAFAFAFAFAFDFDFDFEFEFEFEFEFEFEFEFEFEFEFEFEFEFE7F8582DD DEDFE5E6E7E8E9EAE9EAEBE9EAEBE9EAEBE9EAEB0000E9EAEBE9EAEBE9EAEBE9 EAEBE9EAEBE8E9EAE7E8E9868C89FDFEFEFDFEFED0D2D1C1C3C2C1C3C2C1C3C2 C1C3C2C1C3C2D0D2D1FDFEFEFDFEFEFDFEFEFDFEFEFDFEFE858B88E3E4E5E8E9 EAE9EAEBE9EAEBE9EAEBE9EAEBE9EAEB0000E9EAEBE9EAEBE9EAEBE9EAEBE9EA EBE9EAEBE9EAEB8B928FFAFBFBF9FAFAF8F9F9F5F6F6F5F6F6F5F6F6F5F6F6F5 F6F6F5F6F6F5F6F6F5F6F6F8F9F9F9FAFAF9FAFA8B918EE6E7E8E9EAEBE9EAEB E9EAEBE9EAEBE9EAEBE9EAEB0000EAEBECEAEBECEAEBECEAEBECEAEBECEAEBEC EAEBEC919794F8F8F8F5F6F6CACDCCBCBFBEBCBFBEBCBFBEBCBFBEBCBFBEBCBF BEBCBFBEBCBFBECACDCCF5F6F6F5F6F6909693E7E9EAEAEBECEAEBECEAEBECEA EBECEAEBECEAEBEC0000EAEBECEAEBECEAEBECEAEBECEAEBECEAEBECEAEBEC96 9C99F6F7F7F1F3F3F1F3F3F1F3F3F1F3F3F1F3F3F1F3F3F1F3F3F1F3F3F1F3F3 F1F3F3F1F3F3F1F3F3F2F4F4959B98E8E9EAEAEBECEAEBECEAEBECEAEBECEAEB ECEAEBEC0000EAEBECEAEBECEAEBECEAEBECEAEBECEAEBECEAEBEC9BA29FF5F6 F6EDEFEFECEEEEE9EBEBE9EBEBECEEEEEDEFEFEDEFEFEDEFEFEDEFEFEDEFEFED EFEFEDEFEFF0F2F29AA09DE8E9EAEAEBECEAEBECEAEBECEAEBECEAEBECEAEBEC 0000EBECEDEBECEDEBECEDEBECEDEBECEDEBECEDEBECEDA1A7A4F4F5F5E9EBEB C3C6C5B7BAB9B7BAB9C3C6C5E9EBEBE9EBEBE9EBEBE9EBEBE9EBEBE9EBEBE9EB EBEFF1F19FA6A3E9EAEBEBECEDEBECEDEBECEDEBECEDEBECEDEBECED0000EEEF EFEEEFEFEEEFEFEEEFEFEEEFEFEEEFEFEEEFEFA6ADAAF4F5F5E5E8E8E4E7E7E2 E5E5E2E5E5E2E5E5E2E5E5E2E5E5E2E5E5E2E5E5E2E5E5E4E7E7E5E8E8EFF1F1 A5ABA8ECECECEEEFEFEEEFEFEEEFEFEEEFEFEEEFEFEEEFEF0000EEEFF0EEEFF0 EEEFF0EEEFF0EEEFF0EEEFF0EEEFF0ACB2AFF5F6F6E2E5E5BEC2C1B3B7B6B3B7 B6B3B7B6B3B7B6B3B7B6B3B7B6B3B7B6B3B7B6BEC2C1E2E5E5F0F2F2AAB1AEEC ECEDEEEFF0EEEFF0EEEFF0EEEFF0EEEFF0EEEFF00000EEEFF0EEEFF0EEEFF0EE EFF0EEEFF0EEEFF0EEEFF0B1B8B5F7F8F8E2E5E5E1E4E4DFE2E2DFE2E2DFE2E2 DFE2E2DFE2E2DFE2E2DFE2E2DFE2E2E1E4E4E2E5E5F4F5F5AFB5B2ECEDEEEEEF F0EEEFF0EEEFF0EEEFF0EEEFF0EEEFF00000EFF0F0EFF0F0EFF0F0EFF0F0EFF0 F0EFF0F0EFF0F0B6BDBAF9FAFAE2E5E5BEC2C1B3B7B6B3B7B6B3B7B6B3B7B6B3 B7B6B3B7B6B3B7B6B3B7B6BEC2C1E2E5E5F7F8F8B4BBB8EDEEEEEFF0F0EFF0F0 EFF0F0EFF0F0EFF0F0EFF0F00000EFF0F1EFF0F1EFF0F1EFF0F1EFF0F1EFF0F1 EFF0F1B6BDBAFCFCFCD5E1DCE2E5E5D4E0DCE2E5E5D4E0DCE2E5E5D4E0DCE2E5 E5D4E0DCE2E5E5D4E0DCE2E5E5FAFBFBB7BEBBEDEEEFEFF0F1EFF0F1EFF0F1EF F0F1EFF0F1EFF0F10000F0F0F1F0F0F1F0F0F1F0F0F1F0F0F1F0F0F1F0F0F1B6 BDBAFEFEFE67BB9087C6A759B68798CCB259B68798CCB259B68798CCB259B687 98CCB24BB27DA5D0BBFDFEFEB7BEBBEEEEEFF0F0F1F0F0F1F0F0F1F0F0F1F0F0 F1F0F0F10000F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1BBC0BEF7F8 F73EB97BD7F5E631B672E5F8EF31B672E5F8EF31B672E5F8EF31B672E5F8EF25 B36AF2FCF7F5F6F6B9C0BDEFF0F0F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1 0000F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2D9DDDBBBC0BF73ECAE 9BC4AF6CEEACA2C1B26CEEACA2C1B26CEEACA2C1B26CEEACA2C1B265EFA9A9C0 B5BAC0BDD8DCDBF0F1F2F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2F0F1F20000F1F1 F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F24EBC841AA25C3F B67929A7663FB67929A7663FB67929A7663FB67929A7662FB06D38AC71F1F1F2 F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F20000F1F2F2F1F2F2 F1F2F2F1F2F2F1F2F2F1F2F2F1F2F2F1F2F2F1F2F2A5D5BD76C49C99D1B581C8 A499D1B581C8A499D1B581C8A499D1B581C8A48DCCAC8DCDADF1F2F2F1F2F2F1 F2F2F1F2F2F1F2F2F1F2F2F1F2F2F1F2F2F1F2F20000F1F2F3F1F2F3F1F2F3F1 F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3 F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2 F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F30000F2F2F3F2F2F3F2F2F3F2F2F3F2F2 F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2 F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3 F2F2F3F2F2F3F2F2F3F2F2F30000F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3 F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3 F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2 F3F3F2F3F3F2F3F30000F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2 F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4 F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3 F4F2F3F40000F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3 F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3 F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4 0000 } OnClick = SpeedButtonNotebookClick ShowCaption = False ShowHint = True ParentShowHint = False end object SpeedRollBack: TSpeedButton AnchorSideLeft.Control = SpeedButtonNotebook AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel1 Left = 333 Height = 38 Hint = 'Roll Back' Top = 1 Width = 38 Glyph.Data = { 36040000424D3604000000000000360000002800000010000000100000000100 2000000000000004000064000000640000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000000000002F2F8AFF0000 00002D2D88FF000000002D2D88FF000000002D2D8CFF1F1F86FF1C1C85FF1C1C 84FF1C1C83FF1B1B81C61B1B7E6A1B1B7D07000000000000000031318FFF0000 00002F2F8EFF000000002F2F8EFF00000000303098FF232392FF202091FF2020 91FF20208FFF1E1E8CFF1C1C85FF1B1B7FD51B1B7D1500000000383893FF0000 0000363692FF00000000363692FF0000000038389DFF33339BFF32329AFF3232 9AFF31319AFF2E2E98FF252592FF1D1D88FF1A1A7FD51B1B7D07000000000000 0000000000000000000000000000000000000000000000000000000000000000 00003C3C9F0E3A3A9F6A35359CF8252592FF1C1C85FF1B1B7E6A000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000003A3A9F6A2E2E98FF1E1E8CFF1B1B81C6000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000003C3C9F0E30309AFF20208FFF1C1C83FF000000000000 0000000000002929842B00000000000000000000000000000000000000000000 0000000000000000000034349A0E2C2C97FF1F1F90FF1D1D85FF000000000000 000029298C2B222284EA00000000000000000000000000000000000000000000 000000000000000000002A2A956A232393FF1E1E8FFF1E1E86C6000000002929 8F2B24248EEA1C1C85FF00000000000000000000000000000000000000000000 00001F1F850E21218B6A212190F81E1E91FF1F1F8DFF2222876A3131932B2626 91EA1F1F90FF1C1C89FF1C1C85FF1C1C85FF1C1C85FF1C1C85FF1C1C85FF1C1C 85FF1D1D89FF1E1E8EFF1E1E91FF202091FF25258DD52727880738389AD52B2B 97FF202092FF1E1E90FF1F1F90FF202091FF202091FF202091FF202091FF2020 91FF202091FF212193FF252593FF2A2A92D52C2C8F15000000003C3C9F2B3838 9EEA2A2A97FF202092FF262694FF303099FF32329AFF32329AFF32329AFF3232 9AFF32329AFF313198C63232976A333394070000000000000000000000003C3C A02B38389DEA2A2A92FF00000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00003C3C9C2B363692EA00000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000003A3A8F2B00000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000 } OnClick = SpeedRollBackClick ShowCaption = False ShowHint = True ParentShowHint = False end object SpeedButtonDelete: TSpeedButton AnchorSideLeft.Control = SpeedButtonTools AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel1 Left = 257 Height = 38 Hint = 'Delete this note' Top = 1 Width = 38 Glyph.Data = { FE0A0000424DFE0A00000000000036000000280000001E0000001E0000000100 180000000000C80A000064000000640000000000000000000000E6E7E8E6E7E8 E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7 E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6 E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E80000E6E7E8E6E7E8E6E7E8E6 E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8 E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7 E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E80000E6E8E9E6E8E9E6E8E9E6E8E9E6E8 E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6 E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9 E6E8E9E6E8E9E6E8E9E6E8E90000E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9 E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8 E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7 E8E9E7E8E9E7E8E90000E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7 E8E9E7E8E9E3E4E5E0E1E2DADBDCD4D5D6CDCECFC8C9CAC9CACBCFCFD0D6D7D8 DBDCDDE1E2E3E5E6E7E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8 E9E7E8E90000E7E9EAE7E9EAE7E9EAE7E9EAE7E9EAE7E9EAE2E4E4D6D8D9CCCE CEADAFAF8B8C9052528831328C19199E0A0AAB0A0AAB18189D32338C56568A91 9296B6B8B8CFD0D1D9DADBE4E6E7E7E9EAE7E9EAE7E9EAE7E9EAE7E9EAE7E9EA 0000E8E9EAE8E9EAE8E9EAE8E9EAE8E9EAE3E4E4D6D7D8CACBCCA9AAAB707190 1717AA1818BD2626D32F2FDB3535DC3434DC2E2EDB2424D11515B91515A77576 95B4B5B6CECFCFD9D9DAE6E7E8E8E9EAE8E9EAE8E9EAE8E9EAE8E9EA0000E8E9 EAE8E9EAE8E9EAE8E9EAE8E9EAE8E9EADCDDDECFCFD26768C01313B92F2FDD40 40DD4848DE4141DD3434DB3434DA4040DD4646DE3D3DDC2B2BDA0E0EB36566BD D1D2D5DFE0E1E8E9EAE8E9EAE8E9EAE8E9EAE8E9EAE8E9EA0000E9EAEBE9EAEB E9EAEBE9EAEBE9EAEBE9EAEBE9EAEB7D7DD42020CA3333DF3131DB2727D97C7D E2ABACE7D6D8ECD6D8ECABACE77C7DE22727D92E2EDA2D2DDD1B1BC37A7ACFE9 EAEBE9EAEBE9EAEBE9EAEBE9EAEBE9EAEBE9EAEB0000E9EAEBE9EAEBE9EAEBE9 EAEBE9EAEBE9EAEBC2C3E31B1BC33131DF2121DA494ADECFD0EBECEEEEECEEEE EDEFEFEDEFEFECEEEEECEEEECFD0EB494ADE1F1FD92929DE1515B9C0C1E1E9EA EBE9EAEBE9EAEBE9EAEBE9EAEBE9EAEB0000E9EAEBE9EAEBE9EAEBE9EAEBE9EA EBE4E4EA2F2FC83030DE2626DB4747DEEBEDEFEEF0F0EEF0F0EFF0F0EFF0F0EF F0F0EFF0F0EEF0F0EEF0F0EBEDEF4747DE2020DB2828DC2929BEE4E4E9E9EAEB E9EAEBE9EAEBE9EAEBE9EAEB0000EAEBECEAEBECEAEBECEAEBECEAEBECA7A8E0 2A2AD03131DE1A1ADBD1D2EDEFF1F1848886757877E2E3E3F1F2F2F1F2F2E2E3 E3777C7A848886EFF1F1D1D2ED1A1ADB2727DD2323CAA5A5DCEAEBECEAEBECEA EBECEAEBECEAEBEC0000EAEBECEAEBECEAEBECEAEBECEAEBEC7A7ADA3232DF28 28DE797AE6F0F2F2F1F3F3787C7A5357556C6F6EE4E5E5E4E5E56C6F6E535755 757877F1F3F3F0F2F2797AE62222DD2727D97777D3EAEBECEAEBECEAEBECEAEB ECEAEBEC0000EAEBECEAEBECEAEBECEAEBECEAEBEC4646D43939E42323DFAAAB ECF2F3F3F3F4F4E5E6E66C6F6E5357556A6D6C6A6D6C5357556C6F6EE5E6E6F3 F4F4F2F3F3ADAFED1F1FDF2F2FE14242CAEAEBECEAEBECEAEBECEAEBECEAEBEC 0000EBECEDEBECEDEBECEDEBECEDEBECED2222D14343E61C1CE0D6D7F1F4F5F5 F5F6F6F6F7F7E7E8E86A6D6C5357555357556A6D6CE7E8E8F6F7F7F5F6F6F4F5 F5DBDDF21B1BE03636E41B1BC3EBECEDEBECEDEBECEDEBECEDEBECED0000EEEF EFEEEFEFEEEFEFEEEFEFEEEFEF2323D34747E71F1FE1D7D8F2F5F6F6F6F7F7F7 F8F8E9EAEA6A6D6C5357555357556A6D6CE9EAEAF7F8F8F6F7F7F5F6F6DEDFF3 1D1DE13939E51C1CC6EEEFEFEEEFEFEEEFEFEEEFEFEEEFEF0000EEEFF0EEEFF0 EEEFF0EEEFF0EEEFF04C4CDB4444E82B2BE4AEAFF0F6F7F7F7F8F8EAEAEA6D70 6F5357556A6E6D6A6E6D5357556D706FEAEAEAF7F8F8F6F7F7B1B2F02626E438 38E54647D1EEEFF0EEEFF0EEEFF0EEEFF0EEEFF00000EEEFF0EEEFF0EEEFF0EE EFF0EEEFF08181E33E3EE73939E78081ECF7F7F7F8F9F9777A795357556E7170 EDEDEDEDEDED6E71705357557A7E7CF8F9F9F7F8F88081EC3131E63333E07D7D DCEEEFF0EEEFF0EEEFF0EEEFF0EEEFF00000EFF0F0EFF0F0EFF0F0EFF0F0EFF0 F0B0B1E83636DE5151EA2929E6DADBF6F8F9F9878A887A7E7CEDEDEDFEFEFEFE FEFEEDEDED777A79878A88F8F9F9DADBF62929E64242E92D2DD4ADAEE5EFF0F0 EFF0F0EFF0F0EFF0F0EFF0F00000EFF0F1EFF0F1EFF0F1EFF0F1EFF0F1EBECF0 3E3EDE4B4BEA4444E95353EBF6F6F8F9FAFAFAFBFBFBFCFCFCFCFCFCFCFCFBFC FCFAFBFBF9FAFAF6F7F95353EB3B3BE83E3EE73838D4EAEBF0EFF0F1EFF0F1EF F0F1EFF0F1EFF0F10000F0F0F1F0F0F1F0F0F1F0F0F1F0F0F1F0F0F1CCCCED2D 2DE05C5CED3434E85454ECDCDDF7F9FAFAFAFAFAFAFBFBFAFBFBFAFAFAF9FAFA DCDDF75454EC2F2FE84C4CEB2626D6CBCBEBF0F0F1F0F0F1F0F0F1F0F0F1F0F0 F1F0F0F10000F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1F0F1F18B8CE93939 E56464ED4F52ED2D2DE98485F0B2B2F3DDDEF7DDDEF7B2B3F48485F02C2CE944 48EB5354EC3232DE898AE4F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1 0000F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2EEEFF28E8FEA3031E4 595BEE7A81F16E77F1565CEE3638EA3537EA5258EE6670F06C74EF4C4EEB2C2C DC8B8BE6EEEFF2F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2F0F1F20000F1F1 F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2D0D0EF4545E540 40E75253EC7173F09496F49193F36A6CF0494AEA3939E34242E0CFCFEEF1F1F2 F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F20000F1F2F2F1F2F2 F1F2F2F1F2F2F1F2F2F1F2F2F1F2F2F1F2F2F1F2F2F1F2F2EEEFF2B2B3EE8686 EC5252E72E2EE52E2EE45151E58585EAB1B2EDEEEFF2F1F2F2F1F2F2F1F2F2F1 F2F2F1F2F2F1F2F2F1F2F2F1F2F2F1F2F2F1F2F20000F1F2F3F1F2F3F1F2F3F1 F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3 F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2 F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F30000F2F2F3F2F2F3F2F2F3F2F2F3F2F2 F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2 F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3 F2F2F3F2F2F3F2F2F3F2F2F30000F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3 F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3 F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2 F3F3F2F3F3F2F3F30000F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2 F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4 F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3 F4F2F3F40000F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3 F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3 F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4 0000 } OnClick = SpeedButtonDeleteClick ShowHint = True ParentShowHint = False end object SpeedButtonTools: TSpeedButton AnchorSideLeft.Control = SpeedButtonText AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel1 Left = 219 Height = 38 Hint = 'Tools - Sync, Export, Spell' Top = 1 Width = 38 Glyph.Data = { FE0A0000424DFE0A00000000000036000000280000001E0000001E0000000100 180000000000C80A000064000000640000000000000000000000E6E7E8E6E7E8 E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7 E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6 E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E80000E6E7E8E6E7E8E6E7E8E6 E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8 E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7 E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E80000E6E8E9E6E8E9E6E8E9E6E8E9E6E8 E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6 E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9 E6E8E9E6E8E9E6E8E9E6E8E90000E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9 E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8 E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7 E8E9E7E8E9E7E8E90000E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E6E7E8E2E3E4D9 DADBCFCFD0C5C6C7C2C3C4C5C6C7CFCFD0D9DADBE2E3E4E6E7E8E7E8E9E7E8E9 E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8 E9E7E8E90000E7E9EAE7E9EAE7E9EAE7E9EAE7E9EAE4E6E7DADCDDC7C9CAB2B4 B5A2A4A49C9D9EA2A4A4B2B4B5C7C9CAD9DBDCE3E5E6E6E8E9E6E8E9E5E7E8E5 E7E8E5E7E8E5E7E8E6E8E9E6E8E9E6E8E9E7E9EAE7E9EAE7E9EAE7E9EAE7E9EA 0000E8E9EAE8E9EAE8E9EAE8E9EAE8E9EAE3E4E5D7D8D9545856535755676B68 878788676B68535755545856ADAFB0DFE0E1E1E2E3DFE0E1DDDEDFDCDDDEDCDD DEDDDEDFDFE0E1E2E3E4E3E4E5E6E7E8E7E8E9E8E9EAE8E9EAE8E9EA0000E8E9 EAE8E9EAE8E9EAE8E9EAE8E9EAE5E6E7535755CECFCFE0E2E2ADB0AFC5C7C6AD B0AFE0E2E2CECFCF535755D1D2D3CDCECEC6C7C8C2C3C34B4A4437352F5C5D58 989796CBCCCDD6D7D8DEDFE0E4E5E6E8E9EAE8E9EAE8E9EA0000E9EAEBE9EAEB E9EAEBE9EAEBE9EAEBE8E9EA545856E0E1E1F8F8F8FBFCFCF7F7F7FBFCFCF8F8 F8E0E1E15054513F3D36828280A4A4A59A9B9C3A38337B7D7A6A6B6936342EB0 B0B1C0C1C2D0D1D2DFE0E1E9EAEBE9EAEBE9EAEB0000E9EAEBE9EAEBE9EAEBE9 EAEBE9EAEBE9EAEB808382ACAFAFFBFBFBA0A3A25E6260A0A3A2FBFBFB9E9F9F 3E3D3691939041403A44423E3A39333F3E399195938589863B3A359FA0A0B2B3 B4C8C9CADBDCDDE9EAEBE9EAEBE9EAEB0000E9EAEBE9EAEBE9EAEBE9EAEBE9EA EBE9EAEBDBDCDDC4C5C5F7F7F7535755C4C5C6535755F7F7F7404039929390A5 A9A7959896ADAFACD4D8D6DCE2DED6DCD8B6BAB83B3A35AAABABBFC0C1CFCFD0 DDDEDFE9EAEBE9EAEBE9EAEB0000EAEBECEAEBECEAEBECEAEBECEAEBECEAEBEC 808482ACAFAFFBFBFBA0A3A25F6261A0A3A2FBFBFB818381403E399CA09ED1D4 D2CFD4D1C0C6C3BFC6C2C9D0CBD7DCD9CDD2CF3D3C35413F3A36342EAEAFADEA EBECEAEBECEAEBEC0000EAEBECEAEBECEAEBECEAEBECEAEBECEAEBEC545856E0 E1E1F8F8F8FBFCFCF7F7F7FBFCFCF8F8F8E0E1E13C3C36AEB0AECED2D0B4B9B6 D8DCDAE9EBE9E2E5E3C3CAC5D4D9D7BCC0BC959895A0A29F686965EAEBECEAEB ECEAEBEC0000EAEBECEAEBECEAEBECEAEBECEAEBECEAEBEC535755CECFCFE0E2 E2AEB1B0C6C8C7AEB1B0E0E2E2CBCCCC3B3933D5D7D6AAAFACC4C8C6ADAFAC46 4440B5B7B4DCE0DEC0C6C2D8DCDBABAEADADAFAE3B3933EAEBECEAEBECEAEBEC 0000EBECEDEBECEDEBECEDEBECEDEBECEDEBECEDEBECED545856535755838684 DEE0E08386843F3F3B3A383243413BE7E9E8979C99BEC1BF4A4943EAEBEC4C4A 44DADDDBB0B7B3DEE1DF41403A3E3B368F8D8BEBECEDEBECEDEBECED0000EEEF EFEEEFEFEEEFEFEEEFEFEEEFEFEEEFEFEEEFEFEEEFEFEEEFEFEEEFEFEEEFEFEE EFEF3B3933B3B4B3D3D5D5E7E8E79EA2A0A5A9A79B9D9B44423EA4A5A3C1C4C2 B1B6B3D6D9D743413CEBECECEEEFEFEEEFEFEEEFEFEEEFEF0000EEEFF0EEEFF0 EEEFF0EEEFF0EEEFF0EEEFF0EEEFF0EEEFF0EEEFF0EEEFF0EEEFF0EEEFF06E6D 69B8B9B7C7C9C7CCCDCCD0D1D0898D8B9A9E9CA8ABAAABAFAD9EA2A0D2D4D3B4 B6B3565550EEEFF0EEEFF0EEEFF0EEEFF0EEEFF00000EEEFF0EEEFF0EEEFF0EE EFF0EEEFF0EEEFF0EEEFF0EEEFF0EEEFF0545856535755848785AEAFAD36342E 3D3B353E3C36DBDCDCD6D7D79EA2A0888C8A9EA1A0D1D3D2DDDEDEB8BBB98281 7EABACAAEEEFF0EEEFF0EEEFF0EEEFF00000EFF0F0EFF0F0EFF0F0EFF0F0EFF0 F0EFF0F0EFF0F0EFF0F0535755CECFCFE0E2E2AEB1B0C5C7C6A2A5A3DFE1E1AA ABA93A3833CCCECDECEDEDFBFBFBEEEEEEC1C2C0C1C2C1D9DBDB9D9E9B45443E EFF0F0EFF0F0EFF0F0EFF0F00000EFF0F1EFF0F1EFF0F1EFF0F1EFF0F1EFF0F1 EFF0F1EFF0F1545856E0E1E1F8F8F8FBFCFCF7F7F7FBFCFCF8F8F8DEDFDF3C3A 35D8DAD9ECEEEE494742403E3953524D848380A3A4A1484742D9D9DAEFF0F1EF F0F1EFF0F1EFF0F10000F0F0F1F0F0F1F0F0F1F0F0F1F0F0F1F0F0F1F0F0F1F0 F0F1818583ACAFAFFBFBFBA0A3A25F6361A0A3A2FBFBFB999B9A36342EBEBEBD CCCDCC403E38EAEAEBF0F0F1AAAAA742403AD9D9D9F0F0F1F0F0F1F0F0F1F0F0 F1F0F0F10000F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1E1E2 E2C4C5C5F7F7F7535755CCCCCC535755F7F7F7C1C2C2B0B0AE6F6F6A37353054 534EF0F1F1F0F1F1F0F1F1EFF0F0F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1 0000F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2818583ACAFAF FBFBFBA0A3A25F6361A0A3A2FBFBFBACAFAF818583F0F1F2F0F1F2F0F1F2F0F1 F2F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2F0F1F20000F1F1 F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2545856E0E1E1F8F8F8FB FCFCF7F7F7FBFCFCF8F8F8E0E1E1545856F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2 F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F20000F1F2F2F1F2F2 F1F2F2F1F2F2F1F2F2F1F2F2F1F2F2F1F2F2535755CECFCFE0E2E2AEB1B0C7C8 C8AEB1B0E0E2E2CECFCF535755F1F2F2F1F2F2F1F2F2F1F2F2F1F2F2F1F2F2F1 F2F2F1F2F2F1F2F2F1F2F2F1F2F2F1F2F2F1F2F20000F1F2F3F1F2F3F1F2F3F1 F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3545856535755858886E3E5E5858886 535755545856F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2 F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F30000F2F2F3F2F2F3F2F2F3F2F2F3F2F2 F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2 F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3 F2F2F3F2F2F3F2F2F3F2F2F30000F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3 F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3 F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2 F3F3F2F3F3F2F3F30000F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2 F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4 F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3 F4F2F3F40000F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3 F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3 F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4 0000 } OnClick = SpeedButtonToolsClick ShowHint = True ParentShowHint = False end object SpeedButtonText: TSpeedButton AnchorSideLeft.Control = SpeedButtonLink AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel1 Left = 181 Height = 38 Hint = 'Font size, bold, italics etc' Top = 1 Width = 38 Glyph.Data = { FE0A0000424DFE0A00000000000036000000280000001E0000001E0000000100 180000000000C80A000064000000640000000000000000000000E6E7E8E6E7E8 E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7 E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6 E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E80000E6E7E8E6E7E8E6E7E8E6 E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8 E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7 E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E80000E6E8E9E6E8E9E6E8E9E6E8E9E6E8 E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6 E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9 E6E8E9E6E8E9E6E8E9E6E8E90000E7E8E9E7E8E9E5E6E7E0E1E2D9D9DAD2D3D4 D0D1D2CFD0D1CFD0D1CFD0D1CFD0D1CFD0D1CFD0D1CFD0D1CFD0D1CFD0D1CFD0 D1CFD0D1CFD0D1CFD0D1CFD0D1CFD0D1D1D2D3D6D7D8DDDEDFE3E4E5E7E8E9E7 E8E9E7E8E9E7E8E90000E7E8E9E7E8E9E1E2E3D2D3D4C1C2C3B7B8B9B4B5B6B3 B4B5B3B4B5B3B4B5B3B4B5B3B4B5B3B4B5B3B4B5B3B4B5B3B4B5B3B4B5B3B4B5 B3B4B5B3B4B5B3B4B5B3B4B5B5B6B7BCBCBDCBCCCDDDDEDFE7E8E9E7E8E9E7E8 E9E7E8E90000E7E9EAE7E9EADCDEDFBABDBD939896848987858A88858A88858A 88858A88858A88858A88858A88858A88858A88858A88858A88858A88858A8885 8A88858A88858A88848987929695B2B4B5D6D8D9E7E9EAE7E9EAE7E9EAE7E9EA 0000E8E9EAE8E9EADDDEDF979D9BD3D6D5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFD4D7D6969A99D8D9D9E8E9EAE8E9EAE8E9EAE8E9EA0000E8E9 EAE8E9EAE3E4E4848987FFFFFFECEEEEEBEEEDEEF0EFF0F2F1F2F4F3F4F6F5F7 F8F7F9FAF9CAC9C8CACAC9F5F5F5C8C9C6B5B4B2E1E2E1F2F4F3F0F2F1EEF0EF EEF0EFFFFFFF848987DEDFE0E8E9EAE8E9EAE8E9EAE8E9EA0000E9EAEBE9EAEB E7E8E9858A88FFFFFFE9EDEBEBEFEDEEF1EFF0F3F1F3F5F4F5F7F6F7F9F8F8F9 F836342E36342E6B6A6636342E36342E414039CBCCCAF0F3F1EEF1EFEBEFEDFF FFFF858A88E6E7E8E9EAEBE9EAEBE9EAEBE9EAEB0000E9EAEBE9EAEBE9EAEB85 8A88FFFFFFE9EDEBEBEFEDEEF0EFF0F2F1F2F4F3F5F6F6F7F8F8F7F8F836342E 36342E73726ECFCFCE706F6A36342E686662F0F2F1EEF0EFEBEFEDFFFFFF858A 88E9EAEBE9EAEBE9EAEBE9EAEBE9EAEB0000E9EAEBE9EAEBE9EAEB858A88FFFF FFE9ECEAEBEEEDEDF0EFF0F2F1F2F4F3F4F6F5F6F8F7F6F7F736342E36342ECD CECCF8F9F9C4C5C336342E3D3B35EFF1F0EDF0EFEBEEEDFFFFFF858A88E9EAEB E9EAEBE9EAEBE9EAEBE9EAEB0000EAEBECEAEBECEAEBEC858A88FFFFFFE8ECEA EAEEECECEFEEEFF1F0F1F3F2F3F5F4F5F6F5F4F6F536342E36342ECECECDF6F8 F7C6C7C436342E3C3A34EDEFEEECEFEEEAEEECFFFFFF858A88EAEBECEAEBECEA EBECEAEBECEAEBEC0000EAEBECEAEBECEAEBEC858A88FFFFFFE7EBE9E9EDEBEB EFEDEDF0EFEFF2F1F1F3F2F3F5F4F2F4F336342E36342E757470D2D3D1757570 36342E62625DEDF0EFEBEFEDE9EDEBFFFFFF858A88EAEBECEAEBECEAEBECEAEB ECEAEBEC0000EAEBECEAEBECEAEBEC858A88FFFFFFE6EAE8E8ECEAEAEDECECEF EDEEF0EFEFF2F0F1F3F2F0F2F136342E36342E65635F36342E36342E3E3D37C3 C4C3ECEFEDEAEDECE8ECEAFFFFFF858A88EAEBECEAEBECEAEBECEAEBECEAEBEC 0000EBECEDEBECEDEBECED858A88FFFFFFE5E9E7E7EBE9E8ECEAEAEEECECEFED EDF0EFEEF1F0EDF0EF36342E36342EDEE0DEBABBB8A5A6A2D6D9D7ECEFEDEAEE ECE8ECEAE7EBE9FFFFFF858A88EBECEDEBECEDEBECEDEBECEDEBECED0000EEEF EFEEEFEFEEEFEF858A88FFFFFFE3E8E5E5E9E7E7EBE9DBDEDCE7EAE8EBEEEDEC EFEEEBEEEC36342E36342EDEDFDEEDF0EEECEFEEEBEEEDEAEDEBE8ECEAE7EBE9 E5E9E7FFFFFF858A88EEEFEFEEEFEFEEEFEFEEEFEFEEEFEF0000EEEFF0EEEFF0 EEEFF0858A88FFFFFFE2E6E4DBE0DE62615C4F4D48494843949591383630E9ED EB4C4B454C4B45DDE0DEEAEEECEAEDEBE9ECEBE8ECEAE6EAE8E5E9E7E3E8E6FF FFFF858A88EEEFF0EEEFF0EEEFF0EEEFF0EEEFF00000EEEFF0EEEFF0EEEFF085 8A88FFFFFFE0E5E2A0A39E61615BE4E9E6DDE2E06F6F6A383630E8ECEAE8ECEA E9ECEAE8ECEAE8ECEAC5C7C473736E5A595472726DE3E8E5E1E6E4FFFFFF858A 88EEEFF0EEEFF0EEEFF0EEEFF0EEEFF00000EFF0F0EFF0F0EFF0F0858A88FFFF FFDEE3E1B0B3B0575752E2E7E5E3E8E6B6BAB6383630E6EAE8E6EAE8E6EAE8E6 EAE8E6EAE8666660B2B4B0E3E8E6CDD1CEDFE4E1DFE5E2FFFFFF858A88EFF0F0 EFF0F0EFF0F0EFF0F0E8F0F00000EFF0F1EFF0F1EFF0F1858A88FFFFFFDCE2DF DDE3E075767151514B61605B686762393731E3E8E5E3E8E6E4E8E6E3E8E6E3E8 E547463FE0E5E2E1E6E3E0E5E3DFE4E1DDE3E0FFFFFF858A88EFF0F1EFF0F1EF F0F1EFF0F1D3EEF10000F0F0F1F0F0F1F0F0F1858A88FFFFFFDAE0DDDBE1DEDD E2DFDDE2DFC8CDC9A6A9A5474640E1E6E3E1E6E3E1E6E3E1E6E3E1E6E35E5D58 C2C5C1DFE4E1DEE3E0DDE2DFDBE1DEFFFFFF858A88F0F0F1F0F0F1F0F0F1F0F0 F1F0F0F10000F0F1F1F0F1F1F0F1F1858A88FFFFFFD8DEDBD1D7D3898B88B2B6 B2A6AAA65D5D587E7F7ADEE4E1DEE4E1DFE4E1DEE4E1DEE4E1AFB2AF63635ED5 DBD8DBE1DECDD2D0D9DFDCFFFFFF858A88F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1 0000F0F1F2F0F1F2F0F1F2858A88FFFFFFD6DDD9D4DBD794979270716D6D6E69 939590D8DEDBDCE1DFDCE2DFDCE2DFDCE2DFDCE1DFDBE1DEA0A49F5C5B565756 526E6F6AD7DEDAFFFFFF858A88F0F1F2F0F1F2F0F1F2F0F1F2F0F1F20000F1F1 F2F1F1F2F1F1F2858A88FFFFFFD9E0DCD5DCD8D6DDD9D7DDDAD8DEDBD8DFDBD9 DFDCD9DFDCD9E0DDDAE0DDD9E0DDD9DFDCD9DFDCD8DFDBD8DEDBD7DDDAD6DDD9 DAE0DDFFFFFF858A88F1F1F2F1F1F2F1F1F2F1F1F2F1F1F20000F1F2F2F1F2F2 F1F2F2A0A5A3CDD1CFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFCE D2D0A0A5A3F1F2F2F1F2F2F1F2F2F1F2F2F1F2F20000F1F2F3F1F2F3F1F2F3DD DEDFA0A5A3858A88858A88858A88858A88858A88858A88858A88858A88858A88 858A88858A88858A88858A88858A88858A88858A88858A88858A88A0A5A3DDDE DFF1F2F3F1F2F3F1F2F3F1F2F3F1F2F30000F2F2F3F2F2F3F2F2F3F2F2F3F2F2 F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2 F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3 F2F2F3F2F2F3F2F2F3F2F2F30000F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3 F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3 F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2 F3F3F2F3F3F2F3F30000F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2 F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4 F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3 F4F2F3F40000F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3 F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3 F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4 0000 } OnClick = SpeedButtonTextClick ShowHint = True ParentShowHint = False end object SpeedButtonLink: TSpeedButton AnchorSideLeft.Control = SpeedButtonSearch AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel1 Left = 143 Height = 38 Hint = 'Link highlighted text to a new note' Top = 1 Width = 38 Glyph.Data = { FE0A0000424DFE0A00000000000036000000280000001E0000001E0000000100 180000000000C80A000064000000640000000000000000000000E6E7E8E6E7E8 E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7 E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6 E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E80000E6E8E9E6E8E9E6E8E9E6 E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9 E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8 E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E90000E7E8E9E7E8E9E7E8E9E7E8E9E7E8 E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7 E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9 E7E8E9E7E8E9E7E8E9E7E8E90000E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9 E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E3E4E5DBDC DDD2D3D4CECFCFD2D3D4DBDCDDE3E4E5E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7 E8E9E7E8E9E7E8E90000E7E9EAE7E9EAE7E9EAE7E9EAE7E9EAE7E9EAE7E9EAE7 E9EAE7E9EAE7E9EAE7E9EAE7E9EAE7E9EAE7E9EAD6D8D9C4C5C6B2B3B4989A9A 6B6F6E98999AB2B3B4C4C5C6D6D8D9E7E9EAE7E9EAE7E9EAE7E9EAE7E9EAE7E9 EAE7E9EA0000E8E9EAE8E9EAE8E9EAE8E9EAE8E9EAE8E9EAE8E9EAE8E9EAE8E9 EAE8E9EAE8E9EAE8E9EAE8E9EAE8E9EAE2E3E4CFD0D1B4B6B56E7370999E9B6A 6F6EB3B4B4CFD0D1E2E3E4E8E9EAE8E9EAE8E9EAE8E9EAE8E9EAE8E9EAE8E9EA 0000E8E9EAE8E9EAE8E9EAE8E9EAE8E9EAE8E9EAE8E9EAE8E9EAE8E9EAE8E9EA E8E9EAE8E9EAE8E9EAE8E9EAE8E9EAD5D6D6777D7BBABEBDDCDFDEB8BCBA7075 72D3D4D5E8E9EAE8E9EAE8E9EAE8E9EAE8E9EAE8E9EAE8E9EAE8E9EA0000E9EA EBE9EAEBE9EAEBE9EAEBE9EAEBE9EAEBE9EAEBE9EAEBE9EAEBE9EAEBE9EAEBE9 EAEBE9EAEBE9EAEBD6D8D87D827FBEC2C1D8DCDAC2C8C6D7DAD9BBBEBD727774 D4D5D6E9EAEBE9EAEBE9EAEBE9EAEBE9EAEBE9EAEBE9EAEB0000E9EAEBE9EAEB E9EAEBE9EAEBE9EAEBE9EAEBE9EAEBE9EAEBE9EAEBE9EAEBE9EAEBE9EAEBE9EA EBD7D8D9828786C2C6C4DCDFDEC9CFCDE9ECEBC7CCCAD8DCDBBCBFBE737876D4 D5D6E9EAEBE9EAEBE9EAEBE9EAEBE9EAEBE9EAEB0000E9EAEBE9EAEBE9EAEBE9 EAEBE9EAEBE9EAEBE9EAEBE9EAEBE9EAEBE9EAEBE9EAEBE9EAEBDADCDC878C89 C6CAC8DFE2E1CFD2D1F6F6F6FAFAFAF5F6F6CACFCDDADEDDBEC2C1757A77D7D9 DAE9EAEBE9EAEBE9EAEBE9EAEBE9EAEB0000EAEBECEAEBECEAEBECEAEBECEAEB ECEAEBECEAEBECEAEBECEAEBECEAEBECEAEBECEAEBECA5A9A8D2D4D4E2E5E4D2 D7D5F6F7F7E9EBEA787D7BE9EAE9F5F6F6CCD2D0DCE0DEB7BCBA9EA2A1EAEBEC EAEBECEAEBECEAEBECEAEBEC0000EAEBECEAEBECEAEBECEAEBECEAEBECEAEBEC EAEBECEAEBECEAEBECEAEBECEAEBECEAEBEC909593FDFDFDE9EBEAF7F8F8EBEC EB878C89C6C8C8848887E9EAEAF5F6F6D8DBDAE2E4E4797E7BEAEBECEAEBECEA EBECEAEBECEAEBEC0000EAEBECEAEBECEAEBECEAEBECEAEBECEAEBECEAEBECEA EBECEAEBECEAEBECEAEBECEAEBECAFB3B2D4D7D5FAFAFAE5E6E68C9190D9DADB EAEBECD8DADA858988E4E6E5FDFDFDD5D7D6A4A6A6EAEBECEAEBECEAEBECEAEB ECEAEBEC0000EBECEDEBECEDEBECEDEBECEDEBECEDEBECEDEBECEDEBECEDEBEC EDEBECEDEBECEDEBECEDE2E4E4B2B6B5919693B0B3B1DDDFDFEBECEDEBECEDEB ECEDDCDDDDA1A4A4838785A5A9A7E0E1E2EBECEDEBECEDEBECEDEBECEDEBECED 0000EEEFEFEEEFEFEEEFEFEEEFEFEEEFEFEEEFEFEEEFEFEEEFEFEEEFEFEEEFEF EEEFEFEEEFEFEEEFEFEEEFEFEEEFEFEEEFEFE2E4E3B0B5B3919794AEB3B1E1E3 E2EEEFEFEEEFEFEEEFEFEEEFEFEEEFEFEEEFEFEEEFEFEEEFEFEEEFEF0000EEEF F0EEEFF0EEEFF0EEEFF0EEEFF0EEEFF0EEEFF0EEEFF0EEEFF0EEEFF0EEEFF0EE EFF0EEEFF0EEEFF0EEEFF0EEEFF0B4B9B7CDD0CEE4E6E6B2B6B5AFB3B2EEEFF0 EEEFF0EEEFF0EEEFF0EEEFF0EEEFF0EEEFF0EEEFF0EEEFF00000EEEFF0EEEFF0 EEEFF0EEEFF0EEEFF0EEEFF0EEEFF0EEEFF0EEEFF0EEEFF0EEEFF0EEEFF0EEEF F0EEEFF0EEEFF0EEEFF09AA09EFDFDFDF3F4F4EFF0F0949997EEEFF0EEEFF0EE EFF0EEEFF0EEEFF0EEEFF0EEEFF0EEEFF0EEEFF00000EFF0F0EFF0F0EFF0F0EF F0F0EFF0F0EFF0F0EFF0F0E6E8E8C4C8C6ACB3B0C1C5C4E5E7E7EFF0F0EFF0F0 EFF0F0EFF0F0B9BDBBDBDEDDFDFDFDDADDDBB5B8B6EFF0F0EFF0F0EFF0F0EFF0 F0EFF0F0EFF0F0EFF0F0EFF0F0EFF0F00000EFF0F1EFF0F1EFF0F1EFF0F1EFF0 F1EFF0F1EFF0F1C7CCCBD9DBDBE8EAEAC4C7C6C2C6C5EFF0F1EFF0F1EFF0F1EF F0F1E5E6E7B9BEBD9DA3A1B7BBBAE4E5E6EFF0F1EFF0F1EFF0F1EFF0F1EFF0F1 EFF0F1EFF0F1EFF0F1EFF0F10000F0F0F1F0F0F1F0F0F1F0F0F1F0F0F1F0F0F1 F0F0F1B6BCB9FDFDFDF3F4F4F1F2F2AFB5B3F0F0F1E7E8E8C0C4C3A7ADABBEC2 C0E6E7E7F0F0F1F0F0F1F0F0F1F0F0F1F0F0F1F0F0F1F0F0F1F0F0F1F0F0F1F0 F0F1F0F0F1F0F0F10000F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1CC D1CFE5E7E6FDFDFDE3E6E5C7CBC9F0F1F1C4C9C7D7D9D9E7E9E9C0C5C3BFC3C1 F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1F0F1 F1F0F1F10000F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2E9EBEBCCD1 CFB8BFBCCACFCDE8EAEBF0F1F2B2B8B5FDFDFDF3F4F4F1F2F1AAB0AEF0F1F2F0 F1F2F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2 0000F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2 F1F1F2F1F1F2F1F1F2C9CDCCE3E5E4FDFDFDE2E4E3C3C7C6F1F1F2F1F1F2F1F1 F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F20000F1F2 F2F1F2F2F1F2F2F1F2F2F1F2F2F1F2F2F1F2F2F1F2F2F1F2F2F1F2F2F1F2F2F1 F2F2F1F2F2EAEBEBC9CFCDB4BAB8C7CCCAE9EAEAF1F2F2F1F2F2F1F2F2F1F2F2 F1F2F2F1F2F2F1F2F2F1F2F2F1F2F2F1F2F2F1F2F2F1F2F20000F1F2F3F1F2F3 F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2 F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1 F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F30000F2F2F3F2F2F3F2F2F3F2 F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3 F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2 F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F30000F2F3F3F2F3F3F2F3F3F2F3F3F2F3 F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2 F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3 F2F3F3F2F3F3F2F3F3F2F3F30000F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4 F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3 F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2 F3F4F2F3F4F2F3F40000F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3 F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4 F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3 F4F3F3F40000F3F4F4F3F4F4F3F4F4F3F4F4F3F4F4F3F4F4F3F4F4F3F4F4F3F4 F4F3F4F4F3F4F4F3F4F4F3F4F4F3F4F4F3F4F4F3F4F4F3F4F4F3F4F4F3F4F4F3 F4F4F3F4F4F3F4F4F3F4F4F3F4F4F3F4F4F3F4F4F3F4F4F3F4F4F3F4F4F3F4F4 0000 } OnClick = SpeedButtonLinkClick ShowHint = True ParentShowHint = False end object SpeedButtonSearch: TSpeedButton AnchorSideLeft.Control = ButtMainTBMenu AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel1 Left = 105 Height = 38 Hint = 'Search All Notes Ctrl-Shift-F' Top = 1 Width = 38 Glyph.Data = { FE0A0000424DFE0A00000000000036000000280000001E0000001E0000000100 180000000000C80A000064000000640000000000000000000000E6E7E8E6E7E8 E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7 E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6 E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E80000E6E7E8E6E7E8E6E7E8E6 E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8 E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7 E8E6E7E8E6E7E8E6E7E8E6E7E8E6E7E80000E6E8E9E6E8E9E6E8E9E6E8E9E6E8 E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6 E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9E6E8E9 E6E8E9E6E8E9E6E8E9E6E8E90000E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9 E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E6E7E8E6E7E8E5E6E7E3E4E5E2E3E4E2E3 E4E1E2E3E0E1E2E1E2E3E2E3E4E2E3E4E3E4E5E5E6E7E6E7E8E6E7E8E7E8E9E7 E8E9E7E8E9E7E8E90000E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7E8E9E7 E8E9E7E8E9E6E7E8E5E6E7E3E4E5E0E1E2DCDDDED7D8D9D1D2D3CDCECFC9CACB C7C8C9C6C7C8C6C7C8C7C8C9CBCCCD9D9FA0606365AAACADE4E5E6E6E7E8E7E8 E9E7E8E90000E7E9EAE7E9EAE7E9EAE7E9EAE7E9EAE7E9EAE7E9EAE7E9EAE6E8 E9E4E6E7E1E3E4DCDEDFD5D7D8CFD0D1C7C9CABFC1C2B8B9BAB2B3B4ABADADA4 A5A69799998486873B3E3F1D202325292C1C1F23ADB0B1E3E5E6E7E9EAE7E9EA 0000E8E9EAE8E9EAE8E9EAE8E9EAE8E9EAE8E9EAE8E9EAE8E9EAE7E8E9E5E6E7 E1E2E3DADBDCD3D4D5CBCCCDC4C4C5BBBCBDB3B4B5ACADADA3A4A49292937071 712426281E2123292E305F676C41474C7D7E80E2E3E4E8E9EAE8E9EA0000E8E9 EAE8E9EAE8E9EAE8E9EAE8E9EAE8E9EAE8E9EAE8E9EAE7E8E9E6E7E8E3E4E5DE DFE0D9D9DAD1D1D2C9CACAC3C4C4BBBCBDB5B6B7AFAFB088888A2022252A2C2D 3838375C646A737B8122262AC4C5C6E4E5E6E8E9EAE8E9EA0000E9EAEBE9EAEB E9EAEBE9EAEBE9EAEBE9EAEBE9EAEBE9EAEBE9EAEBE8E9EAC4B7ADA28672865E 42734221724220835A3E977B67AFA1968B8D8F1F21243F3D3848443E5761677F 878E23272BB6B7B8E5E6E7E8E9EAE9EAEBE9EAEB0000E9EAEBE9EAEBE9EAEBE9 EAEBE9EAEBE9EAEBE9EAEBE9EAEBDFDCDA9370587B492B8B4B39975145A25550 A255509751458C4B397643255D39205A4B3F595046555E638892982D2F34A4A7 A8E8E9EAE9EAEBE9EAEBE9EAEBE9EAEB0000E9EAEBE9EAEBE9EAEBE9EAEBE9EA EBE9EAEBE9EAEBCABEB57849288D4F3BB25C57AA5A51A15E51925A4885564284 58448A5344A357548B4B396F3F1E5B564F8D979F393E41888B8DE9EAEBE9EAEB E9EAEBE9EAEBE9EAEBE9EAEB0000EAEBECEAEBECEAEBECEAEBECEAEBECEAEBEC E1DEDC784A299D554BC05E5AB9645EAA766CBEA69ED0C9C5D0CBC8BAACA3977D 6C77533D98574C9F564C74472848494B696C70EAEBECEAEBECEAEBECEAEBECEA EBECEAEBECEAEBEC0000EAEBECEAEBECEAEBECEAEBECEAEBECEAEBEC96735B8E 513DC5605CB96663BEA09BE2E3E5E8E9EAE8EAEBE8EAEBE7E9EAE4E6E7BDB3AD 76553F9C5A5292503F67432BE8E9EAEAEBECEAEBECEAEBECEAEBECEAEBECEAEB ECEAEBEC0000EAEBECEAEBECEAEBECEAEBECEAEBECC8BCB37C4A2CB7635EB75F 5BB79993E0E1E3E8E9EBE9E9EAE9EAEBE8EAEBE8E9EAE8E9EAE4E6E7B6ACA574 523CB36662814C30C5B6ACEAEBECEAEBECEAEBECEAEBECEAEBECEAEBECEAEBEC 0000EBECEDEBECEDEBECEDEBECEDEBECEDA88E7B91533FB25D54996960D7D9DA E6E8E9E8EAEBEAEBEDEBECEDEBECEDEAEBECE9EBECE8EAEBDDDEDF8A73638F57 4A9E5C4CA48773EBECEDEBECEDEBECEDEBECEDEBECEDEBECEDEBECED0000EEEF EFEEEFEFEEEFEFEEEFEFEEEFEF93684DA25D509A5448AA9189DEDFDFECECECEC EDEDEEEFEFEEEFEFEDEEEEEDEFEFEDEEEEEBECEDE3E4E5A99D947C5243B66A62 8E6345EEEFEFEEEFEFEEEFEFEEEFEFEEEFEFEEEFEFEEEFEF0000EEEFF0EEEFF0 EEEFF0EEEFF0EEEFF0834D27B26963824A3AB4AAA7DDDEDFEBECEDECEEEFEEEF F0EDEEEFEDEEEFEDEEF0ECEDEFEBECEDE1E3E4BDB8B4674631C87B78824B26ED EEEEEEEFF0EEEFF0EEEFF0EEEFF0EEEFF0EEEFF00000EEEFF0EEEFF0EEEFF0EE EFF0EEEFF089512BB66D67784833AEA5A1D7D9DAE7E9EAEBECEEECEEEFEDEFF0 EDEEEFECEEEFECEDEEEBECECDDDEDFB8B3AF63412DCE8380884F28EEEEEFEEEF F0EEEFF0EEEFF0EEEFF0EEEFF0EEEFF00000EFF0F0EFF0F0EFF0F0EFF0F0EFF0 F0A27353AD68597B493997887FCCCDCDE1E2E3ECECECECEEEEEDEEEEEDEFEFED EEEEECEEEEE5E6E7D2D4D49B8D85785141C9827A9E6D4BEFF0F0EFF0F0EFF0F0 EFF0F0EFF0F0EFF0F0EFF0F00000EFF0F1EFF0F1EFF0F1EFF0F1EFF0F1BC9B83 A7644C945848715948B9BABAD1D3D4E0E1E3E8E9EBECEDEEF6F6F6FAFAFAF4F4 F4DDDFDFC0C1C26D56499F6A5FC07C6EB9947BEFF0F1EFF0F1EFF0F1EFF0F1EF F0F1EFF0F1EFF0F10000F0F0F1F0F0F1F0F0F1F0F0F1F0F0F1D9C7BC9F5E35BC 74706A3F2B8C8077B8BABACDCDCDD7D8D8E9E9EAFAFBFBFFFFFFF4F4F5C9CACA 93877F5F3D2DDE9F9EAB6A47D6C2B5F0F0F1F0F0F1F0F0F1F0F0F1F0F0F1F0F0 F1F0F0F10000F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1B88969B46E53AD69 62623D27897C73ABADADBABABAC9CBCCE1E1E1DDDDDEB9B9B9877B73543727C6 918DCB8D7DB58361F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1F0F1F1 0000F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2EBE6E4A86637C57C6FAA6762 5E38286D524288796E908984918A8584756B674F415B3A2CD4A7A3E3ADA9A965 37E9E4E0F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2F0F1F2F0F1F20000F1F1 F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2E0CEC2AE6A3AC1785FD0888690 584F5E372F4629204C2D23653F39A5756EE9B7B6D59C8CB06A3ADECABCF1F1F2 F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F2F1F1F20000F1F2F2F1F2F2 F1F2F2F1F2F2F1F2F2F1F2F2F1F2F2F1F2F2EDE8E5C6926EB96F42CC816CD990 86E09C99E09F9DE0A099D79786BF7A52C48E68ECE6E1F1F2F2F1F2F2F1F2F2F1 F2F2F1F2F2F1F2F2F1F2F2F1F2F2F1F2F2F1F2F20000F1F2F3F1F2F3F1F2F3F1 F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3E2CEBFD2A789C5875DBA6E38 B96D37C4865CD1A688E1CCBDF1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2 F3F1F2F3F1F2F3F1F2F3F1F2F3F1F2F30000F2F2F3F2F2F3F2F2F3F2F2F3F2F2 F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2 F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3F2F2F3 F2F2F3F2F2F3F2F2F3F2F2F30000F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3 F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3 F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2F3F3F2 F3F3F2F3F3F2F3F30000F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2 F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4 F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3F4F2F3 F4F2F3F40000F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3 F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3 F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4F3F3F4 0000 } OnClick = SpeedButtonSearchClick ShowHint = True ParentShowHint = False end object ButtMainTBMenu: TSpeedButton AnchorSideLeft.Control = Panel1 AnchorSideTop.Control = Panel1 AnchorSideBottom.Control = SpeedButtonSearch AnchorSideBottom.Side = asrBottom Left = 1 Height = 38 Top = 1 Width = 104 Anchors = [akTop, akLeft, akBottom] Caption = 'Menu' Glyph.Data = { 36090000424D3609000000000000360000002800000018000000180000000100 2000000000000009000064000000640000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000003232 3238333333050000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000000000002E2E2E163636 36F93C3C3CF0393939863737371C000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000000000003737377D8080 80F6DEDEDEFF727272FA3A3A3ADC000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000003434348D34343440555555033D3D3DEBD9D9 D9FFFFFFFFFF777777F536363672000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000003E3E3EEB464646F53B3B3BEB595959F2FFFF FFFFEEEEEEFF3A3A3AF630303010000000000000000000000000000000000000 000000000000000000004D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D 4DFF4D4D4DFF4D4D4DFF4D4D4DFF3E3E3EFFE8E8E8FFCDCDCDFFCECECEFFFFFF FFFF9E9E9EFC3E3E3EB100000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF474747FFEAEAEAFFFFFFFFFFFFFFFFFFFFFF FFFFACACACFC434343F5404040D0323232510000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF454545FFEDEDEDFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFCFCFCFFF383838F9323232420000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FFFFFFFFFFFFFFFFFF414141FFF0F0F0FFFFFFFFFFFFFFFFFFFFFF FFFFD8D8D8FF3E3E3EF43333334B000000000000000000000000000000000000 000000000000000000004D4D4DFFFAFAFAFFFAFAFAFFFAFAFAFFFAFAFAFFFAFA FAFFFAFAFAFFFAFAFAFFFAFAFAFF3F3F3FFFF2F2F2FFFFFFFFFFFFFFFFFFD9D9 D9FF3E3E3EF53434344E00000000000000000000000000000000000000000000 000000000000000000004D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D 4DFF4D4D4DFF4D4D4DFF4D4D4DFF383838FFF5F5F5FFFFFFFFFFDBDBDBFF3E3E 3EF6353535570000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFAFAFAFFFAFAFAFFFAFAFAFFFAFAFAFFFAFA FAFFFAFAFAFFFAFAFAFFFAFAFAFF3A3A3AFFF8F8F8FFE0E0E0FF424242F53636 365A000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FFFFFFFFFFFFFFFFFF383838FFDDDDDDFF424242FF3636365E0000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF363636FF494949FF454545FF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FFFFFFFFFFFFFFFFFFFFFFFFFF353535FFAEAEAEFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFDFDFDFFA9A9A9FFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FF000000FFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D 4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000 } OnClick = ButtMainTBMenuClick PopupMenu = PopupMainTBMenu end end object KMemo1: TKMemo AnchorSideLeft.Control = Owner AnchorSideTop.Control = Panel1 AnchorSideTop.Side = asrBottom AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = PanelReadOnly Left = 0 Height = 366 Top = 40 Width = 695 Anchors = [akTop, akLeft, akRight, akBottom] ContentPadding.Left = 5 ContentPadding.Top = 5 ContentPadding.Right = 5 ContentPadding.Bottom = 5 ParentFont = False ParentShowHint = False TabOrder = 0 Visible = True OnChange = KMemo1Change OnKeyDown = KMemo1KeyDown OnKeyPress = KMemo1KeyPress OnKeyUp = KMemo1KeyUp OnMouseDown = KMemo1MouseDown OnMouseUp = KMemo1MouseUp end object PopupMenuText: TPopupMenu Left = 232 Top = 200 object MenuBold: TMenuItem Caption = 'Bold' ShortCut = 16450 OnClick = MenuTextGeneralClick end object MenuItalic: TMenuItem Caption = 'Italic' ShortCut = 16457 OnClick = MenuTextGeneralClick end object MenuStrikeout: TMenuItem Caption = 'Strikeout' ShortCut = 16467 OnClick = MenuTextGeneralClick end object MenuHighLight: TMenuItem Caption = 'Highlight' ShortCut = 16456 OnClick = MenuTextGeneralClick end object MenuFixedWidth: TMenuItem Caption = 'Fixed Width' ShortCut = 16468 OnClick = MenuTextGeneralClick end object MenuUnderline: TMenuItem Caption = 'Underline' ShortCut = 16469 OnClick = MenuTextGeneralClick end object MenuItem2: TMenuItem Caption = '-' end object MenuSmall: TMenuItem Caption = 'Small Font' ShortCut = 16433 OnClick = MenuTextGeneralClick end object MenuNormal: TMenuItem Caption = 'Normal Font' ShortCut = 16434 OnClick = MenuTextGeneralClick end object MenuLarge: TMenuItem Caption = 'Large Font' ShortCut = 16435 OnClick = MenuTextGeneralClick end object MenuHuge: TMenuItem Caption = 'Huge' ShortCut = 16436 OnClick = MenuTextGeneralClick end object MenuItem3: TMenuItem Caption = '-' end object MenuItemBulletRight: TMenuItem Caption = 'Bullet >>' ShortCut = 32807 OnClick = MenuTextGeneralClick end object MenuItemBulletLeft: TMenuItem Caption = 'Bullet <<' ShortCut = 32805 OnClick = MenuTextGeneralClick end end object PopupMenuTools: TPopupMenu Left = 368 Top = 200 object MenuItemSync: TMenuItem Caption = 'Synchronize' Enabled = False OnClick = MenuItemSyncClick end object MenuItemSettings: TMenuItem Caption = 'Settings' OnClick = MenuItemSettingsClick end object MenuItemExport: TMenuItem Caption = 'Export' object MenuItemExportRTF: TMenuItem Caption = 'Export RTF' OnClick = MenuItemExportRTFClick end object MenuItemExportPlainText: TMenuItem Caption = 'Export Plain Text' OnClick = MenuItemExportPlainTextClick end object MenuItemExportMarkdown: TMenuItem Caption = 'Export Markdown' OnClick = MenuItemExportMarkdownClick end end object MenuItemPrint: TMenuItem Caption = 'Print' OnClick = MenuItemPrintClick end object MenuItemSpell: TMenuItem Caption = 'Spell Check' OnClick = MenuItemSpellClick end object MenuItemIndex: TMenuItem Caption = 'Index' OnClick = MenuItemIndexClick end object MenuItemEvaluate: TMenuItem Caption = 'Evaluate' ShortCut = 16453 OnClick = MenuItemEvaluateClick end object MenuStayOnTop: TMenuItem Caption = 'Stay On Top' OnClick = MenuStayOnTopClick end end object PopupMenuRightClick: TPopupMenu Left = 80 Top = 200 object MenuItemFind: TMenuItem Caption = 'Find in this Note' ShortCut = 16454 OnClick = MenuItemFindClick end object MenuFindNext: TMenuItem Caption = 'Find Next' ShortCut = 114 OnClick = MenuFindNextClick end object MenuFindPrev: TMenuItem Caption = 'Find Prev' ShortCut = 8306 OnClick = MenuFindPrevClick end object MenuItem1: TMenuItem Caption = '-' end object MenuItemCut: TMenuItem Caption = 'Cut' OnClick = MenuItemCutClick end object MenuItemCopy: TMenuItem Caption = 'Copy' OnClick = MenuItemCopyClick end object MenuItemPaste: TMenuItem Caption = 'Paste' OnClick = MenuItemPasteClick end object MenuItemDelete: TMenuItem Caption = 'Delete' OnClick = MenuItemDeleteClick end object MenuItemSelectAll: TMenuItem Caption = 'Select All' OnClick = MenuItemSelectAllClick end end object TimerSave: TTimer Interval = 10000 OnTimer = TimerSaveTimer Left = 368 Top = 280 end object TaskDialogDelete: TTaskDialog Buttons = <> RadioButtons = <> Left = 80 Top = 280 end object TimerHousekeeping: TTimer OnTimer = TimerHousekeepingTimer Left = 376 Top = 127 end object PrintDialog1: TPrintDialog Left = 496 Top = 119 end object PopupMainTBMenu: TPopupMenu Left = 486 Top = 252 end end tomboy-ng_0.34-1/package/0000755000175000017500000000000014145033507015010 5ustar dbannondbannontomboy-ng_0.34-1/package/package.bash0000644000175000017500000002764714145033507017262 0ustar dbannondbannon#!/bin/bash # A script to build tomboy and make deb packages and zip up the other binaries # see https://www.debian.org/doc/manuals/debian-faq/ch-pkg_basics # we can also add preinst, postinst, prerm, and postrm scripts if required # David Bannon, November, 2017 # Assumes a working FPC/Lazarus install with cross compile tools as described in # http://wiki.lazarus.freepascal.org/Cross_compiling_for_Win32_under_Linux and # http://wiki.lazarus.freepascal.org/Cross_compiling # and that a 'Release' mode exists. # ---------------------------------------------------------------------------- # Typical usage - # ./package_debian.sh $HOME"/lazarus/laz-200 # Note we assume laz config has same name as Laz directory, ie .laz-200 # ---------------------------------------------------------------------------- PRODUCT="tomboy-ng" VERSION=`cat version` SOURCE_DIR="../source" ICON_DIR="../glyphs" WHOAMI="David Bannon " MANUALS_DIR="BUILD/usr/share/doc/$PRODUCT/" MANUALS=`cat note-files` BUILDOPTS=" -B --quiet --quiet" # BUILDOPTS=" -B --verbose" BUILDDATE=`date -R` LPI="Tomboy_NG.lpi" LAZ_FULL_DIR="$1" LAZ_DIR=`basename "$LAZ_FULL_DIR"` WIN_DIR=WinPre_"$VERSION" LEAKCHECK="NO" if [ -z "$LAZ_DIR" ]; then echo "Usage : $0 /Full/Path/Lazarus/dir" echo "eg : $0 \$HOME/bin/Lazarus/trunk" echo "or" echo " : $0 clean" exit fi if [ "$2" == "LeakCheck" ]; then LEAKCHECK="YES" fi if [ $1 == "clean" ]; then rm -f *.deb rm -f *.tgz rm -f *.rpm rm -Rf BUILD rm -Rf WinPre* exit fi # ---------------------- function LookForBinary () { cd "$SOURCE_DIR" if [ -a "$1" ]; then echo "Binary $1 was made" else echo "---------- ERROR $1 was not made" fi cd "../package" } function ModeParamArch () { # expects to be called like ARCH=$(ModeParamArch ReleaseLin64) case $1 in # Only useful in debian packaging ReleaseLin64) echo "amd64" ;; ReleaseLin32) echo "i386" ;; ReleaseQT5) echo "amd64Qt" ;; ReleaseRasPi) echo "armhf" ;; esac } function ModeParamBin () { # expects to be called like BIN=$(ModeParam ReleaseWin64) case $1 in ReleaseLin64) echo "$PRODUCT"-64 ;; ReleaseLin32) echo "$PRODUCT"-32 ;; ReleaseWin32) echo "$PRODUCT"-32.exe ;; ReleaseWin64) echo "$PRODUCT"-64.exe ;; ReleaseQT5) echo "$PRODUCT"-qt-64 ;; ReleaseRasPi) echo "$PRODUCT"-armhf ;; esac } # Modes (as defined in IDE) ReleaseLin64 ReleaseLin32 ReleaseWin64 ReleaseWin32 ReleaseRasPi ReleaseQT5 function BuildAMode () { echo "------------- Building Mode $1 --------" cd ../source BIN=$(ModeParamBin "$1") rm -f "$BIN" #CMD="TOMBOY_NG_VER=$VERSION $LAZ_FULL_DIR/lazbuild $BUILDOPTS $LAZ_CONFIG --build-mode=$1 $LPI" #echo "CMD is $CMD" TOMBOY_NG_VER="$VERSION" $LAZ_FULL_DIR/lazbuild $BUILDOPTS $LAZ_CONFIG --build-mode="$1" "$LPI" if [ ! -f "$BIN" ]; then echo "----- $1 ERROR failed to build $BIN ---------" echo "$LAZ_FULL_DIR/lazbuild $BUILDOPTS $LAZ_CONFIG --build-mode=$1 $LPI" exit fi cd ../package } function DebianTemplate () { # the common to all versions things # We build a debian tree in BUILD and call dpkg-deb -b # BUILD/DEBIAN control,debian-binary and any scripts rm -rf BUILD mkdir -p BUILD/DEBIAN mkdir -p BUILD/usr/bin mkdir -p BUILD/usr/share/"$PRODUCT" for i in 16x16 22x22 24x24 32x32 48x48 256x256; do mkdir -p "BUILD/usr/share/icons/hicolor/$i/apps"; cp "$ICON_DIR/$i.png" "BUILD/usr/share/icons/hicolor/$i/apps/$PRODUCT.png"; done; mkdir -p BUILD/usr/share/doc/$PRODUCT cp ../doc/authors BUILD/usr/share/doc/$PRODUCT/. cp -R ../doc/HELP BUILD/usr/share/"$PRODUCT"/. # -------------- Translation Files # we end up with, eg, /usr/share/locale/es/LC_MESSAGES/tomboy-ng.mo # and /usr/share/locale/es/LC_MESSAGES/lclstrconsts.mo for Linux mkdir -p BUILD/usr/share/locale for i in `ls -b ../po/*.??.po`; do # Deal with each country code in turn # echo "Name is $i" BASENAME=`basename -s.po "$i"` # echo "BASENAME is $BASENAME" CCODE=`echo "$BASENAME" | cut -d '.' -f2` # echo "CCode is $CCODE" mkdir -p BUILD/usr/share/locale/"$CCODE"/LC_MESSAGES BASENAME=`basename -s."$CCODE" "$BASENAME"` msgfmt -o BUILD/usr/share/locale/"$CCODE"/LC_MESSAGES/"$BASENAME".mo "$i" msgfmt -o BUILD/usr/share/locale/"$CCODE"/LC_MESSAGES/lclstrconsts.mo "$LAZ_FULL_DIR"/lcl/languages/lclstrconsts."$CCODE".po done mkdir BUILD/usr/share/applications cp "$ICON_DIR/$PRODUCT.desktop" BUILD/usr/share/applications/. mkdir -p BUILD/usr/share/man/man1 gzip -9kn ../doc/$PRODUCT.1 mv ../doc/$PRODUCT.1.gz BUILD/usr/share/man/man1/. cp ../debian/copyright BUILD/usr/share/doc/"$PRODUCT"/. } function DebianPackage () { rm -Rf BUILD DebianTemplate ARCH=$(ModeParamArch "$1") BIN=$(ModeParamBin "$1") CTRL_ARCH=$ARCH CTRL_DEPENDS="libgtk2.0-0 (>= 2.6), libc6 (>= 2.14), libcanberra-gtk-module, wmctrl" CTRL_RELEASE="GTK2 release." cp $SOURCE_DIR/$BIN BUILD/usr/bin/$PRODUCT # ----------- Some Special Cases ---------------- case "$1" in "ReleaseQT5") echo "++++++++++ Setting QT5 +++++++++" CTRL_ARCH="amd64" CTRL_DEPENDS="libqt5pas1, libc6 (>= 2.14), wmctrl" CTRL_RELEASE="Qt5 release." ;; "ReleaseRasPi") CTRL_RELEASE="Raspberry Pi release." ;; esac chmod 755 BUILD/usr/bin/tomboy-ng # -------------------- Changelog ----------------- cp ../debian/changelog "$MANUALS_DIR"changelog DEBEMAIL="David Bannon " dch --changelog "$MANUALS_DIR"changelog -v "$VERSION" -D unstable --force-distribution "Release of new version" DEBEMAIL="David Bannon " dch --changelog "$MANUALS_DIR"changelog --append "Please see github for change details" gzip -9n "$MANUALS_DIR"changelog # -------------------------------- Make control file ------------------------- echo "Package: $PRODUCT" > BUILD/DEBIAN/control echo "Version: $VERSION" >> BUILD/DEBIAN/control echo "Architecture: $CTRL_ARCH" >> BUILD/DEBIAN/control echo "Maintainer: $WHOAMI" >> BUILD/DEBIAN/control # -------------------------------- Calculate size, thanks circular@LazForum SIZE_IN_KB="$(du -s BUILD | awk '{print $1;}')" echo "Installed-Size: ${SIZE_IN_KB}" >> "BUILD/DEBIAN/control" echo "Depends: $CTRL_DEPENDS" >> BUILD/DEBIAN/control echo "Priority: optional" >> BUILD/DEBIAN/control echo "Homepage: https://github.com/tomboy-notes/tomboy-ng/wiki" >> BUILD/DEBIAN/control #echo "Homepage: https://wiki.gnome.org/Apps/Tomboy" >> BUILD/DEBIAN/control echo "Section: x11" >> BUILD/DEBIAN/control echo "Description: Tomboy Notes rewritten to make installation and cross platform easier." >> BUILD/DEBIAN/control echo " $CTRL_RELEASE" >> BUILD/DEBIAN/control echo " Please report your experiences." >> BUILD/DEBIAN/control chmod -R g-w BUILD fakeroot dpkg-deb -b BUILD/. "$PRODUCT""_$VERSION-0_"$ARCH".deb" # --------------------------------- Clean up ----------- # rm -Rf BUILD } function WriteZipReadMe () { RM="$1/readme.txt" echo "This is a tar ball of $PRODUCT $VERSION for Linux. Use this if you cannot use" > "$RM" echo "either the deb or rpm on your particular distribution. It contains some of the" >> "$RM" echo "files you need and a very basic installer but does not resolve dependancies." >> "$RM" echo "Its assumed you know what you are doing." >> "$RM" echo "* Files and features not provided here include -" >> "$RM" echo "* Language other than English" >> "$RM" echo "* tomboy-ng help files" >> "$RM" echo "* Ability to have tomboy-ng set itself to autostart" >> "$RM" echo "Dependencies include libgtk2.0-0, libcanberra-gtk-module, libnotify, wmctrl." >> "$RM" echo " or, in the Qt5 version, libqt5pas1, libnotify, wmctrl" >> $RM echo "If you need help, please post specific question to tomboy-ng github issues." >> "$RM" } function DoGZipping { BIN=$(ModeParamBin "$1") ARCH=$(ModeParamArch "$1") GZIP_DIR="$PRODUCT"-"$VERSION" # rm -f *.tgz # for TBVer in tomboy-ng32 tomboy-ng; do rm -Rf "$GZIP_DIR" mkdir "$GZIP_DIR" cp "$SOURCE_DIR"/"$BIN" "$GZIP_DIR"/"$PRODUCT" for i in 16x16 22x22 24x24 32x32 48x48 256x256; do cp "$ICON_DIR/$i.png" "$GZIP_DIR/$i.png" done; cp "$ICON_DIR/install-local.bash" "$GZIP_DIR/install-local.bash" cp "$ICON_DIR/$PRODUCT.desktop" "$GZIP_DIR/$PRODUCT.desktop" gzip -9kn ../doc/$PRODUCT.1 mv ../doc/$PRODUCT.1.gz "$GZIP_DIR"/. WriteZipReadMe "$GZIP_DIR" tar czf "$PRODUCT"-"$VERSION"-"$ARCH".tgz "$GZIP_DIR" rm -Rf "$GZIP_DIR" } function MkWinPreInstaller() { # Make a dir containing everything we need to make a 32/64bit Inno Setup installer for Windows rm -Rf "$WIN_DIR" mkdir "$WIN_DIR" cp "$SOURCE_DIR"/tomboy-ng-64.exe "$WIN_DIR"/tomboy-ng64.exe cp "$SOURCE_DIR"/tomboy-ng-32.exe "$WIN_DIR"/tomboy-ng32.exe # cp ../../DLL/* "$WIN_DIR"/. cp ../../DLL/libhunspell.dll "$WIN_DIR/." cp ../../DLL/libhunspell.license "$WIN_DIR/." cp ../COPYING "$WIN_DIR/." cp AfterInstall.txt "$WIN_DIR/." sed "s/MyAppVersion \"REPLACEME\"/MyAppVersion \"$VERSION\"/" tomboy-ng.iss > "$WIN_DIR/tomboy-ng.iss.temp" # mkdir -p "$WIN_DIR/HELP/EN" # mkdir -p "$WIN_DIR/HELP/ES" # for i in $MANUALS; do # cp ../doc/$i "$WIN_DIR/." # done; mkdir "$WIN_DIR/HELP_DIR" cp -R ../doc/HELP "$WIN_DIR/HELP_DIR/." # " -------- WRITE mo files --------" msgfmt -o "$WIN_DIR"/"$PRODUCT".mo ../po/"$PRODUCT".po # Source: "tomboy-ng.mo"; DestDir: "{app}\locale"; Flags: ignoreversion echo "Source: \""$PRODUCT".mo\"; DestDir: \"{app}\\locale\"; Flags: ignoreversion" > mo.insert for i in `ls -b ../po/*.??.po`; do # echo "Name is $i" BASENAME=`basename -s.po "$i"` CCODE=`echo "$BASENAME" | cut -d '.' -f2` # echo "CCode is $CCODE" BASENAME=`basename -s."$CCODE" "$BASENAME"` msgfmt -o "$WIN_DIR"/"$BASENAME"."$CCODE".mo "$i" msgfmt -o "$WIN_DIR"/lclstrconsts."$CCODE".mo "$LAZ_FULL_DIR"/lcl/languages/lclstrconsts."$CCODE".po echo "Source: \""$BASENAME"."$CCODE".mo\"; DestDir: \"{app}\\locale\"; Flags: ignoreversion" >> mo.insert echo "Source: \"lclstrconsts."$CCODE".mo\"; DestDir: \"{app}\\locale\"; Flags: ignoreversion" >> mo.insert done sed '/PUTMOLINESHERE/r mo.insert' "$WIN_DIR"/tomboy-ng.iss.temp > "$WIN_DIR"/tomboy-ng.iss MANWIDTH=70 man -l ../doc/tomboy-ng.1 > "$WIN_DIR/readme.txt" unix2dos -q "$WIN_DIR/readme.txt" echo "----------- Windows installer dir created -----------" rm mo.insert # ls -la "$WIN_DIR" } # ------- OK, lets find Laz Config --------------------------------- # It all starts here if [ -f "$LAZ_FULL_DIR"/lazarus.cfg ]; then # Assume if we have a cfg, it specifies pcp ?? Will fail otherwise LAZ_CONFIG=`grep -i pcp "$LAZ_FULL_DIR"/lazarus.cfg` else if [ -d "$HOME/.Laz_$LAZ_DIR" ]; then # try my way of naming config first LAZ_CONFIG="$HOME/.Laz_$LAZ_DIR"; else echo "------ Testing for the .Laz config $HOME------" if [ -d "$HOME/.$LAZ_DIR" ]; then LAZ_CONFIG="$HOME/.$LAZ_DIR"; fi fi fi if [ -z "$LAZ_CONFIG" ]; then echo "--------- ERROR, dont have a Laz Config -------" exit fi echo "----- LAZ_CONFIG is $LAZ_CONFIG ------" for BIN in ReleaseLin64 ReleaseLin32 ReleaseWin64 ReleaseWin32 ReleaseRasPi ReleaseQT5 ; do BuildAMode $BIN; done #if [ "$2" == "LeakCheck" ]; then rm tom*.deb for BIN in ReleaseLin64 ReleaseLin32 ReleaseRasPi ReleaseQT5 ; do DebianPackage $BIN ; done rm tom*.tgz for MODE in ReleaseLin64 ReleaseLin32 ; do DoGZipping $MODE; done MkWinPreInstaller # ls -ltr fakeroot bash ./mk_rpm.sh # echo "OK, if that looks OK, run fakeroot bash ./mk_rpm.sh" # Dont sign under fakeroot, its messy echo "OK, we will now sign the RPMs - david, use the longer passphrase !" for i in `ls -b *.rpm`; do rpm --addsign "$i"; echo "Signed $i"; done ls -l *.rpm *.deb "$WIN_DIR"/*.exe tomboy-ng_0.34-1/package/PkgInfo0000644000175000017500000000001114145033507016260 0ustar dbannondbannonAPPL???? tomboy-ng_0.34-1/package/tomboy-ng.iss0000644000175000017500000001066514145033507017453 0ustar dbannondbannon; Script generated by the Inno Script Studio Wizard. ; SEE THE DOCUMENTATION FOR DETAILS ON CREATING INNO SETUP SCRIPT FILES! #define MyAppName "tomboy-ng" #define MyAppVersion "REPLACEME" #define MyAppPublisher "David Bannon" #define MyAppURL "https://github.com/tomboy-notes/tomboy-ng" #define MyAppExeName32 "tomboy-ng.exe" #define MyAppExeName64 "tomboy-ng.exe" [Setup] ; NOTE: The value of AppId uniquely identifies this application. ; Do not use the same AppId value in installers for other applications. ; (To generate a new GUID, click Tools | Generate GUID inside the IDE.) AppId={{913B2DAF-AAFB-451A-98B3-FAE16027E477} AppName={#MyAppName} AppVersion={#MyAppVersion} ;AppVerName={#MyAppName} {#MyAppVersion} AppPublisher={#MyAppPublisher} AppPublisherURL={#MyAppURL} AppSupportURL={#MyAppURL} AppUpdatesURL={#MyAppURL} DefaultDirName={pf}\{#MyAppName} DefaultGroupName={#MyAppName} LicenseFile=COPYING InfoAfterFile=AfterInstall.txt OutputBaseFilename=tomboy-ng-setup-{#MyAppVersion} Compression=lzma SolidCompression=yes ; VersionInfoVersion={#MyAppVersion} ; "ArchitecturesInstallIn64BitMode=x64" requests that the install be ; done in "64-bit mode" on x64, meaning it should use the native ; 64-bit Program Files directory and the 64-bit view of the registry. ; On all other architectures it will install in "32-bit mode". ArchitecturesInstallIn64BitMode=x64 [Languages] Name: "english"; MessagesFile: "compiler:Default.isl" [Tasks] Name: "desktopicon"; Description: "{cm:CreateDesktopIcon}"; GroupDescription: "{cm:AdditionalIcons}"; Flags: unchecked ;Name: associate; Description: "&Associate files"; GroupDescription: "Associate .note files with tomboy-ng:"; Flags: unchecked ; Thats a todo, see http://www.jrsoftware.org/isfaq.php - requires admin priviliges, maybe a pain to non-admin users ? [Files] ; Install MyProg-x64.exe if running in 64-bit mode (x64; see above), MyProg.exe otherwise. Source: "libhunspell.license"; DestDir: "{app}"; Check: Is64BitInstallMode Source: "libhunspell.dll"; DestDir: "{app}"; Check: Is64BitInstallMode ; Source: "ssleay32.dll-64"; DestDir: "{app}"; DestName: "ssleay32.dll"; Check: Is64BitInstallMode ; Source: "libeay32.dll-64"; DestDir: "{app}"; DestName: "libeay32.dll"; Check: Is64BitInstallMode ; Source: "ssleay32.dll-32"; DestDir: "{app}"; DestName: "ssleay32.dll"; Check: not Is64BitInstallMode ; Source: "libeay32.dll-32"; DestDir: "{app}"; DestName: "libeay32.dll"; Check: not Is64BitInstallMode Source: "tomboy-ng64.exe"; DestDir: "{app}"; DestName: "tomboy-ng.exe"; Check: Is64BitInstallMode Source: "tomboy-ng32.exe"; DestDir: "{app}"; DestName: "tomboy-ng.exe"; Check: not Is64BitInstallMode ;Source: "C:\Users\dbann\Desktop\tomboy-ng_{#MyAppVersion}\tomboy-ng64.exe"; DestDir: "{app}"; Flags: ignoreversion DestDir: {app}; Source: "HELP_DIR\*"; Flags: recursesubdirs ; eg DestDir: {app}; Source: Files\*; Excludes: "*.m,.svn,private"; Flags: recursesubdirs ; Source: "calculator.note"; DestDir: "{app}"; Flags: ignoreversion ; Source: "key-shortcuts.note"; DestDir: "{app}"; Flags: ignoreversion ; Source: "recover.note"; DestDir: "{app}"; Flags: ignoreversion ; Source: "sync-ng.note"; DestDir: "{app}"; Flags: ignoreversion ; Source: "tomboy-ng.note"; DestDir: "{app}"; Flags: ignoreversion ; Source: "tomdroid.note"; DestDir: "{app}"; Flags: ignoreversion Source: "readme.txt"; DestDir: "{app}"; Flags: ignoreversion ; PUTMOLINESHERE ; Source: "tomboy-ng.es.mo"; DestDir: "{app}\locale"; Flags: ignoreversion ; NOTE: Don't use "Flags: ignoreversion" on any shared system files [Icons] Name: "{group}\{#MyAppName}"; Filename: "{app}\{#MyAppExeName64}"; Check: Is64BitInstallMode Name: "{group}\{#MyAppName}"; Filename: "{app}\{#MyAppExeName32}"; Check: not Is64BitInstallMode Name: "{commondesktop}\{#MyAppName}"; Filename: "{app}\{#MyAppExeName64}"; Tasks: desktopicon; Check: Is64BitInstallMode Name: "{commondesktop}\{#MyAppName}"; Filename: "{app}\{#MyAppExeName32}"; Tasks: desktopicon; Check: not Is64BitInstallMode [Run] Filename: "{app}\{#MyAppExeName64}"; Description: "{cm:LaunchProgram,{#StringChange(MyAppName, '&', '&&')}}"; Flags: nowait postinstall skipifsilent; Check: Is64BitInstallMode Filename: "{app}\{#MyAppExeName32}"; Description: "{cm:LaunchProgram,{#StringChange(MyAppName, '&', '&&')}}"; Flags: nowait postinstall skipifsilent; Check: not Is64BitInstallMode tomboy-ng_0.34-1/package/tomboy-ng-GPG-KEY0000644000175000017500000000463014145033507017712 0ustar dbannondbannon-----BEGIN PGP PUBLIC KEY BLOCK----- mQGNBF5nel0BDADL3w/YjEkndcle+AneMfA+ONagrflHJTyoTvrKqo9knE9qqShg +8IaNA4ceHpbUHz7ULlQCTLREPpXFV7h1O+nWjdG3MD3MA04nBO4j2L5Zj/rKvK6 5uzaBTi9qEJeUOU+iZn5sQJQV+bN3TQeZO2QdbKCrLIxAJtgKxF0xv1GoxM5Lxwo 6fp9UlYuWAIfrnUp78GRd37HrBsroX8KYrljZMbPUPe7RAQJd9l/gPoGOXquZ0cX L6cijVKL3vUNDuMc8I63gsNyGDLiy3LJv0RCSjOY/U9WQxDDZNe2ICIPN3Pn+wsz DskZ7mw/4sEElFSCCl7SKc2O4oz4y1wzbKE8q7aVpSlVgxgFnOvSy4lwKB6kvnxN Rw7Vv1cXXmKdt700rikb8qnV48S7oDL+Y97wEDTbFdVzinZW3oR1ZAaLmsqMRmI9 9uvhrnDx1O7iOCcxxFLVmyKND8SnpK3wrD98lyx3/fAZk2sUR17FSGvRf89ttf/3 fugr9mgLKX7mBEMAEQEAAbQjdG9tYm95LW5nIDx0b21ib3ktbmdAYmFubm9ucy5p ZC5hdT6JAdQEEwEKAD4WIQR5RFdmm2Mu4jNx0lPc2EGrwJEOFQUCXmd6XQIbAwUJ A8JnAAULCQgHAgYVCgkICwIEFgIDAQIeAQIXgAAKCRDc2EGrwJEOFa/dC/49OZY1 mWtuIxcPpqRz1aYzINW5qsV+0H2VfIQVl+K2S6rzi4Ig1p51ILmF9fjB6/xB+Qwl bSRwpx0uhT2LYA4h74pLBLXPANY+YXMV6QQRjgdfIJBLk6PlWEM18oawFUjq6BHs xGg5IuWy49I0/WdNmOze8tFTn0pcYjn/LdqRW68M/xogMu5kon0Qt61fR55huNoP 7N83VygKHMalYuREEMWXLGGIphoFJhucEH5DE4a7gb34MF0g42YXm9oAuBx86k3g IcEC6o1MRb9gV0iR5eE6E47KQPKzQA7+qkiOc6Gl9fw5W+XjGp3mkNQZWK2svYC7 M33ctx2DDaqV9eKKukRAW3CEecEuIYlOpEAHrmlXU/IH338ycuvYcbNFmWgJe+k7 NxR01Nd/9UqhRz1s9bQsq5Ltp58boUC/1bsNitYJw0KWyxhDDem5TkpD07T5jMR/ cifEYhN28fH6VYsQ8ivaNkUUEcDpUM0OXWR1eTCekOC/vjuJyp3KA7WE3Ie5AY0E Xmd6XQEMAJgC2HOBeoZUYIe8kUQ4Nk1EgwXYs55N/oYjUv8MPNiKYhvicF1SDZDL Q1SoMZK2aI5yWQGMYrjyyso/Dr/fEBSAVDd2Gv6lBZOtrYI7IXFHeeRA5YLHIWRW eoEI+Ap9PDCVEi6prRbptk4KFhTPd3i0wkqAogrGpTOOsMUvuFnnL0t8UCzz5RV6 d5syvG0kJTjXyyzMlaMnZUHh2L3m3IrjSwqzT6pcmerTzwJLvcLhvU+6Oh74cBNd dWTaB0z0hrdpI8LLrpQ/apkiVUNAOfUemezxfh5zNbmxp4cuEr/HHrxNNXvfzG2n SGW78XWQs1ZIWIe8Hub/X1kImLfJQE/yuM0j81chkFyECA6D4pYbr8fCICM2PDNV 9T/q5Q91Ky1u6Pk5Dm9N2RD5QaSNK2Dcti40+D0pCwzOJ7KAuEaOJ6n9QsrqNI6r GRLFqYk9Gl3LqzzGhLkY2aEBadJovVtXqlqPz1FboWXMdVKuYVHybCjpogKZ3bCN 5moDVPZ0vQARAQABiQG8BBgBCgAmFiEEeURXZptjLuIzcdJT3NhBq8CRDhUFAl5n el0CGwwFCQPCZwAACgkQ3NhBq8CRDhU1mQwAj2u18Ec2U9Vb5JB6LtDwmQ8wTNK6 ws+riNjonGlW4ZhCPs7+Yz7whcv0ScpA1JXWMg/J5O9puCRHJK4jSL+eEtRIlYkS 8F3JyRYLskZ6VQQCRIMVDj01HqI53coRvEwIXMUHUqvY/LRMNZtr9wpo5HEXNJPA rJoJU7sHvLZspfGu62dTljICvT1Fr+yklhmMyFewjEBhyCIGLdXD8e92lafPSpWh 6oKlLJcxvVgQTzxydOLnrrvAvGqv7QP791FS1Ohow+0onVUuVitxcFErLMc0t/5Q MVAYyXfwaBW+KENPf6gGmDUI/+kv7qx2k3nBbL9a+WyBWdi3U1AC6f7eFBbVcWCP n7nDLIkocYYmjXqLbCMK9a8TZvZ+2XDp9+HO9y2z3EiAKVw78RCmqR3p9h43G1Un Q5umgzjZATqh/AhP4yhxSKRZY3becYckBodG5TY6cmeIqpRL/+yJcQpz2NFncNDH o4f8zq9WLmtw5BKUaFBlN6GZebUc+WL3ErFO =dTMk -----END PGP PUBLIC KEY BLOCK----- tomboy-ng_0.34-1/package/mk_dmg.bash0000644000175000017500000000613314145033507017110 0ustar dbannondbannon#!/bin/bash # ------------------------------------------------------------ # # A script to generate Mac's tomboy-ng dmg files # Typical Usage : bash ./mk_dmg.bash $HOME/bin/lazarus/fixes_2_0 # Note we assume config is named same as lazarus dir, ie .laz-200 # # Depends (heavily) on https://github.com/andreyvit/create-dmg # which must be installed. # # Probably should put license and readme in there too. # ------------------------------------------------------------- LAZ_FULL_DIR="$1" LAZ_DIR=`basename "$LAZ_FULL_DIR"` PRODUCT=tomboy-ng WORK=source_folder CONTENTS="$WORK/""$PRODUCT".app/Contents VERSION=`cat version` MANUALS=`cat note-files` MSGFMT="/usr/local/Cellar/gettext/0.19.8.1/bin/msgfmt" VERSION=`cat version` if [ -z "$LAZ_DIR" ]; then echo "Usage : $0 /Full/Path/Lazarus/dir" echo "eg : $0 \$HOME/bin/lazarus/fixes_2_0" exit fi if [ ! -f "$LAZ_FULL_DIR"/lazbuild ]; then echo "Sorry, ""$LAZ_FULL_DIR"" does not look like it contains a Lazarus build" exit fi # We do some wildcard deletes further on, be safe ! if [ ! -f tomboy-ng.iss ]; then echo "Not running in tomboy-ng package dir, too dangerous" exit fi function MakeDMG () { if [ "$1" = "carbon" ]; then CPU="i386" BITS="32" REL="CarbonRelease" else CPU="x86_64" BITS="64" REL="CocoaRelease" fi cd ../source rm -f "$PRODUCT" TOMBOY_NG_VER="$VERSION" $LAZ_FULL_DIR/lazbuild --pcp="$HOME/.$LAZ_DIR" -B --cpu="$CPU" --ws="$1" --build-mode="$REL" --os="darwin" Tomboy_NG.lpi if [ ! -f "$PRODUCT" ]; then echo "------------------------------------" echo "Failed to build ""$BITS"" bit binary" echo "------------------------------------" exit fi cd ../package rm -Rf $WORK mkdir -p $CONTENTS ln -s /Applications $WORK/Applications mkdir "$CONTENTS"/SharedSupport mkdir "$CONTENTS"/Resources mkdir "$CONTENTS"/MacOS MANWIDTH=70 man ../doc/tomboy-ng.1 > "$CONTENTS"/SharedSupport/readme.txt cp -R ../doc/html "$CONTENTS"/SharedSupport/. sed "s/REPLACEVER/\"$VERSION\"/" Info.plist > "$CONTENTS/Info.plist" # cp Info.plist "$CONTENTS/." cp PkgInfo "$CONTENTS/." cp ../glyphs/tomboy-ng.icns "$CONTENTS/Resources/." # for i in $MANUALS; do # cp ../doc/"$i" "$CONTENTS/Resources/."; # done; cp -R ../doc/HELP "$CONTENTS/Resources/." mkdir "$CONTENTS/MacOS/locale" for i in `ls -b ../po/*.??.po`; do echo "Name is $i" BASENAME=`basename -s.po "$i"` CCODE=`echo "$BASENAME" | cut -d '.' -f2` echo "CCode is $CCODE" BASENAME=`basename -s."$CCODE" "$BASENAME"` mkdir -p "$CONTENTS/MacOS/locale/$CCODE" "$MSGFMT" -o "$CONTENTS/MacOS/locale/$CCODE"/"$BASENAME".mo "$i" "$MSGFMT" -o "$CONTENTS/MacOS/locale/$CCODE"/lclstrconsts.mo "$LAZ_FULL_DIR"/lcl/languages/lclstrconsts."$CCODE".po done mv ../source/"$PRODUCT" "$CONTENTS/MacOS/." rm -f "$PRODUCT""$BITS"_"$VERSION".dmg ~/create-dmg-master/create-dmg --volname "$PRODUCT""$BITS" --volicon "../glyphs/vol.icns" "$PRODUCT""$BITS"_"$VERSION".dmg "./$WORK/" } rm -f *.dmg # MakeDMG "carbon" # We don't bother building carbon any more, it should still build, must test occasionally. July 2020 MakeDMG "cocoa" tomboy-ng_0.34-1/package/version0000644000175000017500000000000514145033507016413 0ustar dbannondbannon0.34 tomboy-ng_0.34-1/package/note-files0000644000175000017500000000042414145033507017000 0ustar dbannondbannonHELP/EN/recover.note HELP/EN/sync-ng.note HELP/EN/tomboy-ng.note HELP/EN/tomdroid.note HELP/EN/calculator.note HELP/EN/key-shortcuts.note HELP/ES/recover.note HELP/ES/sync-ng.note HELP/ES/tomboy-ng.note HELP/ES/tomdroid.note HELP/ES/calculator.note HELP/ES/key-shortcuts.note tomboy-ng_0.34-1/package/AfterInstall.txt0000644000175000017500000000106114145033507020137 0ustar dbannondbannonOK, looks like tomboy-ng is now installed. When it starts, it places a yellow icon in your System Tray, thats probably all you need to interact with it. If you cannot see it, click the ^ icon, "Show Hidden Icons". Depending on your existing setting, you may also see a small "spash screen" window showing some tomboy-ng status infomation. You can dismiss this and, if you wish, in Settings, ensure you don't see it again. If you close the small splash screen using top, right [X], that will close tomboy-ng. Please report you experiences with tomboy-ng. tomboy-ng_0.34-1/package/Info.plist0000644000175000017500000000243414145033507016763 0ustar dbannondbannon CFBundleDevelopmentRegion English CFBundleExecutable tomboy-ng CFBundleIconFile tomboy-ng.icns CFBundleName tomboy-ng CFBundleIdentifier com.company.tomboy-ng CFBundleInfoDictionaryVersion 6.0 CFBundlePackageType APPL CFBundleSignature tomb CFBundleShortVersionString REPLACEVER CFBundleVersion REPLACEVER CSResourcesFileMapped CFBundleDocumentTypes CFBundleTypeRole Viewer CFBundleTypeExtensions * CFBundleTypeOSTypes fold disk **** NSHighResolutionCapable tomboy-ng_0.34-1/package/mk_rpm.sh0000644000175000017500000000440314145033507016632 0ustar dbannondbannon#!/usr/bin/bash # ==================================================== # a short script to make RPMs from our tomboy-ng debs # does more than just call alien as that seems to end up # with commands to create / and /usr/bin that upset yum # # This script must be run as fake root, so useage is - # fakeroot bash mk_rpm # # History # 2020/03/10 # Finally worked out why yum won't work, while the rpm # command is happy with me calling the arch i386, amd64 (debian speak) # yum insists on them being x86, x86_64. # Manually add wmctrl to dependencies. # 2021/05/15 # don't add gnome-shell-extension-appindicator to dependencies, # it pulls in half of Gnome desktop, on gnome users would hate me. # ==================================================== PROD=tomboy-ng VERS=`cat version` RDIR="$PROD"-"$VERS" function DoAlien () { FILENAME="$PROD"_"$VERS"-0_"$1".deb ARCH="$1" rm -Rf "$RDIR" # Note, debs have a dash after initial version number, RPM an underscore if [ "$1" = amd64Qt ]; then # FILENAME="tomboy-ngQt_0.24b-0_amd64.deb" ARCH=x86_64 fi if [ "$1" = amd64 ]; then ARCH=x86_64 fi if [ "$1" = i386 ]; then ARCH=x86 fi echo "--- RDIR=$RDIR and building for $1 using $FILENAME ---------" alien -r -g -v "$FILENAME" # Alien inserts requests the package create / and /usr/bin and # the os does not apprieciate that, not surprisingly. # This removes the %dir / sed -i 's#%dir "/"##' "$RDIR"/"$RDIR"-2.spec # and this removes %dir /usr/bin sed -i 's#%dir "/usr/bin/"##' "$RDIR"/"$RDIR"-2.spec # rpmbuild detects the dependencies but it misses wmctrl due to way its used. # So we add it to the spec file manually, insert as line 5. sed -i '5i Requires: wmctrl ' "$RDIR"/"$RDIR"-2.spec # cp -r "$RDIR" "$RDIR"-"$1" cd "$RDIR" rpmbuild --target "$ARCH" --buildroot "$PWD" -bb "$RDIR"-2.spec cd .. # if its a Qt one, rename it so it does not get overwritten subsquently if [ "$1" = amd64Qt ]; then mv "$RDIR"-2."$ARCH".rpm "$PROD"Qt-"$VERS"-2."$ARCH".rpm fi } rm -f tom*.rpm # Must do the "non std" ones first, else have overwrite problems DoAlien "amd64Qt" DoAlien "i386" DoAlien "amd64" chown "$SUDO_USER" *.rpm #echo "OK, we will now sign - david, use the longer passphrase !" #for i in `ls -b *.rpm`; do rpm --addsign "$i"; echo "Signed $i"; done ls -l *.rpm tomboy-ng_0.34-1/LICENSE.txt0000644000175000017500000000004714145033507015241 0ustar dbannondbannonPlease see the debian/copyright file. tomboy-ng_0.34-1/buildit.bash0000755000175000017500000002616314145033507015723 0ustar dbannondbannon#!/bin/bash # copyright David Bannon, 2019, 2020, use as you see fit, but retain this statement. # # A script to build tomboy-ng from source without using the Lazarus GUI # # tomboy-ng depends directly on fpc, lazbuild, lcl and kcontrols. Because the # package based install of fpc/lazarus is quite different to the popular # installs in user space, we need to allow for both. debuild does not pass the # user's PATH through so we need to allow for those user space installs. # * We expect to find FPC (3.2.0 or later) preinstalled. Either on a path # indicated by the file ../WHICHFPC or PATH. Only the ../WHICHFPC method will work # if its installed in user space, fpc is not passed through the SRC Deb tool chain. # * Lazarus, must find lazbuild, first tries ../WHICHLAZ, then PATH. # If lazbuild is in root space, then lcl is # probably pointed to by /etc/alteratives/lazarus. If its user space, then # we can assume lcl is in the same place as the lazbuild command itself. # * KControls is bundled into the deb source kit by prepare script, its not # present in the github zip file where tomboy-ng calls home. If building # from a SRC Deb kit, kcontrols is already in the 'orig' tarball. # While really intended to be part of a tool chain to build a Debian Source # package, its useful as a standalone build tool if all you want is the binary. # # This script runs in the upper tomboy-ng source tree (level with, eg Makefile). # The files, WHICHFPC and WHICHLAZ are in the directory above, while they can # created by hand, the script, prepare.bash will also do so if necessary. # The prepare script will take a github zip file, unpack it, add kcontrols # and create the necessary ../WHICH* files if it can. # Its necessary to call fpc directly here, lazbuild will not help us because kcontrols # is not in the location that the project file expects it to be. lazbuild does not # have an option to add an arbitary extra package location. # 2021-10-30 Added paths to lazarus unit src in case obj need rebuilding # This is where I keep tarballs and zips to avoid repeated large downloads. MYREPO="$HOME/Documents/Kits" # set an alterantive with -r LAZ_VER="trunk" # an alternative is lazarus-2.0.10-2 LAZ_INT_NAME="blar" #CPU="x86_64" # default x86_64, can be arm CPU=$HOSTTYPE # might return i686, we change to i386 OS="linux" PROJ=Tomboy_NG # the formal name of the project, it's in project file. START_DIR=$PWD SOURCE_DIR="$PWD/source" TARGET="$CPU-$OS" K_DIR="$PWD/kcontrols/packages/kcontrols" WIDGET="gtk2" # either gtk2 or qt5 TEMPCONFDIR=`mktemp -d` # lazbuild writes, or worse might read a default .lazarus config file. We'll distract it later. EXCLUDEMESSAGE=" -vm6058,2005,5027 " # cut down on compiler noise # 6058 - note about things not being inlined # 5027 - var not used # 2005 - level 2 comment FPCHARD=" -Cg -k-pie -k-znow " AUTODOWNLOAD=FALSE # downloading large file, use -d to allow it # ------------------------ Some functions ------------------------ function ShowHelp () { echo " " echo "Assumes FPC of some sort in path, available and working, ideally 3.2.0." echo "Will look for Lazarus and KControls kits in repo, or download to it." echo "David Bannon, July 2020" echo "-h print help message" echo "-c specify CPU, default is $HOSTTYPE - supported x86_64, i386, arm" echo "-Q build a Qt5 version (default gtk2)" echo "When used in SRC DEB toolchain, set -c (if necessary) options in the Makefile." echo "" exit 1 } # Looks to see if we have a viable fpc, exits if not function CheckFPC () { if [ -f "../WHICHFPC" ]; then # If existing, the msg files take precedance COMP_DIR=`cat ../WHICHFPC | rev | cut -c -4 --complement | rev` if [ ! -x "$COMP_DIR""/fpc" ]; then echo "Sorry, WHICHFPC is not a viable compiler" echo "--------------------- EXITING ---------------------" exit 1 fi PATH="$COMP_DIR":"$PATH" export PATH else # OK, is it on path ? This won't work in SRC Deb mode if its installed in user space COMP_DIR=`which fpc | rev | cut -c -4 --complement | rev` if [ ! -x "$COMP_DIR""/fpc" ]; then echo "Sorry, not finding a viable compiler" echo "--------------------- EXITING ---------------------" exit 1 fi fi COMPILER="$COMP_DIR""/fpc" # we will need that later } # looks for a lazbuild, first in WHICHLAZ, then in PATH, failing exits. function CheckLazBuild () { if [ -f "../WHICHLAZ" ]; then LAZ_DIR=`cat ../WHICHLAZ | rev | cut -c -9 --complement | rev` if [ ! -x "$LAZ_DIR""/lazbuild" ]; then echo "Sorry, WHICHLAZ is not a viable lazarus install" echo "The path and 'lazbuild' is required" echo "--------------------- EXITING ---------------------" exit 1 fi PATH="$LAZ_DIR":"$PATH" export PATH else LAZ_DIR=`which lazbuild | rev | cut -c -9 --complement | rev` fi if [ ! -x "$LAZ_DIR""/lazbuild" ]; then echo "---------- ERROR, cannot find lazbuild ----------" exit 1 fi # if LAZ_DIR starts with /usr then its installed in root space and we should # assume that the lcl components are not 'along side' lazbuild. In fact # might be somewhere like /usr/lib/lazarus/2.0.8, should we assume its # /etc/alternatives/lazarus ? PREFIX="${LAZ_DIR:0:4}" if [ "$PREFIX" = "/usr" ]; then LAZ_DIR="/etc/alternatives/lazarus" fi } # We default to GTK2 but if a file is left in working dir called # Qt5 then we build that. Note a -q does the same thing. function CheckForQt5 () { if [ -f "Qt5" ]; then WIDGET="qt5" fi } # ------------ It all starts here --------------------- while getopts "hQc:" opt; do case $opt in h) ShowHelp ;; c) CPU="$OPTARG" TARGET="$CPU-$OS" ;; Q) WIDGET="qt5" ;; \?) echo "Invalid option: -$OPTARG" >&2 ShowHelp ;; esac done if [ "$CPU" = "i686" ]; then CPU="i386" fi if [ "$CPU" = "powerpc64le" ]; then # power does not like intel switches ! FPCHARD=" " fi TARGET="$CPU-$OS" CheckFPC CheckLazBuild CheckForQt5 # OK, if to here, we have a fpc and lazbuild, but which FPC ? FPCVERSION=$($COMPILER -iV) if [ "$FPCVERSION" = "3.0.4" ]; then echo "Sorry, need a later version of FPC later than $FPCVERSION" exit 1 fi #case $FPCVERSION in # 3.0.4) # echo "Compiler reported [$FPCVERSION]" # echo "FPC 3.0.4 is no longer suppoted by tomboy-ng ..." # exit 1 # # EXCLUDEMESSAGE=" -vm2005,5027 " # ;; # 3.2.0 | 3.2.2 | 3.2.3 | 3.2.4 | 3.2.5 | 3.2.6 ) # untested with > 3.2.3 # EXCLUDEMESSAGE=" -vm6058,2005,5027 " # ;; # *) # echo "Compiler reported [$FPCVERSION]" # echo "Unclear about your compiler, maybe edit script to support new one, exiting ..." # exit 1 # ;; # esac # OK, lets see if we can build KControls at this stage. # These are paths to Laz unit's source, needed if units need to be rebuilt, eg new compiler LAZUNITSRC=" -Fu$LAZ_DIR/lcl -Fi$LAZ_DIR/lcl/include -Fu$LAZ_DIR/components/lazutils -Fu$LAZ_DIR/lcl/widgetset " LAZUNITSRC="$LAZUNITSRC -Fu$LAZ_DIR/components/printers -Fi$LAZ_DIR/components/printers/unix " LAZUNITSRC="$LAZUNITSRC -Fu$LAZ_DIR/components/printers/unix -Fu$LAZ_DIR/components/cairocanvas " LAZUNITSRC="$LAZUNITSRC -Fu$LAZ_DIR/lcl/interfaces/$WIDGET -Fu$LAZ_DIR/lcl/forms -Fu$LAZ_DIR/lcl/nonwin32 " LAZUNITSRC="$LAZUNITSRC -Fu$LAZ_DIR/packager/registration " K_DIR="$PWD/kcontrols/source" cd "$K_DIR" # WARNING, kcontrols is not part of the github zip file, its added by prepare.bash # Here we build just the kmemo.pas part of kcontrols. mkdir -p "lib/$TARGET" # this is where kcontrols object files end up. rm "lib/$CPU-$OS/kmemo.o" # make sure we try to build a new one FPCKOPT=" -B -MObjFPC -Scgi -Cg -O1 -g -gl -l -vewnibq -vh- $EXCLUDEMESSAGES -Fi$K_DIR" FPCKUNITS=" -Fu$LAZ_DIR/packager/units/$TARGET -Fu$LAZ_DIR/components/lazutils/lib/$TARGET" FPCKUNITS="$FPCKUNITS -Fu$LAZ_DIR/components/buildintf/units/$TARGET -Fu$LAZ_DIR/components/freetype/lib/$TARGET" FPCKUNITS="$FPCKUNITS -Fu$LAZ_DIR/lib/$TARGET -Fu$LAZ_DIR/lcl/units/$TARGET -Fu$LAZ_DIR/lcl/units/$TARGET/$WIDGET" FPCKUNITS="$FPCKUNITS -Fu$LAZ_DIR/components/cairocanvas/lib/$TARGET/$WIDGET -Fu$LAZ_DIR/components/lazcontrols/lib/$TARGET/$WIDGET" FPCKUNITS="$FPCKUNITS -Fu$LAZ_DIR/components/ideintf/units/$TARGET/$WIDGET -Fu$LAZ_DIR/components/printers/lib/$TARGET/$WIDGET" FPCKUNITS="$FPCKUNITS -Fu$LAZ_DIR/components/tdbf/lib/$TARGET/$WIDGET -Fu. -FUlib/$TARGET" RUNIT="$COMPILER $EXCLUDEMESSAGE $FPCKOPT $FPCHARD $LAZUNITSRC $FPCKUNITS kmemo.pas" echo "--------------- kcontrols COMPILE COMMAND -------------" echo "$RUNIT" echo "-----------------" $RUNIT 1>tomboy-ng.log # exit if [ ! -e "$K_DIR/lib/$CPU-$OS/kmemo.o" ]; then echo "ERROR failed to build KControls, exiting..." K_DIR="" exit 1 fi cd "$START_DIR" VERSION=`cat "package/version"` echo "------------------------------------------------------" echo "OK, we seem to have both Lazarus LCL and KControls available : " echo "kcontrols = $K_DIR" echo "Lazarus = $LAZ_DIR" echo "Compiler = $COMPILER" echo "CPU type = $CPU" echo "tb-ng Ver = $VERSION" echo "Hardening = $FPCHARD" echo "Exclude = $EXCLUDEMESSAGE" echo "PATH = $PATH" echo "-------------------------------------------------------" # Test to see if we find the tomboy-ng source. if [ ! -e "$SOURCE_DIR/editbox.pas" ]; then echo "----------------------------------------------------------------" echo "Looked for [$SOURCE_DIR/editbox.pas]" echo "Not finding tomboy-ng source, exiting ...." echo " " ShowHelp fi # echo "In buildit.bash, ready to start building tomboy" >> "$HOME"/build.log cd $SOURCE_DIR # DEBUG options -O1, (!) -CX, -g, -gl, -vewnhibq OPT1="-MObjFPC -Scghi -CX -Cg -O3 -XX -Xs -l -vewnibq $EXCLUDEMESSAGE -Fi$SOURCE_DIR/lib/$TARGET" UNITS="$UNITS -Fu$K_DIR/lib/$TARGET" UNITS="$UNITS -Fu$LAZ_DIR/components/tdbf/lib/$TARGET/$WIDGET" UNITS="$UNITS -Fu$LAZ_DIR/components/printers/lib/$TARGET/$WIDGET" UNITS="$UNITS -Fu$LAZ_DIR/components/cairocanvas/lib/$TARGET/$WIDGET" UNITS="$UNITS -Fu$LAZ_DIR/components/lazcontrols/lib/$TARGET/$WIDGET" UNITS="$UNITS -Fu$LAZ_DIR/components/lazutils/lib/$TARGET" UNITS="$UNITS -Fu$LAZ_DIR/components/ideintf/units/$TARGET/$WIDGET" UNITS="$UNITS -Fu$LAZ_DIR/lcl/units/$TARGET/$WIDGET" UNITS="$UNITS -Fu$LAZ_DIR/lcl/units/$TARGET" UNITS="$UNITS -Fu$LAZ_DIR/packager/units/$TARGET" UNITS="$UNITS -Fu$SOURCE_DIR/" UNITS="$UNITS -FU$SOURCE_DIR/lib/$TARGET/" OPT2=" -dLCL -dLCL$WIDGET" DEFS="-dDisableLCLGIF -dDisableLCLJPEG -dDisableLCLPNM -dDisableLCLTIFF" # FPCHARD=" -Cg -k-pie -k-znow " # We must force a clean compile, no make looking after us here. # I have not found a way of telling the compiler to write its .o and .ppu files # somewhere else so not to compete with an existing Lazarus, but both this script # and Lazarus is quite happy to write new ones whenever needed. So, flush it clean. rm -Rf "lib/$TARGET" rm -f tomboy-ng rm -f "$PROJ" mkdir -p "lib/$TARGET" RUNIT="$COMPILER $OPT1 $FPCHARD $UNITS $LAZUNITSRC $OPT2 $DEFS $PROJ.lpr" echo "------------ tomboy-ng COMPILE COMMAND --------------------" echo "$RUNIT" TOMBOY_NG_VER="$VERSION" $RUNIT 1>>tomboy-ng.log if [ ! -e "$PROJ" ]; then echo "ERROR - COMPILE FAILED, please see source/tomboy-ng.log" exit 1 else cp "$PROJ" "tomboy-ng" fi exit 0 tomboy-ng_0.34-1/fpexprpars_addon.pas0000644000175000017500000003401214145033507017461 0ustar dbannondbannonunit fpexprpars_addon; {$mode objfpc}{$H+} interface uses Classes, SysUtils, fpexprpars; Procedure ExprDegToRad(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprRadToDeg(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprTan(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprCot(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprArcsin(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprArccos(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprArccot(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprCosh(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprCoth(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprSinh(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprTanh(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprArcosh(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprArsinh(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprArtanh(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprArcoth(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprSinc(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprPower(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprHypot(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprLog10(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprLog2(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprErf(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprErfc(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprGammaP(var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprGammaQ(var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprBetaI(var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprChi2Dist(var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprtDist(var Result: TFPExpressionResult; const Args: TExprParameterArray); Procedure ExprFDist(var Result: TFPExpressionResult; const Args: TExprParameterArray); Procedure ExprI0(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprI1(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprJ0(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprJ1(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprK0(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprK1(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprY0(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprY1(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); function FixDecSep(const AExpression: String): String; implementation uses Math, typ, spe; // numlib { Additional functions for the parser } procedure ExprDegToRad(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := degtorad(x); end; procedure ExprRadToDeg(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := radtodeg(x); end; procedure ExprTan(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := tan(x); end; procedure ExprCot(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := cot(x); end; procedure ExprArcsin(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := arcsin(x); end; procedure ExprArccos(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := arccos(x); end; procedure ExprArccot(Var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := pi/2 - arctan(x); end; procedure ExprCosh(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := cosh(x); end; { Hyperbolic cotangent coth(x); x <> 0 } procedure ExprCoth(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := 1/tanh(x); end; procedure ExprSinh(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := sinh(x); end; procedure ExprTanh(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := tanh(x); end; procedure ExprArcosh(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := arcosh(x); end; procedure ExprArsinh(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgtoFloat(Args[0]); Result.resFloat := arsinh(x); end; procedure ExprArtanh(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := artanh(x); end; procedure ExprArcoth(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := artanh(1.0/x); end; procedure ExprSinc(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); if x = 0 then Result.ResFloat := 1.0 else Result.resFloat := sin(x)/x; end; procedure ExprPower(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x,y: Double; begin x := ArgToFloat(Args[0]); y := ArgToFloat(Args[1]); Result.resFloat := Power(x, y); end; procedure ExprLg(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := log10(x); end; procedure ExprLog10(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := log10(x); end; procedure ExprLog2(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := log2(x); end; procedure ExprMax(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x1, x2: Double; begin x1 := ArgToFloat(Args[0]); x2 := ArgToFloat(Args[1]); Result.resFloat := Max(x1, x2); end; procedure ExprMin(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x1, x2: Double; begin x1 := ArgToFloat(Args[0]); x2 := ArgToFloat(Args[1]); Result.resFloat := Min(x1, x2); end; Procedure ExprHypot(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); var x,y: Double; begin x := ArgToFloat(Args[0]); y := ArgToFloat(Args[1]); Result.resFloat := Hypot(x,y); end; Procedure ExprErf(Var Result: TFPExpressionResult; const Args: TExprParameterArray); // Error function var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := speerf(x); end; Procedure ExprErfc(Var Result: TFPExpressionResult; const Args: TExprParameterArray); // Error function complement var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := speefc(x); end; // Incomplete gamma function P Procedure ExprGammaP(var Result: TFPExpressionResult; Const Args: TExprParameterArray); var x, s: Double; begin s := ArgToFloat(Args[0]); x := ArgToFloat(Args[1]); Result.resFloat := gammap(s, x); end; // Incomplete gamma function Q Procedure ExprGammaQ(var Result: TFPExpressionResult; Const Args: TExprParameterArray); var x, s: Double; begin s := ArgToFloat(Args[0]); x := ArgToFloat(Args[1]); Result.resFloat := gammaq(s, x); end; // Incomplete beta function Procedure ExprBetaI(var Result: TFPExpressionResult; Const Args: TExprParameterArray); var a, b, x: Double; begin a := ArgToFloat(Args[0]); b := ArgToFloat(Args[1]); x := ArgToFloat(Args[2]); Result.resFloat := betai(a, b, x); end; Procedure ExprChi2Dist(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; n: Double; begin x := ArgToFloat(Args[0]); n := ArgToFloat(Args[1]); Result.resFloat := chi2dist(x, round(n)); end; Procedure ExprtDist(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; n: Double; begin x := ArgToFloat(Args[0]); n := ArgToFloat(Args[1]); Result.resFloat := tdist(x, round(n), 2); end; Procedure ExprFDist(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; n1, n2: Double; begin x := ArgToFloat(Args[0]); n1 := ArgToFloat(Args[1]); n2 := ArgToFloat(Args[2]); Result.resFloat := Fdist(x, round(n1), round(n2)); end; Procedure ExprI0(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); // Bessel function of the first kind I0(x) var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := spebi0(x); end; Procedure ExprI1(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); // Bessel function of the first kind I1(x) var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := spebi1(x); end; Procedure ExprJ0(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); // Bessel function of the first kind J0(x) var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := spebj0(x); end; Procedure ExprJ1(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); // Bessel function of the first kind J1(x) var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := spebj1(x); end; Procedure ExprK0(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); // Bessel function of the second kind K0(x) var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := spebk0(x); end; Procedure ExprK1(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); // Bessel function of the second kind K1(x) var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := spebk1(x); end; Procedure ExprY0(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); // Bessel function of the second kind Y0(x) var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := speby0(x); end; Procedure ExprY1(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); // Bessel function of the second kind Y1(x) var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := speby1(x); end; function FixDecSep(const AExpression: String): String; var i: Integer; begin Result := AExpression; for i:=1 to Length(Result) do begin if Result[i] = ',' then Result[i] := '.'; end; end; //--------------------- procedure RegisterExprParserAddons; begin with BuiltinIdentifiers do begin AddFunction(bcMath, 'degtorad', 'F', 'F', @ExprDegtorad); AddFunction(bcMath, 'radtodeg', 'F', 'F', @ExprRadtodeg); AddFunction(bcMath, 'tan', 'F', 'F', @ExprTan); AddFunction(bcMath, 'cot', 'F', 'F', @ExprCot); AddFunction(bcMath, 'arcsin', 'F', 'F', @ExprArcSin); AddFunction(bcMath, 'arccos', 'F', 'F', @ExprArcCos); AddFunction(bcMath, 'arccot', 'F', 'F', @ExprArcCot); AddFunction(bcMath, 'cosh', 'F', 'F', @ExprCosh); AddFunction(bcMath, 'coth', 'F', 'F', @ExprCoth); AddFunction(bcMath, 'sinh', 'F', 'F', @ExprSinh); AddFunction(bcMath, 'tanh', 'F', 'F', @ExprTanh); AddFunction(bcMath, 'arcosh', 'F', 'F', @ExprArcosh); AddFunction(bcMath, 'arsinh', 'F', 'F', @ExprArsinh); AddFunction(bcMath, 'artanh', 'F', 'F', @ExprArtanh); AddFunction(bcMath, 'arcoth', 'F', 'F', @ExprArcoth); AddFunction(bcMath, 'sinc', 'F', 'F', @ExprSinc); AddFunction(bcMath, 'power', 'F', 'FF', @ExprPower); AddFunction(bcMath, 'hypot', 'F', 'FF', @ExprHypot); AddFunction(bcMath, 'lg', 'F', 'F', @ExprLog10); AddFunction(bcMath, 'log10', 'F', 'F', @ExprLog10); AddFunction(bcMath, 'log2', 'F', 'F', @ExprLog2); // Error function AddFunction(bcMath, 'erf', 'F', 'F', @ExprErf); AddFunction(bcMath, 'erfc', 'F', 'F', @ExprErfc); // Incomplete gamma and beta functions AddFunction(bcMath, 'gammap', 'F', 'FF', @ExprGammaP); AddFunction(bcMath, 'gammaq', 'F', 'FF', @ExprGammaQ); AddFunction(bcMath, 'betai', 'F', 'FFF', @ExprBetaI); // Probability distributions AddFunction(bcMath, 'chi2dist', 'F', 'FI', @ExprChi2Dist); AddFunction(bcMath, 'tdist', 'F', 'FI', @Exprtdist); AddFunction(bcMath, 'Fdist', 'F', 'FII', @ExprFDist); // Bessel functions of the first kind AddFunction(bcMath, 'I0', 'F', 'F', @ExprI0); AddFunction(bcMath, 'I1', 'F', 'F', @ExprI1); AddFunction(bcMath, 'J0', 'F', 'F', @ExprJ0); AddFunction(bcMath, 'J1', 'F', 'F', @ExprJ1); // Bessel functions of the second kind AddFunction(bcMath, 'K0', 'F', 'F', @ExprK0); AddFunction(bcMath, 'K1', 'F', 'F', @ExprK1); AddFunction(bcMath, 'Y0', 'F', 'F', @ExprY0); AddFunction(bcMath, 'Y1', 'F', 'F', @ExprY1); end; end; initialization RegisterExprParserAddons; end. tomboy-ng_0.34-1/README.md0000644000175000017500000000340514145033507014676 0ustar dbannondbannon### tomboy-ng tomboy-ng is a note taking app that works and syncronises between Linux, Windows and MacOS. It will also Sync to Tomdroid on Android. It features a rich text markup, printing, spell check, backup and snapshot capability. Undo and Redo. Import and export (plain text, RFT, MarkDown). It has Tomboy's automatic linking between notes, searching abilities, NoteBooks and a similar interface. Change a note's title by just editing the title in the edit window. Importantly, tomboy-ng has few dependancies and so is an easy and lightweight install. It is easily installed for Debian Bullseye and its derivatives directly from the Debian Repositories or you can download an install kit for other Linuxes, Windows or MacOS from here. You are, of course, welcome to build from source. Download from the [Wiki Download Page](https://github.com/tomboy-notes/tomboy-ng/wiki/Download_Release) Also available is [TomboyTools](https://github.com/davidbannon/TomboyTools) it provides a means to import or export notes individually, as members of a Notebook or in a directory. A range of formats include Markdown, plain text, HTML (following tomboy style links) and Man Page.

Please see the [Wiki](https://github.com/tomboy-notes/tomboy-ng/wiki) for further information. We use GitHub to store sources and track bugs, see [Tomboy](https://github.com/tomboy-notes/tomboy-ng). The tomboy-ng homepage also is part of the Tomboy homepage [here](https://wiki.gnome.org/Apps/Tomboy). Copyright (C) 2018,2019,2020,2021 David Bannon --- tomboy-ng_0.34-1/doc/0000755000175000017500000000000014145033543014162 5ustar dbannondbannontomboy-ng_0.34-1/doc/tomboy-ng.10000644000175000017500000001261414145033507016163 0ustar dbannondbannon.TH TOMBOY-NG 1 .SH NAME tomboy-ng \- manage a collection of notes using a simple markup .SH SYNOPSIS .B tomboy-ng [\fB\-h\fR] [\fB\-g\fR] [\fB-\-gnome3\fR] [\fB\-\-debug\-sync\fR] [\fB\-\-debug\-index\fR] [\fB\-\-debug-log\fR=\fILOGFILE\fR] [\fB\-\-lang\fR=\fICC\fR] [\fB\-\-config\-dir\fR=\fIPATH_to_DIR\fR] [\fB\-o\fR \fIPATH_to_NOTE\fR] [\fB\-\-open-note\fR=\fIPATH_to_NOTE\fR] [\fIPATH_to_NOTE\fR] .SH DESCRIPTION .B tomboy-ng is a rewrite of the much loved Tomboy Notes. It runs on Linux, Windows and MacOS. It is file compatible with Tomdroid and GNote (>=v0.30). Tomboy-ng notes support Bold, Italic, Strikethrough, Highlight and Underline in four sizes. It will sync notes with other systems using Tomboy's File Sync model and to remote servers using sshfs. tomboy-ng has built in systems to take snapshots of your notes for safe keeping, to import and export notes in different formats, spell checking means to group your notes into "notebooks" for easy management. Many users will want to have tomboy-ng start at logon time and leave it running indefinitly. When running, it will put an Icon in the System Tray and you can interact with it via that Icon. However, some Gnome 3 based Linux distros cannot display the System Tray Icon, on such limited systems, add tomboy-ng to your dock as a favourite and clicking that will either start tomboy-ng or activate an existing instance. On Windows and Mac tomboy-ng uses native libraries, on Linux, tomboy-ng comes in both GTK2 and Qt5 version and most systems have almost all the necessary libraries pre installed. While options below are familiar to Linux users, Mac and Windows users may like to look at some examples further down to see how to use them. .SH OPTIONS .TP .BR \-h Print some help and exit. .TP .BR \-\-debug-sync Generate a lot of logging information on the console during a sync process. Intended for debugging. .TP .BR \-\-debug-index Generate a lot of logging information on the console while indexing the notes repo. Intended for debugging. .TP .BR \-\-debug\-log=\fILOGFILE Direct debug info to a file, this is necessary to see that output on Windows and Mac and sometimes useful on Linux. LOGFILE is a filename and a (writable) path to that filename. See section below on debugging. .TP .BR \-\-lang=\fICC\fR Tomboy-ng normally picks up its language from the OS and does an auto switch. However, its possible to force a language at startup using the two letter language code, ie es for spanish, nl for dutch. .TP .BR \-c ", " \-\-config\-dir=\fIPATH_to_DIR\fR Create or use an alternative config. That config could, for example, specify an alternative location to store notes and sync against a different file sync repository. .TP .BR \-o ", " \-\-open-note=\fIPATH_to_NOTE\fR Open a note in single note mode. In this mode, a separate process runs, it does not have access to the normal notes location, nor sync but can read, display and write back to a stand alone note. If the note name does not exist, a new note is created. If the note name specifies a plain text file or a rtf file, the contents of that file will be imported into a new note and that note will be named as specified on the command line but with an extension of ".note". In this mode, the note remains in its existing location, it is not moved to the tomboy-ng notes location, it is not synced, nor searched by tomboy-ng in its normal mode. Note that the switch (-o or --open-note) is optional, "tomboy-ng some.note" will works as well. .SH Further Help tomboy-ng comes bundled with several read only notes that provide help on topics such as keyboard short cuts, setting up a sync system, using the built in calculator and keeping your notes safe. The project's wiki also has extensive information available. .I https://github.com/tomboy-notes/tomboy-ng .SH DEBUGGING tomboy-ng accepts a couple of debug switches as noted above. They will write detailed progress reports relating to their section of the application to the console. However, Windows and Mac do not, for this purpose, have a console. But can be told to capture this log info to a file using another command line switch or by setting an env variable that specifies a file name. Please ensure you have permission to write to the location specified. tomboy-ng \-\-debug-log=%userprofile%\\debug.txt \-\-debug-sync set tomboy-ng_debuglog=c:\\%userprofile%\\debug.txt Mac users can do something similar : open /Applications/tomboy-ng.app \-\-args "\-\-debug-log=$HOME/tomboy-ng.log" "\-\-debug-sync" Linux users who need a debug logfile can also : tomboy-ng \-\-debug-sync \-\-debug-log=$HOME/tomboy-ng.log Windows users should do something like this - Rightclick the startbutton and select "run". In the field, enter this command line exactly as show (including the inverted commas) - "C:\\Program Files\\tomboy-ng\\tomboy-ng.exe" --debug-index --debug-log=%userprofile%\\Desktop\\tomboy-log.txt Press enter, tomboy-ng should start up normally. Close it. A file called tomboy-log.txt will have been created on your desktop. If you intend to post such a log file to (eg) the Tomboy help system, do please check through it first to ensure there is nothing there you don't want the world to see. .SH "SEE ALSO" .I https://github.com/tomboy-notes/tomboy-ng There you will find several wiki pages going into far more detail than here. .SH BUGS Please send bug reports to the Tomboy mailing list (tomboy-list@beatniksoftware.com) or via Github see above. tomboy-ng_0.34-1/doc/HELP/0000755000175000017500000000000014145033507014712 5ustar dbannondbannontomboy-ng_0.34-1/doc/HELP/ES/0000755000175000017500000000000014145033507015221 5ustar dbannondbannontomboy-ng_0.34-1/doc/HELP/ES/calculator.note0000664000175000017500000000720114145033507020243 0ustar dbannondbannon Calculadora tomboy-ng Calculadora tomboy-ng Versiones de tomboy-ng después de V0.20 incluyen una calculadora. Tiene tres modos básicos, todos activados al pulsar Ctrl-E (o Cmd-E en el Mac). Modo Simple, por ejemplo, escriba 6+10= y pulse Ctrl-E y tomboy-ng mostrará '16' después del signo igual. Funcionará con cualquier cálculo básico, (5*7)/(8.3+12)-0.724=1.000 En este modo, puede usar números, paréntesis, el "." (en vez de la coma) para delimitar décimos y los operadores + - / * y ^ (es decir, potencia). Modo complejo, si necesita usar, por ejemplo, funciones trigonométricas, el Modo Simple no encontrará su expresión completa. Por lo cual, escriba la expresión, selecciónela y entra Ctrl-E de nuevo. Resultado similar. En este modo puede usar los operadores mencionados arriba, más pi, cos, sin, tan, arctan, abs, sqr, sqrt, exp, ln, log, frac, int round y trunc. ej., sin(0.5)^2 + cos(0.5)^2 =1 Modo Columna, sumará una columna de números en las líneas justo encima del total. En este caso, 'una columna' significa todos los números al principio o al final de las líneas. Si hay números tanto al principio como al final, la columna más larga prima. Si tenemos el mismo número de datos en la primera y última columna, la columna a la izquierda prevalece. La primera línea encontrada que no tiene un número en el extremo apropiado (principio o final) hace parar el cálculo. Acuérdese de que un número que es el único dato en una línea se puede considerar como en el principio o el final de la línea. Puede impedir que un número se incluya 'escondiéndolo' con un carácter alfa, quitando el carácter después de hacer el cálculo. En este modo solamente se permiten números y el delimitador de décimos, ".". Casa a Axedale 5.5 Axedale a Bendigo 19 Bendigo a casa por O'Briens Road 23 ida y vuelta = 47.500 5 [algún texto] 7 1 [más texto] 3 [texto] 4 9 En el segundo ejemplo, se usa la columna izquierda porque tiene tres números elegibles. La columna derecha tiene solamente uno (el '4') dado que no hay ningún número al final de la línea "1 [más texto]". texto 7 1 más texto 4 3 14 En esta ejemplo, la calculadora ha elegido los números al final de las líneas porque hay más al final. 7+4+3=14 tome nota que el número '3' se puede considerar en la primera columna y la columna final. La calculadora usa números de coma flotante donde haga falta y se muestra el resultado con 3 dígitos después del decimal ".". Sin embargo, los cálculos internos se hacen con mucho más precisión. Tome nota que en los ejemplos citados arriba, he puesto los resultados en negrita para claridad. No se ocurre automáticamente. 2021-07-19T12:14:41.2452799+00:00 2021-07-19T12:14:41.2452799+00:00 2019-01-15T21:32:06.9620000+11:00 1 1 1000 626 20 29 False tomboy-ng_0.34-1/doc/HELP/ES/tomboy-ng.note0000664000175000017500000002114414145033507020027 0ustar dbannondbannon Ayuda de tomboy-ng Ayuda de tomboy-ng Tomboy-ng es una refundición del querido programa Notas Tomboy. Funciona en Linux, Windows y MacOS. Los archivos son compatibles con Tomdroid y (¿quizás?) GNote. Tomboy-ng notas permiten letras Negritas, Cursivas, Tachadas, Resaltadas y Subrayadas en cuatro tamaños, pequeña, normal, grande y enorme. Puede sincronizar las notas con otros sistemas utilizando el modelo de sincronización de Tomboy, pero todavía no puede hacer la sincronización por red usando Rainy o Grauphel. Hay una capacidad de sincronizar de uno a uno con un móvil Android utilizando Tomdroid (pero solamente desde un equipo de Linux). Muchos usuarios querrán tener tomboy-ng iniciarse al acceder al SO. La aplicación pondrá un icono en la bandeja de sistema que se puede usar para interactuar con ella. Sin embargo, para asegurar que tenemos soporte para algunas plataformas difíciles, se abre una pequeña ventana también que se puede despachar si ve el icono en la bandeja de sistema (o en algunos sistemas de Gnome 3, la ha añadido a su dock como favorito). Puede elegir no mostrar la ventana pequeña al menos que no haya una nota corrompida al iniciar. Usando tomboy-ng Puede interactuar con tomboy-ng a través de un menú en la bandeja de sistema (en algunos sistemas) o el menú que aparece en todas las ventanas principales del programa. Si no tienes un icono en la bandeja de sistema (¡que triste!), añada tomboy-ng a los favoritos que aparecen en su dock y, de esta manera, puedes iniciarlo o despertar la ventana de búsqueda fácilmente. Desde la ventana de búsqueda, puede: Acceder al menú principal (Nota Nueva, Preferencias, notas recientes, etc.). Buscar términos en todas sus notas. Un término de búsqueda como "Juan García" nombre encontrará todas las notas con la palabra nombre en cualquier sitio, y tienen la combinación exacta de Juan García. No encontrará, por ejemplo, mi nombre es García, Juan. Organizar sus notas en cuadernos. tomboy-ng permite que cada nota puede aparecer en más de un cuaderno, pero si sincroniza o comparte las notes con el original Tomboy, no uses esa función. Renombrar un cuaderno, pero si sincroniza sus notas, ¡haga una sincronización completa primero! Tome nota que mientras que la ventana de búsqueda sigue abierta, puede que no se actualicen automáticamente los resultados, al menos que esté marcada la casilla de 'Actualización automática'. Eso es para asegurar que los resultados no cambien mientras está trabajando con notas individuales. Si hay un cambio pendiente, el botón 'Actualizar' se habilita y puede iniciar una actualización al hacer clic en el botón. En general tomboy-ng: guarda notas automáticamente al hacer cambios. le permite cambiar el título de una nota en la ventana de la nota. hace copias de seguridad de notas eliminadas. Si necesita saber que una nota se ha eliminado de verdad, vaya a Preferencias-->Copia de Seguridad. tiene funciones para hacer instantáneas de sus notas de vez en cuando. ¡Utilícelo, por favor! puede sincronizar sus notas con un almacén de archivos común para que estén disponibles de equipos múltiples (Linux, Windows o Mac). no comparte bien. Si guarda sus notas en un disco compartido (sin usar sincronización), tenga muchísimo cuidado de no tener más de una instancia de tomboy-ng o Tomboy ejecutándose al mismo tiempo. Ocurren cosas malas. Parámetros de la línea de comandos. -h, --help Mostrar la ayuda y salir. --delay-start Añade un par de segundos al inicio para asegurar que tomboy-ng capta su combinación de colores. -l CCode --lang=CCode Forzar idioma, códigos de idiomas soportados como es y nl. Díganos si quiere tomboy-ng en otro idioma. --version Imprimir el número de versión y salir. --no-splash No mostrar la pequeña ventana de bienvenida. Le ahorra el trabajo de despacharla después del inicio. No lo use al menos que haya comprobado que se pueda ver el icono en la bandeja de sistema. --config-dir=PATH_to_DIR Crear o usar una configuración alternativa. Principalmente una opción para pruebas, pero útil si, por ejemplo, quiere tener dos (o más) grupos de notas independientes (pero no concurrentes). --open-note=PATH_to_NOTE Abrir una nota en el modo de nota simple. En este modo, un proceso independiente se ejecuta que no tiene acceso a la ubicación normal de las notas ni a la sincronización, pero que se puede leer, mostrar y escribir una sola nota. Si el nombre de la nota no existe, se crea una nueva. Si el nombre de la nota especifica un archivo de texto plano o rtf, los contenidos del archivo serán importados a una nota nueva y la nota tendrá el nombre especificado en la línea de comandos, pero con la extensión ".note". En este modo la nota se queda en la ubicación donde estaba (o, para notas nuevas, donde se especifica en la línea de comandos). No se tralada a la ubicación de las notas tomboy-ng, no se sincroniza, ni se busca con tomboy-ng en el modo normal. Téngase en cuenta que el parámetro (-o o --open-note) es opcional; "tomboy-ng some.note" funciona también. --save-exit Funciona solamente en el modo de nota única e importará el archivo (.note, .rtf, texto plano), convertirá al formato .note (y el formato estándar del nombre de una nota) y lo guardará en el directorio de notas dado en la configuración. Téngase en cuenta que tomboy-ng requiere un reinicio o 'actualización' después. --debug-sync --debug-index ---debug-spell Mostrar lo que pasa durante una sincronización, indización o revisión ortográfica. Útil para depuración. Estos parámetros escribirán al terminal informes de progreso detallados con relación a las funciones respectivas de la aplicación. Sin embargo, Windows no tiene un terminal con este fin. Sin embargo, se puede dirigir esta información a un archivo de registro usando otro parámetro de la línea de comandos o estableciendo un variable ENV que especifica un nombre de archivo. Asegúrese, por favor, que tenga el permiso para escribir a la ubicación dada. Por ejemplo, desde el botón de inicio, haga clic en ejecutar y teclee: tomboy-ng --debug-log=c:\debug.txt --debug-sync Cosas de Mac Usuarios de Mac necesitan una línea de comandos un poco más complicada al usar cualquier de estos parámetros. Por ejemplo, una línea de comandos para generar un registro de depuración de una sincronización sería: open tomboy-ng.app --args "--debug-log=$HOME/tomboy-ng.log" "--debug-sync" Y, como consecuencia de la metodología .app, hay que usar rutas absolutas para los parámetros, o, $PWD relativo al directorio actual: open tomboy-ng/tomboy-ng.app --args "-o" "$PWD/doc/tomboy-ng.note" 2021-07-19T15:38:32.4712985+00:00 2021-07-19T15:38:32.4712985+00:00 2018-11-07T16:01:06.6550000+11:00 1 1 1000 626 20 30 False tomboy-ng_0.34-1/doc/HELP/ES/sync-ng.note0000664000175000017500000002175514145033507017502 0ustar dbannondbannon Sincronización con tomboy-ng Sincronización con tomboy-ng Esto trata de la sincronización de archivos entre equipos con Linux, Windows y Mac. Hay otro documento de ayuda que trata de sincronizar con Tomdroid. Si le interesa en sincronizar a través de Github, que permite tanto la sincronización como acceso a sus notas online desde un navegador, vea https://github.com/tomboy-notes/tomboy-ng/wiki/Github-Sync Sincronizar sus notas tomboy-ng (y/o Tomboy) puede ser muy útil. Si lo hace bien, todas las notas en todos sus equipos serán las mismas. Y, además, tiene una estrategia para hacer copias de seguridad de las notas. ¡Acuérdese que el valor de sincronizar está relacionado con la frecuencia de que lo hace! tomboy-ng permite la sincronización de archivos. Es decir, que sincroniza utilizando un sistema de archivos compartidos (un repositorio). El sistema de archivos puede ser Google Drive, cualquier servidor remoto con lo que se puede comunicar con ssh, un disco local compartido o incluso un pendrive. Funciona de la misma manera entre las plataformas de Linux, Windows y Mac. Tome nota de que tomboy-ng (a diferencia de Tomboy) no conecta a un servicio de sincronización dedicado como Snowy, Rainy o grauphel/NextCloud/Apache. Nuevo a partir de v0.27, Auto-Sincronización, vea más abajo. Vale, antes de empezar, ¿guarda instantáneas? Si no, ¿¿¿por qué no??? Un sistema de archivos compartidos En la práctica, que sepamos, tomboy-ng sincronizará con cualquier sistema de archivos en lo que su administrador de archivos puede navegar. Podría usar Google Drive, Drop Box u otro sistema en la nube. Pero acuérdese que una copia de sus notas estarán en esos servidores y si no está conforme con que se pueden leer allí, tal vez ¡guardarlas allí no es muy buena idea! Puede que quiera compartir un repositorio a través de NFS o SMB. Windows y NFS no representan una buena combinación, pero SMB funciona bien para las tres plataformas. El router que tiene el autor en casa cuenta con una ranura USB detrás y un disco USB enchufado allí que está compartido a través de SMB. Ha funcionado sin fallo durante un par de años. Algunos gestores de archivos de Linux puede ponerle pegas en mostrar los archivos compartidos por SMB o Samba. Puede ser de ayuda de crear un marcador en el gestor de archivos principal, pero incluso si no funciona, asegúrese de tener instalados gvfs y gvfs-fuse y buscar utilizando el diálogo de directorios que abre tomboy-ng donde verá un archivo denominado más o menos: /run/user/1000/gvfs/smb_share... O incluso podría usar un disco USB y enchufarlo en cualquier equipo que está sincronizando de momento. Vale siempre y cuando tomboy-ng puede leer y escribir allí. Una cosa de tener en cuenta: si piensas sincronizar ambos Tomboy y tomboy-ng con el mismo repositorio, Tomboy no es tan flexible con "cualquier sistema de archivos". Investíguelo antes de dedicar mucho tiempo en establecer el sistema. Crear un repositorio Fácil. Puede que sea una buena idea crear un directorio allí en el sitio compartido como "Tomboy-Sync" o lo que quiera. Simplemente hay que decir a tomboy-ng (o Tomboy) donde está el sistema de archivos y lo hará todo. En tomboy-ng, vaya a Preferencias, haga clic en la pestaña de Sincronización, y "Cambiar repositorio". Navegue al directorio que creó antes. tomboy-ng analizará el directorio y las notas (si las hay) y producirá un informe sobre lo que hará. Si le parece bien, haga clic en "Guardar y Sincronizar". Hecho. sshfs para sincronizar a través de una red tomboy-ng puede sincronizarse con cualquier servidor remoto accesible a través de ssh. El desarrollador emplea un plan de hosting barato con un sitio web poco usado y unos cuantos GB de espacio. Es útil porque ¡puedo comunicarme con ello por ssh! Por poder hacerlo así, puedo usar sshfs. Por ejemplo, en Linux, instalaría sshfs y como primer paso conectarme al servidor remoto con ssh y crear un directorio, por ejemplo, TB_Sync. Luego en el equipo local: cd; mkdir TB_Sync; sshfs minombre@servidorremoto.com:TB_Sync TB_Sync [intro] Abrir tomboy-ng y establecer el repositorio de sincronización a ~/TB_Sync, y ¡listo! Desconectar del directorio compartido con: fusermount -uz TB_Sync [intro] Y re-conectar más tarde para sincronizar de nuevo con sshfs minombre@servidorremoto.com:TB_Sync TB_Sync [intro] Sincronización manual y conflictos De vez en cuando tiene que hacer clic en la entrada del menú de Sincronización. Un informe breve aparecerá contando lo que ha hecho. Eche un vistazo y cierra el informe. Sin embargo, es casi seguro que llegará un momento en que haya cambiado una nota en más de un equipo después de la última sincronización. Triste, pero inevitable. Ahora, el motor de sincronización no sabe que hacer. Le mostrará una lista de diferencias entre las dos notas y puede elegir usar la versión local o remota. Remota significa la versión en el repositorio de archivos "remoto". Si, incluso después de ver las diferencias entre las dos versiones, no puede elegir, entonces tal vez debería elegir usar la versión remota. De esta manera la versión "local" se copiará a la copia de seguridad y puede recuperarla desde Preferencias-->Copia de Seguridad. Para resolver conflictos, también existen varios botones "hacer todo" que se aplicarán a los demás conflictos en la sincronización. Remota, local, la más nueva, la más vieja, si se siente valiente, haga clic en una. Sincronización automática Nuevo en v0.27, tomboy-ng sincroniza automáticamente en segundo plano. Obviamente ocurre solamente si tienes el proceso de sincronización configurado y el repositorio está disponible. Preferencias-->Sincronización y marque la casilla. Sincronizará unos 15 segundos después de arrancarse y luego cada hora. Si encuentra un conflictos entre dos versiones de una nota, la ventana normal aparecerá mostrándole las diferencias entre las dos versiones para que puedas decidir. Si no se puede sincronizar porque, quizás ha desconectado el repositorio compartido, una ventana emergerá para avisarle. Puede arreglar el problema y haga clic en "Intentar de Nuevo" o, si hace clic en "Cancelar", no se sincronizará hasta que reinicie tomboy-ng o alterne la opción de Auto-Sincronizar. Si usted, como yo, tiene que asegurarse que todo funcione, puede ver detalles de la sincronización más reciente en la barra de estado de la ventana de Búsqueda. Unirse de nuevo a un repositorio Tomboy tenía dificultades si quería unirse de nuevo a un repositorio que usaba antes. Veía muchas notas con el mismo identificador sin tener los datos del repositorio para saber como tratarlas y las marcaba todas como conflictos. Para solucionarlo, tomboy-ng mira la última fecha de cambio, con precisión al microsegundo, y decide que dos notas con el mismo identificador y la misma fecha del último cambio debería de ser consideradas idénticas. Es una apuesta bastante buena. Ahora bien, este proceso puede ser un poco lento y por eso guardamos datos adiciones en el manifiesto remoto. No obstante, si usa Tomboy en el mismo repositorio, quitará esos datos y tardará en unirse de nuevo al repositorio. Usualmente no presente ningún problema ... Cuando algo va mal De verdad, he probado el nuevo motor de sincronización de modo exhaustivo, pero todos sabemos el problema de desarrolladores que prueban sus propios programas. Entonces, pues sí, ¡puede que todo vaya al traste! Primero, ¿está guardando instantáneas? Si no, ¿¿¿por qué no??? Segundo, por favor, prueba iniciar tomboy-ng desde la línea de comandos. Mientras se ejecuta, cualquier anomalía aparece en el terminal. Si no le muestra nada revelador, intente parar y añadir --debug-sync a la línea de comandos. Si tiene un problema, por favor haga un informe en Github o la lista de correos de Tomboy. ¡Realmente deseamos saberlo! 2021-11-11T16:07:10.4508768+11:00 2021-11-11T16:07:10.4508768+11:00 2000-01-01T10:00:00.0000000+11:00 1 1 1000 626 332 30 False tomboy-ng_0.34-1/doc/HELP/ES/systray.note0000664000175000017500000000353114145033507017632 0ustar dbannondbannon Bandeja de Sistema en Linux Bandeja de Sistema en Linux La manera habitual de interactuar con tomboy-ng es por un pequeño icono amarillo que aparece en la Bandeja de Sistema (SysTray), a veces llamada el área de notificación. Sin embargo, no todos los Entornos de Escritorio de Linux pueden mostrar iconos en la bandeja de sistema, y algunos que pueden no lo hacen por defecto. Si puede ver un pequeño icono de color amarillo, probablemente en el panel principal en la pantalla, no tienes ningún problema. Si no lo puede ver, es probable que usa un Escritorio que tiene dificultades en mostrar la bandeja de sistema, quizás el escritorio de Gnome. Información detallada y, esperamos, actual sobre los últimos 'trucos' para tener una bandeja de sistema disponible o, incluso, como usar tomboy-ng sin una se puede encontrar en https://github.com/tomboy-notes/tomboy-ng/wiki/System-Tray-on-Linux Suporte para la bandeja de sistema en Linux a veces cambia de repente, entonces vale la pena considerar una versión más nueva de tomboy-ng, https://github.com/tomboy-notes/tomboy-ng 2021-07-19T11:57:41.2944340+00:00 2021-07-19T11:57:41.2944340+00:00 2021-01-23T13:48:35.2369237+11:00 1 1 1227 610 108 126 False tomboy-ng_0.34-1/doc/HELP/ES/tomdroid.note0000664000175000017500000003705414145033507017744 0ustar dbannondbannon Sincronización con Tomdroid Sincronización con Tomdroid ¡Nuevo en V0.32, conexión entre PC y dispositivo Android usando un cable! Sin necesidad de perfiles, contraseñas ni ssh. Bienvenido a la estrategia de tomboy-ng de sincronizarse con Tomdroid. Por favor, dese cuenta de que es una función experimental en tomboy-ng y depende mucho de lo que hace el mismo Tomdroid. Sin embargo, el autor ha usado este modelo habitualmente durante un par de meses en varios dispositivos Android, y parece que funciona. Tiene ganas de saber sus experiencias. Pero tome nota de que la sincronización con Tomdroid es un proceso lento, y tomboy-ng no muestra un informe sobre el progreso de la sincronización todavía. La primera sincronización con un repositorio grande puede ser bastante inquietante. Si tiene más de unos cientos de notas, puede que sea mejor esperar a la próxima versión de tomboy-ng. Permitirá la sincronización solamente con un cuaderno especifico. Introducción Como una app independiente, Tomdroid funciona bastante bien, pero cuando se sincroniza con sus notas en un PC o portátil, realmente destaca. Tomdroid se hizo en los mejores días de la familia Tomboy. Funcionaba bien sincronizando a través de una red con el servicio de la nube Ubuntu One (aunque puede que fuera antes del uso de este término). Sin embargo, el servicio se retiró y los usuarios de la red Tomdroid necesitaba proveer sus propios servicios de sincronización. Eso implica mantener un servidor Rainy en casa o configurar un sistema Grauphel. Ninguno de los dos es una tarea trivial. Sin embargo, tomboy-ng no sincroniza a través de una red. tomboy-ng, sí, hace una sincronización basada en archivos donde un repositorio compartido está visible para todas las partes. Es rápido y bastante fácil, pero Tomdroid no puede formar parte de este tipo de sistema. La solución tomboy-ng, a partir de versión 0.32 puede hacer una sincronización de uno a uno entre Tomdroid y un equipo de Linux a través de un cable USB. El equipo con Linux puede formar parte del grupo de sincronización de archivos, o no. Puede establecer tantas conexiones de uno a uno como dispositivos Tomdroid que tenga. Lo que hace falta Un PC, portátil o cualquier equipo Linux donde se ejecuta tomboy-ng. Uno o más dispositivos Android (móvil, tablet, etc) con Tomdroid instalado, por ejemplo, desde la tienda PlayStore o F-Droid. Un cable USB normal para conectarlos. Configuración para el primer uso Si ya tienes notas de tomboy-ng y una instalación nueva de Tomdroid, debería seguir los siguientes pasos. Abra Tomdroid en el dispositivo. Toque el Menú (arriba a la derecha), elija "Preferencias" y localice el grupo "Sincronización". Compruebe que la preferencia del servicio es "Tarjeta SD" (no hace falta tener una Tarjeta SD externa porque Android dirige los datos a un sitio interno) y que la ubicación en la Tarjeta SD indica /storage/emulated/0/Tomdroid/. Cierra la ventana de Preferencias y toque el icono de sincronización en la barra del menú. Si no tiene notas Tomdroid en este momento, pasará rápido. IMPORTANTE - Cierre Tomdroid ahora. Android usa mucho el caché de disco y tenemos que asegurarnos que realmente ha llegado al 'disco'. Es esencial que cierre Tomdroid en vez de dejarlo funcionando en segundo plano. De lo contrario la sincronización fallará de vez en cuando. Ahora conectar el dispositivo Android al PC. El dispositivo le pedirá permitir acceso desde el PC a sus archivos. En el equipo de Linux, vaya a las Preferencias de tomboy-ng, Pestaña Basicó, y marque "Mostrar Sincronización Tomdroid". Obsérvese que es experimental. Ahora, debería hacer una sincronización normal (es decir, que no es de Tomdroid) o una instantánea, o mejor, ¡ambos! Instantáneas son fáciles de hacer: Preferencias, Pestaña Recuperar y haga clic en "Hacer Instantánea Manual". ¡Demasiado fácil! El Menú Principal ahora tendrá una entrada "Tomdroid". ¡Haga clic en ello! La próxima pantalla intentará encontrar a su dispositivo Android, concretamente el directorio que contiene los archivos de sincronización de Tomdroid. Si todo está bien, le sugerirá hacer clic en "Unirse". Hágalo. Tardará un minuto o dos, quizás mucho más, en transferir copias de las notas del PC al dispositivo. Al terminar, cierre la conexión con el dispositivo usando en el PC el gestor de archivos o una utilidad dedicada a hacerlo si hay. Desenchufe el cable USB. Lance Tomdroid de nuevo, toque el símbolo de sincronización, y todas sus notas debería empezar a aparecer en Tomdroid. Sincronización rutinaria Es importante que siga estos pasos en cada sincronización. Desde Tomdroid, toque el icono sincronizar y luego cerrar Tomdroid. ¡Ciérrelo de verdad! Conecte el dispositivo Android al PC con un cable USB. Desde tomboy-ng, haga clic en "Sincronización Tomdroid" y debería identificar el dispositivo como uno de sincronización y sugerirle que haga clic en el icono de sincronización. Cierre la conexión, desenchufe el cable USB, reinicie Tomdroid y toque el icono de sincronización. Si sincroniza tomboy-ng con otros portátiles o PCs, tiene sentido hacerlo antes de hacer una sincronización rutinaria con Tomdroid, y otra vez inmediatamente después. Consejos generales Opciones de Tomdroid y sus efectos Notas Claras - Eliminar todas las notas de la base de datos local. Si usa esta opción y luego toca "Sincronizar" (de Tomdroid), conseguirá un conjunto nuevo de notas de las que están en el directorio de sincronización. (Tome nota de que "clara" en Tomdroid es una traducción mala del inglés. Debería ser "Eliminar notas".) Eliminar Notas Remotas - Eliminar todas las notas del servicio remoto. ¡Tenga cuidado con esta opción! Si elige esto y luego sincroniza desde tomboy-ng, todas las notas sincronizadas antes se eliminarán de tomboy-ng. (Pero hizo una copia de seguridad antes, ¿no?) Casi sin duda no quiere esta opción, entonces tenga cuidado, por favor. Si ha marcado está opción y perdido las notas remotas, ejecute "Unirse" ("Join") en vez de "Sincronizar" dado que "unirse" no elimina archivos y, por eso, siempre es seguro. Acuérdese que tomboy-ng tiene algunas herramientas que ayudan en recuperar del mal uso de las herramientas arriba citadas. Si quiere empezar una sincronización completamente nueva con Tomdroid, haga reset (reinicio) y luego eliminar las dos cosas anteriores. Luego monte el móvil usando el cable USB y eliminar el archivo 'tomboy.serverid' del directorio 'phone/tomdroid'. Si no sincroniza con otros dispositivos Android, para ser "ordenado", podría eliminar el directorio '~/.config/tomboy-ng/android'. ¿Funciona con Windows o Mac? Todavía, no, pero es probable que será mucho más fácil hacer lo funcionar allí que la manera antigua. Entonces, quizás. ¿Reacciones? ¿Puede sincronizar mi móvil con varios equipos? No. Cada vez que sincroniza con un equipo "nuevo", tiene que hacer un "Unirse", que implica que las notas que eliminó antes puede que se restauren. Sincronice sus equipos con la sincronización de archivos normal de tomboy-ng y elija un sólo equipo como el punto de acceso a sus dispositivos Android. ¿Se puede conectar un equipo a varios dispositivos Android? Sí, está bien mientras que lo haga uno por uno. Puede que tenga que repetir la sincronización inicial después de una segunda hasta que no haya cambios indicados en el programa. Otros asuntos Unirse versus Sincronizar - Son procesos similares, solamente que no podemos usar un manifiesto local durante el proceso de unirse. El manifiesto local contiene datos sobre notas eliminadas, entonces "unirse" en vez de "sincronizar" reavivará notas eliminadas en un lado o el otro. Cuadernos - Tomdroid no sabe de cuadernos. Sin embargo, una nota editada en Tomdroid y sincronizada con tomboy-ng recuerda a cuales cuadernos pertenece. Errores y solicitudes de funciones de Tomdroid - Ahora mismo nadie mantiene Tomdroid. Todo el código fuente está disponible. ¿Quiere intentar mantenerlo? Depuración - si tiene un problema, la primera cosa que debería hacer es cerrar tomboy-ng y reiniciarlo desde la línea de comandos. Puede que informe de algunos errores en el terminal. Marque la casilla 'Depurar' en la ventana de sincronización de Tomdroid antes de sincronizar. Por favor, informenos de lo que encuentre. Cosas por hacer Primero, el proceso puede ser bastante lento debido al sistema de archivos MTP, pero no se puede ver el progreso. Es posible una versión para Windows. Creo que sería útil que la sincronización funcione solamente con un cuaderno especial para Tomdroid. De esta manera, podría limitar el número de notas que aparecen en el dispositivo Android. Si tengo la impresión que hay algo de interés en la sincronización con Tomdroid, se pueden considerar estas posibilidades. Sincronización de uno a uno También incorporado al tomboy-ng es la capacidad de hacer una sincronización de uno a uno, parecida al modelo de Tomdroid, sino utilizando un directorio cualquiera. Aquí se trata sólo de la parte de la sincronización de tomboy-ng, entonces si utiliza este método, debe gestionar para si misma las notas que aparezcan en ese directorio. Para indicar el directorio que utiliza tomboy-ng, tiene que establecer un variable de entorno, TB_ONETOONE dirigido al directorio que quiere utilizar antes de lanzar tomboy-ng. Este directorio tiene que existir y tener permiso de escritura. Si está sin usar, requerirá un "Unirse" y se inicializa según se necesite. Por ejemplo: $ TB_ONETOONE=/home/minombre/MiUnoaUno tomboy-ng <enter> Empiece la sincronización a través de elemento "Tomdroid" en el menú. Tome nota que no puede usar la conexión con cable USB de Tomdroid y la conexión uno a uno en la misma sesión de tomboy-ng, pero cerrando y reiniciando tomoy-ng sin el variable de entorno restablecerá el comportamiento normal de la conexión con cable USB de Tomdroid. Es probable que puede dejar de leer ahora. Como funciona todo El método de sincronización con Tomdroid es otro ejemplo de la sincronización de archivos que utiliza tomboy-ng. Esta es el segundo intento del programador. El primero usaba ssh y, aunque funcionaba, fue mucho más complicado de usar habitualmente. Primero, al hacer la conexión inicial con Tomdroid, tomboy-ng da un identificador único al dispositivo y guarda una copia de su archivo de configuración. Además usa el identificador en el archivo del manifiesto. Si los identificadores no corresponden, una sincronización normal no puede continuar. tomboy-ng (aquí y en otros sitios) usa la fecha-del-último-cambio de cada uno de las notas para establecer si dos notas son, en realidad, idénticas y por eso no hace falta sincronizarlas. No creo que Tomboy lo haga, y por eso, a veces acabamos con un número de conflictos (no válidos) y notas duplicadas al unirnos de nuevo a un repositorio. tomboy-ng nunca debería comportarse así. Además de mantener un registro de los números de revisiones y las últimas fechas de sincronización, el manifiesto local es importante cuando se elimine una nota de cualquier de los dos lados. Tiene dos secciones, la primera, "note-revisions", contiene una lista de todas las notas que este cliente ha visto en el repositorio de sincronización. Entonces, si el repositorio no tiene esa nota ahora, sabemos que ha sido eliminado en el otro sitio y debería eliminarse de la ubicación local. La segunda sección, "notes-deletions", contiene una lista de todas las notas, sincronizadas anteriormente, que se han eliminado de este cliente. En el momento de sincronizar, estas notas se debería eliminar del repositorio remoto (y no estar en la lista del manifiesto local). Téngase en cuenta que creo que tomboy-ng se comporta de otra manera que el Tomboy original porque Tomboy dependía de comparar los números de revisión de sincronización mientras que tomboy-ng analiza la fecha-del-último-cambio. Unirse a (o más precisamente, Crear una conexión con) Tomdroid Primero, ponemos un identificador único en el directorio principal de sshdroid. A continuación registramos las notas en el directorio remoto (es decir, en el dispositivo) y entonces comparamos ese registro con las notas locales. Por definición, no hay un manifiesto local activo, entonces no se elimina nada. Para cada nota, comprobamos primero si hay una correspondiente al otro lado. Si las fechas-del-último-cambio corresponden, las notas son iguales, y no haremos nada. Si tienen distintas fechas-del-último-cambio, entonces hay un conflicto y pediremos al usuario decidir que hacer más adelante. Si una nota existe en un lado o en el otro, pero no en los dos, es una carga o descarga. Sincronización rutinaria Primero, comprobamos los identificadores únicos. Si no coinciden, no continuamos y sugerimos al usuario encontrar el perfil correcto o unirse de nuevo. A continuación leemos el manifiesto local y luego hacemos más o menos lo mismo que lo de arriba, pero utilizando los datos del manifiesto local para determinar lo que hay que eliminar. En ambos casos, en cuanto tengamos todos los datos sobre lo que hay que hacer, lo haremos. Primero Descargar notas, Eliminar notas, Cargar notas, Eliminar notas locales, Escribir el manifiesto local. La interfaz de Tomdroid es bastante frágil y no nos indica donde le duele. 2021-07-20T17:46:12.0819447+00:00 2021-07-20T17:46:12.0819447+00:00 2000-01-01T10:00:00.0000000+11:00 1 1 1000 626 20 30 False tomboy-ng_0.34-1/doc/HELP/ES/recover.note0000664000175000017500000001336114145033507017563 0ustar dbannondbannon Recuperar notas perdidas Recuperar notas perdidas Si está leyendo esto, es probable que ¡está preocupado! Entonces, el primer consejo es no se deje llevar por el pánico. (1) Es bastante probable que le podemos ayudar. Dependerá de que ha ocurrido y, tal vez, si ha hecho una instantánea manual recientemente. En primer lugar, no sincronice las notas, lo que podría sustituir datos malos por buenos. Luego, dé pasos pequeños. Vamos a ver las posibilidades: Eliminé (o se eliminó) una nota que necesito. Puede que sea fácil de solucionar. Mantenemos una copia de todas las notas eliminadas manualmente o sobrescritas en una sincronización. Pero, hay solamente una copia, entonces si se ha sincronizado y sobrescrito otra vez, la nota original se ha esfumado. Compruebe volviendo a la pestaña de "Recuperar" en Preferencias, haga clic en "Ver Nota(s)", eche un vistazo a las notas y haga doble clic en una nota que puede que sea la que busca. Aparecerá una caja de diálogo que le permite ver, eliminar o recuperar la nota. Tengo una nota corrompida. Al iniciar tomboy-ng, verá un aviso sobre la imposibilidad de indizar la nota. Probablemente significa que el formato XML de la nota se ha corrompido de alguna manera. (2) El método de indizar en tomboy-ng es muy riguroso por diseño y se genera un error si hay un campo que no se puede obtener. Sin embargo, en función de donde está el error en la nota, puede que sea posible abrirla y guardarla con el XML reescrito. Por supuesto, haga una instantánea antes de iniciar el proceso. Para probar este remedio rápido, debería: Desde la pestaña "Recuperar" en "Preferencias", hacer clic primero en "Hacer una Instantánea Manual" (¡para estar seguro!) y luego en "Recuperar notas perdidas". En la pestaña "Notas corrompidas" encontrará una lista de notas que están corrompidas. Haga doble clic en una nota que puede ser la problemática y se abrirá una nueva ventana de edición. Puede que haya conseguido recuperar por lo menos algo del contenido. No me esta escuchando, ¡he perdido todas mis notas! Vale, entendido. Esto es grave. Pero nos quedan dos posibilidades todavía. A ver . . . Sincronizo mis notas desde otro lugar. Ah, esto es bueno. Quizás sólo tiene que eliminar el directorio actual de las notas (3) y unirse de nuevo a la red de sincronización. Tome nota, hago hincapié en no solamente sincronizar las notas. Deba ir a la pestaña de sincronización y haga clic en "Establecer Repositorio de Sincronización". De esta manera, el sistema de sincronización le ve como un usuario nuevo y le envía todas las notas. La utilidad de este método depende del tiempo que ha transcurrido desde la última sincronización dado que, claro está, los cambios hechos después de la última sincronización se perderán. Tengo una instantánea ¡Una noticia fantástica! Puede recurrir fácilmente a una instantánea concreta y olvidarse de todas las preocupaciones. ¡Demasiado fácil! Si tuvo la prudencia de guardar la instantánea en otro sitio, cópiela a su directorio de instantáneas (visible en la pestaña "Recuperar" de "Preferencias"). De la pestaña "Recuperar", haga clic en "Recuperar Notas Perdidas". Si no lo ha hecho todavía, ahora es buen momento para hacer clic en "Instantánea de Seguridad" dado que está en una situación peligrosa en este momento. Vaya a la pestaña "Recuperar Instantánea", elija la instantánea que quiere usar y ¡adelante! (4) Regrese y vaya a "Buscar" y haga clic en "Actualizar". Después de comprobar que todo está en orden, por favor, ¡acuérdese to hacer una instantánea de vez en cuando! Notas (1) Palabras de Douglas Adams, usadas sin permiso. (2) Las notas nunca debería corromperse, pero parece que ha pasado: fallo eléctrico, error del programa, lo que sea. Si es culpa mía, ¡lo lamento sinceramente! Por favor, haga un informe sobre la experiencia en la lista de correo de Tomboy o en Github. La única manera que tengo de eliminar los problemas es a través de los informes de los usuarios. (3) Tomboy-ng le informa de donde se guardan sus notas. Vaya allí con un gestor de archivos y seleccione todos los archivos de notas. Son los archivos con nombres de 36 caracteres que parecen ser aleatorios y la extensión ".note". ¡Haga esto solamente si sincronice sus notas! (5) Si guarda una copia en otro sitio, recupérela y desencríptelo la si hace falta. Y ¡ buen trabajo ! 2021-07-20T17:51:10.2211944+00:00 2021-07-20T17:51:10.2211944+00:00 2018-08-26T14:03:28.1020000+10:00 1 1 1061 626 248 20 False tomboy-ng_0.34-1/doc/HELP/ES/key-shortcuts.note0000664000175000017500000001420414145033507020737 0ustar dbannondbannon Atajos de teclado de tomboy-ng Atajos de teclado de tomboy-ng Todas los sistemas Alt-FlechaDerecha : Activar viñetas Alt-FlechaIzquierda : Desactivar viñetas Ctrl-1 : Fuente pequeña Ctrl-2 : Fuente normal Ctrl-3 : Fuente grande Ctrl-4 : Fuente enorme Mayús-FlechaDerecha : extender el texto seleccionado por un carácter hacia la derecha Mayús-FlechaIzquierda : extender el texto seleccionado por un carácter hacia la izquierda Mayús-Clic : Seleccionar texto entre posición actual y posición del clic Windows / Linux Ctrl-Q : Salir de tomboy-ng - En Búsqueda, Preferencias o cualquier Nota Abierta Ctrl-N : Nota nueva - En Búsqueda, Preferencias y cualquier Nota abierta Ctrl-X : Cortar el texto seleccionado y copiarlo al portapapeles Ctrl-C : Copiar el texto seleccionado al portapapeles Ctrl-V : Pegar el contenido del portapapeles en la nota actual Ctrl-A : Seleccionar todo Ctrl-FlechaDerecha : Mover al principio de la palabra a la derecha Ctrl-FlechaIzquierda : Mover al principio de la palabra a la izquierda del puntero Ctrl-Mayús-FlechaIzquierda : extender el texto seleccionado por un carácter hacia la izquierda Ctrl-Mayús-FlechaDerecha : extender el texto seleccionado por un carácter hacia la derecha Ctrl-Z : Deshacer Ctrl-Y : Rehacer Ctrl-F4 : Cerrar la ventana de la nota actual Ctrl-D : Insertar fecha, AAAA-MM-DD hh:mm:ss Ctrl-L : Crear un enlace desde el texto seleccionado Alt-F4 : Cerrar la ventana de la nota actual (algunos escritorios de Linux) Fuentes Ctrl-B : Negrita Ctrl-I : Cursiva Ctrl-S : Tachado Ctrl-U : Subrayado Ctrl-H : Resaltado Ctrl-E : Calculadora - Vea la nota de ayuda sobre la calculadora Buscar (en una nota) Ctrl-F : Encontrar algo en una nota F3 o Ctrl-G : Buscar siguiente instancia Mayús-F3 o Mayús-Ctrl-G : Buscar instancia anterior Mac Cmd-Q : Salir de tomboy-ng - En Búsqueda, Preferencias o cualquier Nota Abierta Cmd-N : Nota nueva - En Búsqueda, Preferencias y cualquier Nota abierta Cmd-X : Cortar el texto seleccionado y copiarlo al portapapeles Cmd-C : Copiar el texto seleccionado al portapapeles Cmd-V : Pegar el contenido del portapapeles en la nota actual Cmd-A : Seleccionar todo Cmd-FlechaDerecha : Ir al final de la línea Cmd-FlechaIzquierda : Ir al principio de la línea Cmd-Z : Deshacer Cmd-Y : Rehacer Cmd-D : Insertar fecha, AAAA-MM-DD hh:mm:ss Opt-Mayús-FlechaIzquierda - extender el texto seleccionado por un carácter hacia la izquierda Opt-Mayús-FlechaDerecha - extender el texto seleccionado por un carácter hacia la derecha Fuentes Cmd-B : Negrita Cmd-I : Cursiva Cmd-S : Tachado Cmd.U : Subrayado Cmd-E : Calculadora - Vea nota de ayuda sobre la calculadora. Opt-H : Resaltado Buscar (en una nota) Cmd-F : Encontrar algo en una nota Cmd-G : Buscar siguiente instancia Mayús-Cmd-G : Buscar instancia anterior 2021-07-19T12:17:24.8509318+00:00 2021-07-19T12:17:24.8509318+00:00 2018-12-06T21:38:38.0650000+11:00 1 1 1000 626 142 95 False tomboy-ng_0.34-1/doc/HELP/FR/0000755000175000017500000000000014145033507015221 5ustar dbannondbannontomboy-ng_0.34-1/doc/HELP/FR/calculator.note0000664000175000017500000000631214145033507020245 0ustar dbannondbannon tomboy-ng Calculator tomboy-ng Calculator Versions of tomboy-ng after V0.20 include an expression calculator. It has three basic modes, all activated by pressing Ctrl-E (or Cmd-E on the Mac) - Simple Calc Mode, you type for example, 6+10= and press Ctrl-E, tomboy-ng will fill in '16' after the equals sign. This will work with any basic numerical calculations, (5*7)/(8.3+12)-0.724=1.000 In this mode, you can use numerals, curved brackets, decimal points and the basic operators, + - / * and ^ (ie power). Complex Calc Mode, if you need to use, say trig functions, the Simple Calc won't find your full expression. So, type the expression, select it and, again, press Ctrl-E. Similar result. In this mode you can use the above mentioned plus pi cos sin tan arctan abs sqr sqrt exp ln log frac int round and trunc. eg sin(0.5)^2 + cos(0.5)^2 =1 Column Mode, will add up a column of numbers in the lines above it. 'A column', in this case means all the numbers that appear at either the beginning of the lines or end of the lines. If there are numbers at both beginning and end of lines, the longer column takes precedence. The first line encounted that does not have a number at the appropriate end stops the column count. You can stop a number being considered by 'hiding' it with an alpha char and, then remove that character after doing the calc. Only numerals and the decimal point are allowed in this mode. Home to Axedale 5.5 Axedale to Bendigo 19 Bendigo to home via O'Briens Road 23 round trip is 47.500 5 some text 7 1 more text 3 blah 4 9 In the above example, the left column is used, it has three eligible numbers, the right column only has one, the '4', there is no number at the end of the "1 more text" line. The expression parser converts to using floating point numbers where necessary and displays its output with 3 digits after the decimal point. It would be easy to add a more flexible model here, one that suppresses trailing zeros and switched to scientific notation if there appears any demand for it. (see floattostrf()). That and the number of decimal places could become config options ? Note in the examples above, I have manually bolded the answers for clarity, it does not happen automatically. 2019-01-29T19:35:51.9370000+11:00 2019-01-29T19:35:51.9370000+11:00 2019-01-15T21:32:06.9620000+11:00 1 1 1000 626 0 0 False tomboy-ng_0.34-1/doc/HELP/FR/tomboy-ng.note0000664000175000017500000001753414145033507020037 0ustar dbannondbannon aide de tomboy-ng aide de tomboy-ng Tomboy-ng est une réécriture du regretté Tomboy Notes. Il tourne sur Linux, Windows et MacOS. Son format de fichier est compatible avec Tomdroid et (?) GNote. Tomboy-ng accepte le texte en Gras, Italique, Barré, Surligné et Souligné en quatre taille de police : petite, normale, grande et énorme. La synchro Tomboy-ng des notes est possible avec tous les systèmes qui utilisent le modèle de synchro de Tomboy (mais pas encore la synchro réseau via Rainy ou Graphal). Il est possible de synchroniser individuellement tout smartphone Android capable d'exécuter Tomdroid (version linux uniquement). Certains utilisateurs souhaiteront avoir Tomboy-ng actif à l'ouverture de la session, une icône est placée la barre des tâches et permet d'interagir. Pour garantir le support sur certaines distribution spéciales, une petite fenêtre ou un écran d'accueil est également ouvert ; il peut être minimisé vers le bandeau des applications (ou sur certaines version de Gnome3, être ajouté comme favori dans le dock). Utilisation de Tomboy-ng Tomboy-ng se manipule depuis le menu visible comme icône dans le bandeau des applications ou via la fenêtre menu sur les autres distributions. En l'absence du beandeau des application (quel dommage !), Tomboy-ng peut-être ajouté comme favori pour apparaitre dans le dock, de cette façon il est aisément possible de le lancer ou de restaurer le champ de recherche. Depuis la fenêtre de recherche, on peut : Accéder au menu principal (Nouvelle note, réglages, notes récentes, etc.). Rechercher des termes dans toutes les notes. Une recherche du type : nom "Jacques Martin" retournera toutes les notes contenant le mot nom et l'exacte combinaison "Jacques Martin". Mon nom est Martin par exemple ne sera pas sélectionné. Organiser les notes dans des carnets, Tomboy-ng autorise qu'une note soit classée dans plus d'un carnet mais si la synchronisation ou le partage est utilisé, c'est à éviter. Renommer un carnet, en n'oubliant pas de faire une synchronisation complète au préalable si cette fonction est utilisée ! À noter que les résultats de la recherche ne sont pas automaitquement mises à jour quand la fenêtre est ouverte. C'est pour garantir qu'un résultat de recherche ne change pas durant la modification des notes. Si un changement est intervenu, le bouton "Rafraîchir" est activé et la mise à jour est alors possible. Tomboy-ng : sauvegarde automatiquement les notes quand elles sont modifiées créé automatiquement une copie de secours qund un note est effacée, pour savoir si une note est effectivement effacée, consulter le menu Réglages->Restauration permet de faire simplement un snapshot des notes, n'oublier pas d'en faire ! Linux, Windows et MacOSpeut synchroniser les notes vers une zone de stockage commune les rendant ainsi accessibles à de multiples machines (Linux, Windows et Mac). ne gère pas parfaitement le partage. L'accès concurrent aux notes sur un volume partagé (sans utiliser la synchronisation) génère des comportements hiératiques avec des résultats imprévisibles. Commandes par terminal -h ou --help affiche l'aide puis quitte. --delay-start Retarde le démarrage de quelques secondes pour permettre a Tomboy-ng d'utiliser la personnalisation des couleurs. -g ou --gnome3 Empêche la fermeture de l'écran d'accueil. Uniquement nécessaire pour certaines distributions linux (gnome 3) qui n'afficherait pas Tomboy-ng dans le bandeau des application. -l CodePays ou --lang=CodePays Sélectionne la langue de l'interface (CodePays= es, nl ou fr). Dites-nous si vous souhaitez voir de nouvelles langues ajoutées ! --version Affiche la version et quitte. --no-splash N'affiche pas l'écran d'accueil au lancement. Évite de devoir fermer la fenêtre manuellement après démarrage. À n'utiliser qu'après avoir vérifié la présence de la petite icône verte dans le bandeau des applications. --config-dir=CHEMIN_RÉPERTOIRE Crée ou utilise un chemin alternatif. Sert surtout à faire des tests, comme avoir deux bases de carnets distinctes par exemple. --open-note=CHEMIN_NOTE Ne fonctionne qu'avec le mode de note unique. Une instance isolée est éxécutée, elle n'a ni accès à au répertoire courant des notes ni à la synchro mais elle peut lire, afficher et écrire la note unique. Si la note n'existe pas, elle est automatiquement créée. Si le nom de la note désigne un fichier ".rtf" ou "texte non formaté", son contenu sera importé dans la dite note qui reprendra le nom stipulé mais au format ".note". Dans ce mode, la note est stockée conformément au chemin précisé et ne sera ni déplacée vers le répertoire courant des notes, ni synchronisée, ni identifiée lors d'une recherche en mode normal. À noter que le paramètre "-o" ou "--open-note" peut être omis : "tomboy-ng ma.note" fonctionne tout aussi bien. --save-exit Importe le fichier (.note, .rtf, texte non formaté), le convertit au format .note (et au format de nom de note standard) puis sauve la note dans le répertoire courant des notes. Aprs avoir passé cette commande, un redémarrage de Tomboy-ng est requis. --debug-sync --debug-index --debug-spell Affiche sur la console les événements demandés de manière détaillée issus de la partie de l'application qui les concerne. La console de Windows ne bénéficie pas de cette fonctinnalité cependant il peut être demandé de diriger les messages de sortie vers un fichier journal en utilisant une autre commande ou en spécifiant une variable d'environnement contenant un nom de fichier. Attention de disposer des droits suffisants. Exemple, presser le logo "start", cliquer sur "exécuter" puis saisir la séquence ci-dessous : tomboy-ng --debug-log=c:\debug.txt --debug-snyc Pour MacOS L'utilisation de la console requiert une syntaxe plus complète dès lors que des paramètres sont ajoutés. Par exemple, journaliser les messages d'un debug de la synchro s'écrivent ainsi : open tomboy-ng.app --args "--debug-log=$HOME/tomboy-ng.log" "--debug-sync" De par l'approche ".app", l'utilisation de paramètres demande que le chemin spécifié soit absolu, sauf à utiliser une variable $PWD relative au repertoire courant : open tomboy-ng/tomboy-ng.app --args "-o" "PWD$/doc/tomboy-ng.note" 2020-11-25T08:25:26.5455611+01:00 2020-11-25T08:25:26.5455611+01:00 2020-11-23T18:33:51.0251392+01:00 1 1 933 947 920 37 False tomboy-ng_0.34-1/doc/HELP/FR/sync-ng.note0000664000175000017500000001725314145033507017500 0ustar dbannondbannon tomboy-ng sync tomboy-ng sync This is about file syncing between Linux, Windows and Mac computers. See a separate document that talks about syncing to Tomdroid. Synchronising your tomboy-ng (and/or Tomboy) notes can be a very useful thing. Do it properly and all your notes on all your computers are the same. And you have a backup strategy for your note too ! Remember that the value of syncing is closely related to how often you do it ! tomboy-ng supports file sync. That is, it syncs to a shared file system. That filesystem might be Google Drive, any remote server you can ssh to, a local shared drive at home or even just a USB thumb drive. It works identically between the three supported platforms, Linux, Windows and Mac. Note that tomboy-ng does not (like Tomboy does) connect to a dedicated Tomboy sync service such as Snowy, Rainy or grauphel/NextCloud/Apache. New in v0.27, Auto sync, see further down. OK, before we start, are you keeping snapshots ? If not, why not ??? A shared Filesystem In practise, tomboy-ng will sync to any (?) file system that your file manager can browse. You could use Google Drive, Drop Box or any such system. Don't forget a copy of your notes will live on their server so if you are unhappy at them being read there, maybe that not a great idea! You may want to setup a NFS or SMB share. Windows and NFS is not a great mix but SMB works well for all three platforms. The author's home network router has a USB slot at the back, a USB Disk Key plugged in there is distributed via SMB. Been working flawlessly for a couple of years. Some Linux File Managers can be reluctant to show you the SMB or Samba shares, it can help to make them a book mark in your main File Manager but if even that does not work, ensure you have gvfs and gvfs-fuse installed and browse using the directory dialog that tomboy-ng pops up to somewhere like /run/user/1000/gvfs/smb_share ..... Or you could even just use a USB Disk Key and plug it into which ever machine you are syncing at the time. As long as tomboy-ng can read and write there, good. One thing to note, if you plan to sync both Tomboy and tomboy-ng with the same repository, Tomboy is not quite so happy with "any shared filesystem", check it before investing too much time. Setting Up A Repository Easy, might be a good idea to create a directory there such as Tomboy-Sync or whatever, tomboy-ng (or Tomboy) just needs be told where the filesystem is and it will do the rest. In tomboy-ng, click Settings, Sync Tab, click "Change File Sync Repo". Browse to the directory you created. tomboy-ng will have a look at the directory and your existing notes (if any) and will generate a report about what it will do. If that looks OK, click "Save and Sync". Done. sshfs to do network sync tomboy-ng can sync quite happily to any remote server that you have ssh access to. The author has a cut price hosting plan with a much neglected website and a few gig of diskspace. Its useful because I can ssh into it ! So, if I can ssh to it, I can use sshfs with it. For example, on a linux machine, I would install sshfs then, initially ssh to this remote server and create a directory called eg TB_Sync, then back on my local machine- cd; mkdir TB_Sync; sshfs myname@remoteserver.com:TB_Sync TB_Sync [enter] Fire up tomboy-ng and set its sync repo to ~/TB_Sync and its done. Disconnect that shared directory with - fusermount -uz TB_Sync [enter] And reconnect later on, to sync again, with sshfs myname@remoteserver.com TB_SYNC [enter] Manual Syncing and Clashes From time to time, you need to click the Sync menu entry. A short report will pop up telling what it has done, have a look and close. However, there will almost certainly come a time when you have changed a particular note on more than one machine since your last Sync. Sad but inevitable. Now, the Sync engine does not know what to do. It will show you a list of the differences between the two notes and you can choose to use the Local or Remote version. Remote being the 'remote' file repository. If, even after seeing the differences between the two versions, you still cannot decide, then perhaps you should chose to use the remote. The local one will then be backed up and you can recover it from Settings->Backup. Note, when resolving clashes, there are also several "do all" buttons that will be applied to the remainder of this sync run. Remote, Local, newest, oldest, if you feel brave, click one. Automatic Syncing New on v0.27, tomboy-ng does automatic, behind the scenes syncing. Obviously only if you have setup sync and the necessary shared file system is available. Settings->Sync and tick the box. It will sync about 15 seconds after startup and then hourly. If it encounters a note clash, the usual window will still popup showing the differences between the two notes allowing you to decide. If it cannot sync, because, perhaps, you have disconnected the shared drive, again a popup windows will advise you, you can either fix the problem and press Retry or, if you press Cancel, syncing will not be attempted again until you either restart tomboy-ng or 'bounce' the Auto Sync setting. If you are like me and need constant reassurance that things are working, you can see details of most recent sync in the Search Window's status bar. Rejoining a Repository Tomboy would struggle when you had occasion to re-join a repo you have used in the past. It would spot a whole lot of notes with the same ID but not have the repository data to know how to handle them, they would all be labelled as clashes. To solve this, tomboy-ng looks at the last change date, accurate to the micro second and decides that two notes with the same ID and the same last change date should be assumed to be identical. Its a pretty good bet. Now, this process can be a bit slow so we keep additional data in the remote manifest. However, if you use Tomboy in the same repo, it will drop that extra data and re-joining a repo will be slow. Not usually a problem ... When Something Goes Wrong. Honestly, I have tested the new sync engine to death. But we all know the problem with developers testing their own code. So, yep, it might all go wrong ! Firstly, are you keeping snapshots ? If not, why not ??? Secondly, please try starting tomboy-ng from the command line. While its running, anything it does not like is reported to your console. If that does not show you anything revealing, try stopping and adding --debug-sync to the command line. If you have a problem, please report it to either github or the Tomboy mailing list, we really want to know ! 2020-12-03T16:18:15.5085042+11:00 2020-12-03T16:18:15.5085042+11:00 2000-01-01T10:00:00.0000000+11:00 1 1 1000 626 806 221 False tomboy-ng_0.34-1/doc/HELP/FR/systray.note0000664000175000017500000000635114145033507017635 0ustar dbannondbannon System Tray on Linux System Tray on Linux Note : the message about not showing the SysTray is usually a false alarm on Ubuntu. Sorry. The normal way that a user interacts with tomboy-ng is via a small yellow icon that appears on the System Tray, sometimes called the notification area. However, not all Linux Desktop Environments are able to display System Tray Icons, and some that can do not do so by default. If you can see a small, yellow icon, possibly upper right of your screen, you don't have a problem, well done in choosing a user focused Desktop. If you cannot see it, you are probably using a Desktop that may not display the System Tray. Firstly, see if your particular Desktop just needs to configured to display a SysTray, failing that, you have a number of alternatives - tint2 Install the very useful tint2 panel. It has no trouble displaying a System Tray on all Linux Desktops that I have tested. It seems to be widely available. Typically, you might type one of the following command in your terminal - sudo yum install tint2 sudo dnf install tint2 sudo apt install tint2 Start tint2 before you start work and if you like that model, add it to your startup applications. Using your dock Gnome 3 typically has a 'dock' down the left side, maybe only visible after you click Activities'. Some other Desktops have similar docks. After starting tomboy-ng (the first time), and before you 'hide' it, find its yellow Icon in your dock. Right click it and choose add to favourites. You can now 'Hide' the tomboy-ng splash screen and activate tomboy-ng at any time directly from the dock. To close tomboy-ng completely, click the tomboy-ng icon in the dock, tomboy-ng's search box opens, click 'Menu' and 'close'. Other Approaches Similarly to the above approach, if you start tomboy-ng and hide it, you can activate it at any time from the Menu you normally use to start an application. In this way, you are not restarting it each time, its always there, the restart attempt just prompts the running instance to pop up its Search Window. There are some Gnome Extensions that you can install to restore a functioning System Tray but especially if you are using Wayland they may be just too hard. But if you are willing to disable wayland and use xorg instead, that just might work. Search for TopIconsPlus. 2021-02-01T18:48:56.2321715+11:00 2021-02-01T18:48:56.2321715+11:00 2021-01-23T13:48:35.2369237+11:00 1 1 912 497 847 292 False tomboy-ng_0.34-1/doc/HELP/FR/tomdroid.note0000664000175000017500000003257114145033507017743 0ustar dbannondbannon Tomdroid Sync Tomdroid Sync New in V0.32, Cable based connection between PC and Android Device ! No profiles, passwords or ssh needed. Welcome to tomboy-ng's take on Tomdroid. Please be aware that its an experimental feature in tomboy-ng and its heavily dependent on what Tomdroid itself does. However, the author has been routinely using this model for a couple of weeks now on several different Android devices and so far it seems functional. He would greatly like to hear your experiences. But note that sync with Tomdroid is slow process, and tomboy-ng does not, yet report on its progress. The first sync with a large repository can be quite unnerving. if you more than a several hundred notes, you may be better waiting to the next release of tomboy-ng, it will allow sync with only notes in a particular notebook. Background As a standalone app, Tomdroid works well enough but when synced to your notes on a PC or Laptop, it really shines. Tomdroid was built back in the Tomboy family's glory days. It worked fine doing a network sync with the Ubuntu One cloud service (although that may have been before we used that term). However, that service was withdrawn and Tomdroid network users needed to provide their own Sync facilities. That means either running a Rainy server at home or setting up a grauphel system. Neither is a trivial exercise. However, tomboy-ng does not do network sync. Tomboy-ng does do a file based sync where a shared file service is visible to all parties. Its quick and relatively simple but Tomdroid cannot be a direct part of such a system. This Solution tomboy-ng, as of release V0.32 can do a one to one file sync between Tomdroid and a Linux Box using a USB Cable. The Linux box may, or may not be part of a File Sync group. You can establish as many of these one to one connections as you have Tomdroid capable devices. Whats needed A Linux pc, laptop or what ever running tomboy-ng. One or more Android devices (phone, tablets etc) with Tomdroid installed, probably from the PlayStore. A normal USB cable to connect them together. First Time SetUp Assuming you already have notes in your tomboy-ng and a fresh install of Tomdroid, you should - Fire up Tomdroid on the device. Touch the Menu (top right), select Settings and find the Synchronization block. Check that Service is set to SD Card (note you don't need an external SDCard, Android directs that to some internal space) and that Location on SD Card is set to /storage/emulated/0/tomdroid/. Close the Settings screen and touch the Sync symbol on the menu bar. Assuming you have no Tomdroid notes at this stage, it will be quite quick. IMPORTANT - close Tomdroid down now. Android uses a lot of disk caching and we must be sure that it has actually hit the 'disk'. It is vital that you close Tomdroid, not just background it. Sync will occasionally fail otherwise. Now, use the cable to connect the PC to a Android Device. The device will ask you to allow access from the PC to its files. On your Linux box, go to tomboy-ng's Settings, Basic Tab, and tick Show Tomdroid Sync. Note it is experimental. Now, you should either run a normal (that is, not Tomdroid) sync or take a snapshot, or, better still, both ! Snapshots are easy, Settings, SnapShot Tab, click Take a Manual Snapshot. Too Easy ! The Main Menu will now have a "Tomdroid" entry. Click it ! The next screen will try and find your Android Device, in particular the directory containing the Tomdroid Sync Files. If all is well, it will suggest you click "Join", do so. It will take a minute or two, maybe much longer, to transfer copies of your PC notes to the Device. When that is finished, use the PC's File Manger to close the connection to the Device. Unplug the USB cable. Restart Tomdroid, touch the Sync symbol and all your notes should start appearing in Tomdroid. Routine Sync Important that this process be followed at each sync. From within Tomdroid, touch the sync button, then close Tomdroid. Really close it ! Connect the Device to the PC with a USB cable. From within tomboy-ng, click Tomdroid Sync, it should identify your device as previously synced and suggest you hit the Sync button. Close the connection, unplug the USB cable, restart Tomdroid and touch the Sync symbol to complete the sync. If you also sync your tomboy-ng to other laptops or computers, it makes sense to do so before you do a Routine Tomdroid sync and then, again, immediately after. General Advice Tomdroid options and their effects. Clear Notes - Clear all notes from local database. If you use this option and then touch (Tomdroid's) sync, you'll get a fresh set of notes based on whats currently in the sync dir. Delete Remote Notes - Delete all notes from remote service. Careful with this one ! If you do this and then run a sync from tomboy-ng, all previously synced notes will be deleted (but, backed up first) from your tomboy-ng install. Almost certainly not what you want, so, please be careful. If you find your self in this position, run a Join rather than a Sync, a Join does not delete files so is always safe. Remember that tomboy-ng has some tools to help recover from misuse of above tools. If you want to start a whole new Tomdroid Sync, a reset, then clear both the above and then mount your phone, using the USB cable, and remove the 'tomboy.serverid' file from the phone/tomdroid directory. To be tidy, and assuming you don't sync with other andrid devices, you could also remove the ~/.config/tomboy-ng/android directory. Does it work with Windows or Mac ? No, not yet. But it probably will be far easier to make it work there than the old model. So, maybe. Feedback ? Can I sync my Phone with several computers ? No, each time you sync with a 'new' computer, you must do a 'Join', that will mean notes you previously deleted may be restored. Sync your computers with tomboy-ng's usual File Sync and chose one to be your gateway to your Android Devices. Can one computer connect to several Android Devices ? Yes, this will fine as long as you do it one at a time. You may need to repeat the first sync after a second one until no changes are reported. Other Matters. Joining v Syncing - These processes are similar except that we cannot use a local manifest during a Join. The local manifest contains data about deleted notes so running a Join instead of a Sync will resurrect notes deleted at one end or the other. Notebooks - Tomdroid does not understand notebooks. But a note edited in Tomdroid and synced back to tomboy-ng remembers what notebooks it was a member of. Tomdroid bugs and feature requests - No one is maintaining Tomdroid right now. All the source is there, want to try your hand ? Debugging - if you have a problem, first thing you should do is close tomboy-ng and restart it from command line, it may report some errors to console. Tick the 'Debug' box in the Tomdroid Sync Window before syncing. Please report what you find. Things yet to be done Firstly, the sync process can be quite slow due to the underlying MTP 'filesystem'. But you don't see any sort of progress report. A Windows version is possible. I believe it would be quite useful to have the Tomdroid sync only work with a special Tomdroid notebook. That way, you could limit the number of notes that appear on your Android device. If I get the impression that there is some interest in the Tomdroid sync, these matters might be looked at. One To One Sync Also currently built in (and seriously untested), is the ability to do a one to one sync, similar to the Tomdroid model, but using any arbitrary directory. Only the tomboy-ng part of this sync is dealt with here, if you use this, you must manage the notes appearing in that directory yourself. To set the directory that tomboy-ng uses you set an environment variable, TB_ONETOONE pointing to the directory you want to use before staring tomboy-ng. That directory must exist and be writable, if not used before, it will require a 'Join' and will be initialised as required. For example - $ TB_ONETOONE=/home/myname/MyOneSync tomboy-ng <enter> Start the sync using the Tomdroid menu item. Note, you cannot use both the Tomdroid USB connection and the One To One connection in the same tomboy-ng session but restarting tomoy-ng without the environment variable will restore normal Tomdroid USB behaviour. You can probably stop reading now. How it all works. The sync model here is another manifestation of the file sync used by tomboy-ng. This is the author's second attempt, the first one used ssh as a transport and while it works was far to complicated to use routinely. Firstly, when making an initial connection to Tomdroid, tomboy-ng stamps a unique ID on the device and keeps a copy in its config file. It also uses that ID as part of a local manifest file. If the IDs don't match, a normal sync cannot proceed. tomboy-ng (here and elsewhere) uses the last-change-date in every note to determine if two notes are in fact identical and don't need any syncing. I don't believe Tomboy does this and that explains why when re-joining a sync we sometimes ended up with a number of (invalid) clashes and duplicate notes. tomboy-ng should never exhibit this behaviour. As well as keeping track of revision numbers and last sync dates, the local manifest is important when a note from either end is deleted. It has two sections, the first, note-revisions, lists all notes that this client has seen in the sync repository. So, if the repository no longer has that note, we know its been deleted elsewhere and should be deleted locally. The second section, notes-deletions, lists every note, previously synced, deleted from this client. At sync time, such notes should be deleted from remote repo (and no longer listed in local manifest). Note that (I believe) tomboy-ng behaves differently from the original Tomboy in that Tomboy relied on comparing sync revision numbers whereas tomboy-ng also considers the last-change-date. Joining (or, more correctly Creating a Tomdroid Connection) First, we stamp a unique ID in sshdroid's home directory. Next, we record any notes in the remote directory (that is in the device) and then compare that list with the local notes. By definition, there is no local manifest in play so deletes don't happen. For each note we firstly check if there is a corresponding one at the other end. If their last-change-dates match, they are the same notes, do nothing. If they have different last-change-dates, then its a clash, we'll ask user to decide later. if a notes exists at one end or the other but not both, its either an upload or a download. Routine Sync First, we check the unique ID, if they don't match, do not proceed, suggest user either find correct profile or Join again. Next, we read the local manifest and then do pretty much as above but use the local manifest data to determine what needs to be deleted. In both cases, once we have a full view of what needs to happen, we do it. Firstly DownLoads, DoDeletes, Uploads, DeleteLocal, WriteLocalManifest. The Tomdroid interface is still quite fragile and not good at telling us where it hurts. 2021-01-31T22:05:59.2180841+11:00 2021-01-31T22:05:59.2180841+11:00 2000-01-01T10:00:00.0000000+11:00 1 1 1000 626 20 30 False tomboy-ng_0.34-1/doc/HELP/FR/recover.note0000664000175000017500000001157414145033507017567 0ustar dbannondbannon Recovering Lost Notes Recovering Lost Notes If you are reading this, odds are you are worried ! So, first bit of advice is don't panic (1) Its quite possible we can help you. That will depend on whats happened and maybe if you have taken a manual snapshot recently. Firstly, don't do a sync, it could replace good data with bad. Next, take small steps. Lets look at the possibilities - I (or the sync) deleted a note I need That just might be easy. We keep a backup copy of every note you manually delete or is overwritten during a sync. But only one copy so if its been synced and overwritten again, its gone. Check by going back to Settings, the Recover tab, click "Show Me", browse through the old notes there and double click a likely candidate. You'll get a dialog that lets you view, delete or recover that note. I have a corrupted note. When you start tomboy-ng, you see a warning about an inability to index a note. That probably means the note's XML has somehow become corrupted (2). The indexing mechanism in tomboy-ng is deliberately very strict in what it will accept, it errors if one field is unobtainable. However, depending on where the XML error in the note is, you may be able to open it and save it with rewritten XML. Do take a snapshot before you start this process. To try this quick fix, you should - From Settings, the Recover tab, click "Manual Snapshot" (to be safe!) then click "Recover lost notes". In this window, under "Bad Notes" is a list of just that. Double click a likely candidate and a new Edit window will open. You may have just recovered at least some content. You're not listening, I have lost all my notes ! OK, I get you, this is serious. But we at have two paths left, lets see - I sync my notes from somewhere else. Oh, that's good. Maybe all you need do is clean out your current notes directory (3) and rejoin the sync network. Note, I emphasise, not just do a sync. You MUST go to the sync tab and click "Set File Sync Repo". That way, the sync system sees you as a new friend and sends you a full set of notes. Just how good an approach this is depends on how recently you last synced, obviously any changes since last sync will be lost. I have a snapshot Great news ! You can easily choose to roll back to a particular snapshot and blow away all your troubles. Too Easy ! If you wisely kept the snapshot elsewhere, copy it to your snapshot directory (shown on the settings -> snapshots tab). From the SnapShot tab, click "Recover one or more lost Notes". If you have not already, now would be a great time to click "Safety Snapshot", you are in seriously dangerous space right now. Go to the "Recover Snapshot" tab, choose the snapshot you wish to use and away you go (4). Back out, go to the Search and click "Refresh". After you have checked all is good, please remember to take a snapshot every now and again ! Notes (1) By Douglas Adams, used without permission. (2) Corrupted notes should never happen, looks like it did. Power failure, program error, whatever. If its my fault, I am sincerely sorry ! Please report this experience to the Tomboy mailing list or Github. The only way I can rid of these problems is if people tell me about them. (3) Tomboy-ng tells you where your notes are stored, go there with a file manager and select all the note files. They are the ones with a 36 apparently random character name and ".note" extension. Only do this if you are a sync user ! (4) If you (wisely) keep a copy elsewhere, bring it back, un-encrypt it if necessary. And, good work ! 2020-11-17T20:33:16.2310674+11:00 2020-11-17T20:33:16.2310674+11:00 2018-08-26T14:03:28.1020000+10:00 1 1 1061 626 76 243 False tomboy-ng_0.34-1/doc/HELP/FR/key-shortcuts.note0000664000175000017500000001366714145033507020753 0ustar dbannondbannon tomboy-ng Keyboard Shortcuts tomboy-ng Keyboard Shortcuts All Platforms Alt-RightArrow : Turn a bullet point on. Alt-LeftArrow : Turn a bullet point off. Control-1 : Small Font Control-2 : normal font Control-3 : large font Control-4 : huge font Shift-RightArrow - extend selection one char to right Shift-LeftArrow - extend selection one char to left Shift-Click : Select text between existing position and clicked position. Windows / Linux Control-Q : Quit tomboy-ng - On Search, Settings and any Open Note Control-N : New Note - On Search, Settings and any Open Note Control-X : Cut the selected text and copy it to the Clipboard. Control-C : Copy the selected text to the Clipboard. Control-V : Paste the contents of the Clipboard into the current note. Control-A : Select All items. Control-RightArrow : move word to the right. Control-LeftArrow : move word to the left. Control-Shift-LeftArrow - extend selection one word to left Control-Shift-RightArrow - extend selection one word to right Control-F4 : Close current note window. Control-Z : Undo Control-Y : Redo Control-D : Insert date time string, YYYY-MM-DD hh:mm:ss Control-L : Create a link note from selected text. Alt - F4 : Close current note window Fonts Control-B : Bold Control-I : Italics Control-S : Strikeout Control-U : Underline Control-H : Highlight Control-E : Expression calculator - see Calculator help note Find (in a note) Control-F : Find something in a Note. F3 or Ctrl-G : Next in note Find Shift-F3 or Shift-Ctrl-G : Previous in note Find Mac (Where Option key is also the Alt key) Command-Q : Quit tomboy-ng - On Search, Settings and any Open Note Command-N : New Note - On Search, Settings and any Open Note Command-X : Cut the selected text and copy it to the Clipboard. Command-C : Copy the selected text to the Clipboard. Command-V : Paste the contents of the Clipboard into the current note. Command-A : Select All items. Command-F : Open a Find window. Command-RightArrow : go to end of line. Command-LeftArrow : go to start of line. Command-Z : Undo Command-Y : Redo Command-D : Insert date time string, YYYY-MM-DD hh:mm:ss Option-Shift-LeftArrow - extend selection one word to left Option-Shift-RightArrow - extend selection one word to right Fonts Command-B : Bold Command-I : Italics Command-S : Strikeout Command-U : Underline Command-E : Expression calculator - see Calculator help note Option-H : Highlight Find (in a note) Command-F : Find something in a Note. Command-G : Next in note Find Shift-Command-G : Previous in note Find 2021-06-17T13:20:22.4828983+10:00 2021-06-17T13:20:22.4828983+10:00 2018-12-06T21:38:38.0650000+11:00 1 1 1000 626 587 163 False tomboy-ng_0.34-1/doc/HELP/EN/0000755000175000017500000000000014145033507015214 5ustar dbannondbannontomboy-ng_0.34-1/doc/HELP/EN/calculator.note0000664000175000017500000000671614145033507020250 0ustar dbannondbannon tomboy-ng Calculator tomboy-ng Calculator Versions of tomboy-ng after V0.20 include an expression calculator. It has three basic modes, all activated by pressing Ctrl-E (or Cmd-E on the Mac) - Simple Calc Mode, you type for example, 6+10= and press Ctrl-E, tomboy-ng will fill in '16' after the equals sign. This will work with any basic numerical calculations, (5*7)/(8.3+12)-0.724=1.000 In this mode, you can use numerals, curved brackets, decimal points and the basic operators, + - / * and ^ (ie power). Complex Calc Mode, if you need to use, say trig functions, the Simple Calc won't find your full expression. So, type the expression, select it and, again, press Ctrl-E. Similar result. In this mode you can use the above mentioned plus pi cos sin tan arctan abs sqr sqrt exp ln log frac int round and trunc. eg sin(0.5)^2 + cos(0.5)^2 =1 Column Mode, will add up a column of numbers in the lines above it. 'A column', in this case means all the numbers that appear at either the beginning of the lines or end of the lines. If there are numbers at both beginning and end of lines, the longer column takes precedence. If we have the same number of entries at either end, the left or beginning column takes precedence. The first line encounted that does not have a number at the appropriate end stops the column count. Remember a number on a line by itself can be considered to be at both the beginning and end of the line. You can stop a number being considered by 'hiding' it with an alpha char and, then remove that character after doing the calc. Only numerals and the decimal point are allowed in this mode. Home to Axedale 5.5 Axedale to Bendigo 19 Bendigo to home via O'Briens Road 23 round trip is 47.500 5 some text 7 1 more text 3 blah 4 9 In the above example, the left column is used, it has three eligible numbers, the right column only has one, the '4', there is no number at the end of the "1 more text" line. some text 7 1 more text 4 3 14 In above example, the parser has chosen to work with the numbers at the end of the line because that list has more entries. 7+4+3=14 note that the '3' can be used by both a beginning and end column. The expression parser converts to using floating point numbers where necessary and displays its output with 3 digits after the decimal point. The internal calculations are done at a much higher precision however. Note in the examples above, I have manually bolded the answers for clarity, it does not happen automatically. 2021-07-11T17:28:34.3098611+10:00 2021-07-11T17:28:34.3098611+10:00 2019-01-15T21:32:06.9620000+11:00 1 1 1000 626 20 29 False tomboy-ng_0.34-1/doc/HELP/EN/tomboy-ng.note0000664000175000017500000001707314145033507020030 0ustar dbannondbannon tomboy-ng help tomboy-ng help Tomboy-ng is a rewrite of the much loved Tomboy Notes. It runs on Linux, Windows and MacOS. Is file compatible with Tomdroid and (?) GNote. Tomboy-ng notes support Bold, Italic, Strike-through, Highlight and Underline in four sizes, small, normal, large and huge. It can sync notes with other systems using Tomboy's File Sync model (but not yet Network Sync using Rainy or Graphal). There is a one to one sync capability to an Android phone running Tomdroid (but only from a Linux box). Many users will want to have tomboy-ng start at logon time, it will put an Icon in the System Tray and you can interact with it via that Icon. However, to ensure we support some difficult platforms, a small window or splash screen is also opened, it can be dismissed if you see the system tray icon (or on some Gnome 3 systems, you have added it to your dock as a favourite). You can set that small splash screen to not open unless a bad note is detected at startup. Using tomboy-ng You will interact with tomboy-ng using a menu on a System Tray Icon (only some systems) or from a menu that appears on all major forms of the application. If you don't have a System Tray Icon (that's sad!) you add tomboy-ng to your Favourites so it appears on your dock, that way, you can always either start it or wake up its Search Form easily. From the search form, you can - Access the main menu (New Note, Settings, recent notes etc). Search for terms in all your notes. A search term like "John Smith" name will find all notes that use the word name anywhere and have exactly that combination of John Smith. It won't, for example find my name is Smith, John. Organise your notes into Notebooks, tomboy-ng will allow each note to be in more than one Notebook but if you sync or share your notes with the original Tomboy, don't turn that feature on. Rename a notebook, but if you sync your notes, do run a full sync first ! Note that search results shown on the search form may not be automatically updated while the form remains open unless 'Auto Refresh' is ticked. That's to ensure that a set of results don't change while you deal with individual notes. If a change is pending, the 'Refresh Button' becomes enabled and you can trigger an update by clicking that button. Generally tomboy-ng - notes are automatically saved as you make changes. allows you to change a notes's title by directly editing the actual title in the note window. automatically makes backup copies when you delete a note, if you need to know a note is really gone, go to Settings->Backup. has facilities to make snapshots of your notes from time to time, please use it! can sync your notes to a common file store so they are accessible from multiple machines (Linux, Windows or Mac). does not share well. If you just put your notes on a shared drive (without using sync) be desperately careful that you don't have more than one tomboy-ng or Tomboy running at the same time. Bad things happen. Command Line Switches. -h or --help Show help and exit. --delay-start Insert a few seconds at startup to ensure that tomboy-ng picks up your colour scheme. -l CCode --lang=CCode Force Language, supported language codes as es and nl. Let us know if you want tomboy-ng in another language. --version Print version and exit --no-splash Don't show small status/splash window. Saves you from having to dismiss it at startup. Don't use unless you have checked you can see the small green system tray icon. --config-dir=PATH_to_DIR Create or use an alternative config. Mainly a testing feature but useful if you want to have two (or more) sets of independent (but not concurrent) notes for example. --open-note=PATH_to_NOTE Open a note in single note mode. In this mode, a separate process runs, it does not have access to the normal notes location, nor sync but can read, display and write back to a stand alone note. If the note name does not exist, a new note is created. If the note name specifies a plain text file or a rtf file, the contents of that file will be imported into a new note and that note will be named as specified on the command line but with an extension of ".note". In this mode, the note remains in its existing location, it is not moved to the tomboy-ng notes location, it is not synced, nor searched by tomboy-ng in its normal mode. Note that the switch (-o or --open-note) is optional, "tomboy-ng some.note" will works as well. --save-exit Works only with the single note mode, will import (.note, .rtf, plain text) the file, convert to .note format (and note standard filename format) and save in the configured notes directory. Note that tomboy-ng will require a restart after this happens. --debug-sync --debug-index ---debug-spell Show what is happening during either sync, index or spell. Useful for debugging. They will write detailed progress reports relating to their section of the application to the console. However, Windows does not, for this purpose, have a console. But it can be told to capture this log info to a file using another command line switch or by setting an env variable that specifies a file name. Please ensure you have permission to write to the location specified. For example, from the start button, click run and type - tomboy-ng --debug-log=c:\debug.txt --debug-sync Mac Things Mac user require a slightly more complicated command line when using any of these command line switches. For example a Mac command line to generate a sync debug log would be - open tomboy-ng.app --args "--debug-log=$HOME/tomboy-ng.log" "--debug-sync" And, because of the .app approach, absolute paths need be used for parameters, or, use $PWD relative to your current directory - open tomboy-ng/tomboy-ng.app --args "-o" "$PWD/doc/tomboy-ng.note" 2021-07-18T20:32:32.9701970+10:00 2021-07-18T20:32:32.9701970+10:00 2018-11-07T16:01:06.6550000+11:00 1 1 1000 626 20 30 False tomboy-ng_0.34-1/doc/HELP/EN/sync-ng.note0000664000175000017500000001755614145033507017501 0ustar dbannondbannon tomboy-ng sync tomboy-ng sync This is about file syncing between Linux, Windows and Mac computers. See a separate document that talks about syncing to Tomdroid. If you are interested in Github sync, providing both Sync and a access to your notes online from a browser, please see https://github.com/tomboy-notes/tomboy-ng/wiki/Github-Sync Synchronising your tomboy-ng (and/or Tomboy) notes can be a very useful thing. Do it properly and all your notes on all your computers are the same. And you have a backup strategy for your note too ! Remember that the value of syncing is closely related to how often you do it ! tomboy-ng supports file sync. That is, it syncs to a shared file system. That filesystem might be Google Drive, any remote server you can ssh to, a local shared drive at home or even just a USB thumb drive. It works identically between the three supported platforms, Linux, Windows and Mac. Note that tomboy-ng does not (like Tomboy does) connect to a dedicated Tomboy sync service such as Snowy, Rainy or grauphel/NextCloud/Apache. New in v0.27, Auto sync, see further down. OK, before we start, are you keeping snapshots ? If not, why not ??? A shared Filesystem In practise, tomboy-ng will sync to any (?) file system that your file manager can browse. You could use Google Drive, Drop Box or any such system. Don't forget a copy of your notes will live on their server so if you are unhappy at them being read there, maybe that not a great idea! You may want to setup a NFS or SMB share. Windows and NFS is not a great mix but SMB works well for all three platforms. The author's home network router has a USB slot at the back, a USB Disk Key plugged in there is distributed via SMB. Been working flawlessly for a couple of years. Some Linux File Managers can be reluctant to show you the SMB or Samba shares, it can help to make them a book mark in your main File Manager but if even that does not work, ensure you have gvfs and gvfs-fuse installed and browse using the directory dialog that tomboy-ng pops up to somewhere like /run/user/1000/gvfs/smb_share ..... Or you could even just use a USB Disk Key and plug it into which ever machine you are syncing at the time. As long as tomboy-ng can read and write there, good. One thing to note, if you plan to sync both Tomboy and tomboy-ng with the same repository, Tomboy is not quite so happy with "any shared filesystem", check it before investing too much time. Setting Up A Repository Easy, might be a good idea to create a directory there such as Tomboy-Sync or whatever, tomboy-ng (or Tomboy) just needs be told where the filesystem is and it will do the rest. In tomboy-ng, click Settings, Sync Tab, click "Change File Sync Repo". Browse to the directory you created. tomboy-ng will have a look at the directory and your existing notes (if any) and will generate a report about what it will do. If that looks OK, click "Save and Sync". Done. sshfs to do network sync tomboy-ng can sync quite happily to any remote server that you have ssh access to. The author has a cut price hosting plan with a much neglected website and a few gig of diskspace. Its useful because I can ssh into it ! So, if I can ssh to it, I can use sshfs with it. For example, on a linux machine, I would install sshfs then, initially ssh to this remote server and create a directory called eg TB_Sync, then back on my local machine- cd; mkdir TB_Sync; sshfs myname@remoteserver.com:TB_Sync TB_Sync [enter] Fire up tomboy-ng and set its sync repo to ~/TB_Sync and its done. Disconnect that shared directory with - fusermount -uz TB_Sync [enter] And reconnect later on, to sync again, with sshfs myname@remoteserver.com TB_SYNC [enter] Manual Syncing and Clashes From time to time, you need to click the Sync menu entry. A short report will pop up telling what it has done, have a look and close. However, there will almost certainly come a time when you have changed a particular note on more than one machine since your last Sync. Sad but inevitable. Now, the Sync engine does not know what to do. It will show you a list of the differences between the two notes and you can choose to use the Local or Remote version. Remote being the 'remote' file repository. If, even after seeing the differences between the two versions, you still cannot decide, then perhaps you should chose to use the remote. The local one will then be backed up and you can recover it from Settings->Backup. Note, when resolving clashes, there are also several "do all" buttons that will be applied to the remainder of this sync run. Remote, Local, newest, oldest, if you feel brave, click one. Automatic Syncing New on v0.27, tomboy-ng does automatic, behind the scenes syncing. Obviously only if you have setup sync and the necessary shared file system is available. Settings->Sync and tick the box. It will sync about 15 seconds after startup and then hourly. If it encounters a note clash, the usual window will still popup showing the differences between the two notes allowing you to decide. If it cannot sync, because, perhaps, you have disconnected the shared drive, again a popup windows will advise you, you can either fix the problem and press Retry or, if you press Cancel, syncing will not be attempted again until you either restart tomboy-ng or 'bounce' the Auto Sync setting. If you are like me and need constant reassurance that things are working, you can see details of most recent sync in the Search Window's status bar. Rejoining a Repository Tomboy would struggle when you had occasion to re-join a repo you have used in the past. It would spot a whole lot of notes with the same ID but not have the repository data to know how to handle them, they would all be labelled as clashes. To solve this, tomboy-ng looks at the last change date, accurate to the micro second and decides that two notes with the same ID and the same last change date should be assumed to be identical. Its a pretty good bet. Now, this process can be a bit slow so we keep additional data in the remote manifest. However, if you use Tomboy in the same repo, it will drop that extra data and re-joining a repo will be slow. Not usually a problem ... When Something Goes Wrong. Honestly, I have tested the new sync engine to death. But we all know the problem with developers testing their own code. So, yep, it might all go wrong ! Firstly, are you keeping snapshots ? If not, why not ??? Secondly, please try starting tomboy-ng from the command line. While its running, anything it does not like is reported to your console. If that does not show you anything revealing, try stopping and adding --debug-sync to the command line. If you have a problem, please report it to either github or the Tomboy mailing list, we really want to know ! 2021-11-11T16:07:10.4508768+11:00 2021-11-11T16:07:10.4508768+11:00 2000-01-01T10:00:00.0000000+11:00 1 1 1000 626 806 221 False tomboy-ng_0.34-1/doc/HELP/EN/systray.note0000664000175000017500000000335114145033507017625 0ustar dbannondbannon System Tray on Linux System Tray on Linux The normal way that a user interacts with tomboy-ng is via a small yellow icon that appears on the System Tray, sometimes called the Notification Area. However, not all Linux Desktop Environments are able to display System Tray Icons, and some that can may not do so by default. If you can see a small, yellow icon, probably on the main panel on your screen, you don't have a problem. If you cannot see it, you are probably using a Desktop that has issues displaying the System Tray, possibly a Gnome Desktop. Detailed and hopefully current information on the latest 'tricks' to display a System Tray on recalcitrant systems and even how to use tomboy-ng without a System Tray can be found at https://github.com/tomboy-notes/tomboy-ng/wiki/System-Tray-on-Linux Support for System Tray on Linux changes quite abruptly sometimes so its often worth considering a newer version of tomboy-ng, https://github.com/tomboy-notes/tomboy-ng 2021-07-20T12:45:17.2379614+10:00 2021-07-20T12:45:17.2379614+10:00 2021-01-23T13:48:35.2369237+11:00 1 1 1227 610 108 195 False tomboy-ng_0.34-1/doc/HELP/EN/tomdroid.note0000664000175000017500000003253714145033507017740 0ustar dbannondbannon Tomdroid Sync Tomdroid Sync New in V0.32, Cable based connection between PC and Android Device ! No profiles, passwords or ssh needed. Welcome to tomboy-ng's take on Tomdroid. Please be aware that its an experimental feature in tomboy-ng and its heavily dependent on what Tomdroid itself does. However, the author has been routinely using this model for a couple of month now on several different Android devices and so far it seems functional. He would greatly like to hear your experiences. But note that sync with Tomdroid is slow process, and tomboy-ng does not, yet report on its progress. The first sync with a large repository can be quite unnerving. If you have more than several hundred notes, you may be better waiting for a future next release of tomboy-ng, it will allow sync with only notes in a particular notebook. Background As a standalone app, Tomdroid works well enough but when synced to your notes on a PC or Laptop, it really shines. Tomdroid was built back in the Tomboy family's glory days. It worked fine doing a network sync with the Ubuntu One cloud service (although that may have been before we used that term). However, that service was withdrawn and Tomdroid network users needed to provide their own Sync facilities. That means either running a Rainy server at home or setting up a grauphel system. Neither is a trivial exercise. However, tomboy-ng does not do network sync. Tomboy-ng does do a file based sync where a shared file service is visible to all parties. Its quick and relatively simple but Tomdroid cannot be a direct part of such a system. This Solution tomboy-ng, as of release V0.32 can do a one to one file sync between Tomdroid and a Linux Box using a USB Cable. The Linux box may, or may not be part of a File Sync group. You can establish as many of these one to one connections as you have Tomdroid capable devices. Whats needed A Linux pc, laptop or what ever running tomboy-ng. One or more Android devices (phone, tablets etc) with Tomdroid installed, probably from the PlayStore. A normal USB cable to connect them together. First Time SetUp Assuming you already have notes in your tomboy-ng and a fresh install of Tomdroid, you should - Fire up Tomdroid on the device. Touch the Menu (top right), select Settings and find the Synchronization block. Check that Service is set to SD Card (note you don't need an external SDCard, Android directs that to some internal space) and that Location on SD Card is set to /storage/emulated/0/tomdroid/. Close the Settings screen and touch the Sync symbol on the menu bar. Assuming you have no Tomdroid notes at this stage, it will be quite quick. IMPORTANT - close Tomdroid down now. Android uses a lot of disk caching and we must be sure that it has actually hit the 'disk'. It is vital that you close Tomdroid, not just background it. Sync will occasionally fail otherwise. Now, use the cable to connect the PC to a Android Device. The device will ask you to allow access from the PC to its files. On your Linux box, go to tomboy-ng's Settings, Basic Tab, and tick Show Tomdroid Sync. Note it is experimental. Now, you should either run a normal (that is, not Tomdroid) sync or take a snapshot, or, better still, both ! Snapshots are easy, Settings, Recover Tab, click Take a Manual Snapshot. Too Easy ! The Main Menu will now have a "Tomdroid" entry. Click it ! The next screen will try and find your Android Device, in particular the directory containing the Tomdroid Sync Files. If all is well, it will suggest you click "Join", do so. It will take a minute or two, maybe much longer, to transfer copies of your PC notes to the Device. When that is finished, use the PC's File Manger to close the connection to the Device. Unplug the USB cable. Restart Tomdroid, touch the Sync symbol and all your notes should start appearing in Tomdroid. Routine Sync Important that this process be followed at each sync. From within Tomdroid, touch the sync button, then close Tomdroid. Really close it ! Connect the Device to the PC with a USB cable. From within tomboy-ng, click Tomdroid Sync, it should identify your device as previously synced and suggest you hit the Sync button. Close the connection, unplug the USB cable, restart Tomdroid and touch the Sync symbol to complete the sync. If you also sync your tomboy-ng to other laptops or computers, it makes sense to do so before you do a Routine Tomdroid sync and then, again, immediately after. General Advice Tomdroid options and their effects. Clear Notes - Clear all notes from local database. If you use this option and then touch (Tomdroid's) sync, you'll get a fresh set of notes based on whats currently in the sync dir. Delete Remote Notes - Delete all notes from remote service. Careful with this one ! If you do this and then run a sync from tomboy-ng, all previously synced notes will be deleted (but, backed up first) from your tomboy-ng install. Almost certainly not what you want, so, please be careful. If you find your self in this position, run a Join rather than a Sync, a Join does not delete files so is always safe. Remember that tomboy-ng has some tools to help recover from misuse of above tools. If you want to start a whole new Tomdroid Sync, a reset, then clear both the above and then mount your phone, using the USB cable, and remove the 'tomboy.serverid' file from the phone/tomdroid directory. To be tidy, and assuming you don't sync with other andrid devices, you could also remove the ~/.config/tomboy-ng/android directory. Does it work with Windows or Mac ? No, not yet. But it probably will be far easier to make it work there than the old model. So, maybe. Feedback ? Can I sync my Phone with several computers ? No, each time you sync with a 'new' computer, you must do a 'Join', that will mean notes you previously deleted may be restored. Sync your computers with tomboy-ng's usual File Sync and chose one to be your gateway to your Android Devices. Can one computer connect to several Android Devices ? Yes, this will fine as long as you do it one at a time. You may need to repeat the first sync after a second one until no changes are reported. Other Matters. Joining v Syncing - These processes are similar except that we cannot use a local manifest during a Join. The local manifest contains data about deleted notes so running a Join instead of a Sync will resurrect notes deleted at one end or the other. Notebooks - Tomdroid does not understand notebooks. But a note edited in Tomdroid and synced back to tomboy-ng remembers what notebooks it was a member of. Tomdroid bugs and feature requests - No one is maintaining Tomdroid right now. All the source is there, want to try your hand ? Debugging - if you have a problem, first thing you should do is close tomboy-ng and restart it from command line, it may report some errors to console. Tick the 'Debug' box in the Tomdroid Sync Window before syncing. Please report what you find. Things yet to be done Firstly, the sync process can be quite slow due to the underlying MTP 'filesystem'. But you don't see any sort of progress report. A Windows version is possible. I believe it would be quite useful to have the Tomdroid sync only work with a special Tomdroid notebook. That way, you could limit the number of notes that appear on your Android device. If I get the impression that there is some interest in the Tomdroid sync, these matters might be looked at. One To One Sync Also currently built in (and seriously untested), is the ability to do a one to one sync, similar to the Tomdroid model, but using any arbitrary directory. Only the tomboy-ng part of this sync is dealt with here, if you use this, you must manage the notes appearing in that directory yourself. To set the directory that tomboy-ng uses you set an environment variable, TB_ONETOONE pointing to the directory you want to use before staring tomboy-ng. That directory must exist and be writable, if not used before, it will require a 'Join' and will be initialised as required. For example - $ TB_ONETOONE=/home/myname/MyOneSync tomboy-ng <enter> Start the sync using the Tomdroid menu item. Note, you cannot use both the Tomdroid USB connection and the One To One connection in the same tomboy-ng session but restarting tomoy-ng without the environment variable will restore normal Tomdroid USB behaviour. You can probably stop reading now. How it all works. The sync model here is another manifestation of the file sync used by tomboy-ng. This is the author's second attempt, the first one used ssh as a transport and while it works was far to complicated to use routinely. Firstly, when making an initial connection to Tomdroid, tomboy-ng stamps a unique ID on the device and keeps a copy in its config file. It also uses that ID as part of a local manifest file. If the IDs don't match, a normal sync cannot proceed. tomboy-ng (here and elsewhere) uses the last-change-date in every note to determine if two notes are in fact identical and don't need any syncing. I don't believe Tomboy does this and that explains why when re-joining a sync we sometimes ended up with a number of (invalid) clashes and duplicate notes. tomboy-ng should never exhibit this behaviour. As well as keeping track of revision numbers and last sync dates, the local manifest is important when a note from either end is deleted. It has two sections, the first, note-revisions, lists all notes that this client has seen in the sync repository. So, if the repository no longer has that note, we know its been deleted elsewhere and should be deleted locally. The second section, notes-deletions, lists every note, previously synced, deleted from this client. At sync time, such notes should be deleted from remote repo (and no longer listed in local manifest). Note that (I believe) tomboy-ng behaves differently from the original Tomboy in that Tomboy relied on comparing sync revision numbers whereas tomboy-ng also considers the last-change-date. Joining (or, more correctly Creating a Tomdroid Connection) First, we stamp a unique ID in sshdroid's home directory. Next, we record any notes in the remote directory (that is in the device) and then compare that list with the local notes. By definition, there is no local manifest in play so deletes don't happen. For each note we firstly check if there is a corresponding one at the other end. If their last-change-dates match, they are the same notes, do nothing. If they have different last-change-dates, then its a clash, we'll ask user to decide later. if a notes exists at one end or the other but not both, its either an upload or a download. Routine Sync First, we check the unique ID, if they don't match, do not proceed, suggest user either find correct profile or Join again. Next, we read the local manifest and then do pretty much as above but use the local manifest data to determine what needs to be deleted. In both cases, once we have a full view of what needs to happen, we do it. Firstly DownLoads, DoDeletes, Uploads, DeleteLocal, WriteLocalManifest. The Tomdroid interface is still quite fragile and not good at telling us where it hurts. 2021-07-21T10:25:01.2798005+10:00 2021-07-21T10:25:01.2798005+10:00 2000-01-01T10:00:00.0000000+11:00 1 1 1000 626 20 30 False tomboy-ng_0.34-1/doc/HELP/EN/recover.note0000664000175000017500000001161614145033507017557 0ustar dbannondbannon Recovering Lost Notes Recovering Lost Notes If you are reading this, odds are you are worried ! So, first bit of advice is don't panic (1) Its quite possible we can help you. That will depend on what has happened and maybe if you have taken a manual snapshot recently. Firstly, don't do a sync, it could replace good data with bad. Next, take small steps. Let's look at the possibilities - I (or the sync) deleted a note I need That just might be easy. We keep a backup copy of every note you manually delete or is overwritten during a sync. But only one copy so if its been synced and overwritten again, it is gone. Check by going back to Settings, the Recover tab, click "Show Me", browse through the old notes there and double click a likely candidate. You'll get a dialog that lets you view, delete or recover that note. I have a corrupted note. When you start tomboy-ng, you see a warning about an inability to index a note. That probably means the note's XML has somehow become corrupted (2). The indexing mechanism in tomboy-ng is deliberately very strict in what it will accept, it errors if one field is unobtainable. However, depending on where the XML error in the note is, you may be able to open it and save it with rewritten XML. Do take a snapshot before you start this process. To try this quick fix, you should - From Settings, the Recover tab, click "Manual Snapshot" (to be safe!) then click "Recover lost notes". In this window, under "Bad Notes" is a list of just that. Double click a likely candidate and a new Edit window will open. You may have just recovered at least some content. You're not listening, I have lost all my notes ! OK, I get you, this is serious. But we at have two paths left, lets see - I sync my notes from somewhere else. Oh, that's good. Maybe all you need do is clean out your current notes directory (3) and rejoin the sync network. Note, I emphasise, not just do a sync. You MUST go to the sync tab and click "Set File Sync Repo". That way, the sync system sees you as a new friend and sends you a full set of notes. Just how good an approach this is depends on how recently you last synced, obviously any changes since last sync will be lost. I have a snapshot Great news ! You can easily choose to roll back to a particular snapshot and blow away all your troubles. Too Easy ! If you wisely kept the snapshot elsewhere, copy it to your snapshot directory (shown on the Settings -> Recover tab). From the Recover tab, click "Recover lost Notes". If you have not already, now would be a great time to click "Take a Manual Snapshot", you are in seriously dangerous space right now. Go to the "Recover Snapshot" tab, choose the snapshot you wish to use and away you go (4). Back out, go to the Search and click "Refresh". After you have checked all is good, please remember to take a snapshot every now and again ! Notes (1) By Douglas Adams, used without permission. (2) Corrupted notes should never happen, looks like it did. Power failure, program error, whatever. If its my fault, I am sincerely sorry ! Please report this experience to the Tomboy mailing list or Github. The only way I can rid of these problems is if people tell me about them. (3) Tomboy-ng tells you where your notes are stored, go there with a file manager and select all the note files. They are the ones with a 36 apparently random character name and ".note" extension. Only do this if you are a sync user ! (4) If you (wisely) keep a copy elsewhere, bring it back, decrypt it if necessary. And, good work ! 2021-07-21T10:31:32.6130010+10:00 2021-07-21T10:31:32.6130010+10:00 2018-08-26T14:03:28.1020000+10:00 1 1 1061 626 22 246 False tomboy-ng_0.34-1/doc/HELP/EN/key-shortcuts.note0000664000175000017500000001353214145033507020735 0ustar dbannondbannon tomboy-ng Keyboard Shortcuts tomboy-ng Keyboard Shortcuts All Platforms Alt-RightArrow : Turn a bullet point on Alt-LeftArrow : Turn a bullet point off Control-1 : Small Font Control-2 : normal font Control-3 : large font Control-4 : huge font Shift-RightArrow : extend selection one char to right Shift-LeftArrow : extend selection one char to left Shift-Click : Select text between existing position and clicked position Windows / Linux Control-Q : Quit tomboy-ng - On Search, Settings and any Open Note Control-N : New Note - On Search, Settings and any Open Note Control-X : Cut the selected text and copy it to the Clipboard Control-C : Copy the selected text to the Clipboard. Control-V : Paste the contents of the Clipboard into the current note Control-A : Select All items. Control-RightArrow : move cursor to the word to the right Control-LeftArrow : move cursor to word to the left Control-Shift-LeftArrow : extend selection one word to left Control-Shift-RightArrow : extend selection one word to right Control-Z : Undo Control-Y : Redo Control-F4 : Close current note window Control-D : Insert date time string, YYYY-MM-DD hh:mm:ss Control-L : Create a link note from selected text Alt-F4 : Close current note window (not all Linux desktops allow this) Fonts Control-B : Bold Control-I : Italics Control-S : Strikeout Control-U : Underline Control-H : Highlight Control-E : Expression calculator - see Calculator help note Find (in a note) Control-F : Find something in a Note F3 or Ctrl-G : Next in-note Find Shift-F3 or Shift-Ctrl-G : Previous in-note Find Mac Command-Q : Quit tomboy-ng - On Search, Settings and any Open Note Command-N : New Note - On Search, Settings and any Open Note Command-X : Cut the selected text and copy it to the Clipboard Command-C : Copy the selected text to the Clipboard Command-V : Paste the contents of the Clipboard into the current note Command-A : Select All items Command-RightArrow : go to end of line Command-LeftArrow : go to start of line Command-Z : Undo Command-Y : Redo Command-D : Insert date time string, YYYY-MM-DD hh:mm:ss Option-Shift-LeftArrow : extend selection one word to left Option-Shift-RightArrow : extend selection one word to right Fonts Command-B : Bold Command-I : Italics Command-S : Strikeout Command-U : Underline Command-E : Expression calculator - see Calculator help note Option-H : Highlight Find (in a note) Command-F : Find something in a Note Command-G : Next in-note Find Shift-Command-G : Previous in-note Find 2021-07-18T17:54:48.9998904+10:00 2021-07-18T17:54:48.9998904+10:00 2018-12-06T21:38:38.0650000+11:00 1 1 1000 626 142 95 False tomboy-ng_0.34-1/doc/authors0000644000175000017500000000165714145033507015603 0ustar dbannondbannonAuthors ======= tomboy-ng is built using - The Free Pascal Compiler and Lazarus, http://wiki.freepascal.org KControls - http://www.tkweb.eu/en/delphicomp/kcontrols.html, https://github.com/kryslt/KControls Much thanks due to the authors and developers of the above. Thanks are also due to the many people involved with the FPC/Lazarus Forum without who's help and patience this project would not have every got off the ground. The user interface and design of Tomboy, indeed, the very idea, is a product of the origional Tomboy authors, see - https://wiki.gnome.org/Apps/Tomboy tomboy-ng is primarily written by David Bannon, tomboy-ng@bannons.id.au Significent contributions made by Benjamin Brandall - me@benj.email Icons by XYPD, xypd.com Translations by Roy Reese (much gramatical work and Spanish), Francois Edelin (French) and Heimen Stoffels (Dutch). Libnotify unit by Ido Kanner, https://github.com/ik5/libnotify-fpc tomboy-ng_0.34-1/doc/overrides0000644000175000017500000000057714145033507016120 0ustar dbannondbannon# This is the Lintian override file for the tomboy-ng binary. # It ultimatly lives in /usr/share/lintian/overrides # and is called tomboy-ng there. # # tomboy-ng is built using the fpc, not gcc. So use of CPPFLAGS # is not possible. PIE, Read-only relocations and Immediate bindings # are enabled but Fortify Source functions is not. tomboy-ng binary: hardening-no-fortify-functions tomboy-ng_0.34-1/Makefile0000644000175000017500000000522114145033507015055 0ustar dbannondbannon # A makefile specificially to assist with making a SRC Deb for tomboy. # Might work to install as a src tarball but its not regularly tested for this. # # copyright David Bannon, 2020, use as you see fit, but retain this statement. # https://www.gnu.org/software/make/manual/html_node/index.html # Some not surprising template stuff PREFIX = /usr BIN_DIR = $(PREFIX)/bin PROGRAM_NAME=tomboy-ng MAN_DIR = $(PREFIX)/share/man/man1 SHARE_DIR = $(PREFIX)/share DOC_DIR = $(SHARE_DIR)/$(PROGRAM_NAME) # ---- Help Notes, it just replicates existing dir/note structure. HELP_DIR = $(DOC_DIR)/HELP RM = rm -f RMDIR = rm -Rf MKDIR = mkdir -p OUTFILES = ../*.deb ../*.build ../*.xz ../*.dsc ../*.buildinfo ../*.changes CLEANDIR = kcontrols/packages/kcontrols/lib source/lib INSTALL = install INSTALL_PROGRAM = $(INSTALL) -c -m 0755 INSTALL_DATA = $(INSTALL) -c -m 0644 CP = cp -R # ----- Language translation files, just add 2 letter code here ----- LANGUAGES = es fr nl MKDIRLANG = test -d $(DESTDIR)$(SHARE_DIR)/locale/$(LANG)/LC_MESSAGES || $(MKDIR) $(DESTDIR)$(SHARE_DIR)/locale/$(LANG)/LC_MESSAGES CPLANG = msgfmt -o $(DESTDIR)$(SHARE_DIR)/locale/$(LANG)/LC_MESSAGES/tomboy-ng.mo po/tomboy-ng.$(LANG).po tomboy-ngx86_64: bash ./buildit.bash $(info ========== We have compiled [${PROGRAM_NAME}]) # $(info ========== $$BIN_DIR is [${BIN_DIR}]) clean: rm -Rf debian/tomboy-ng $(RM) debian/debhelper-build-stamp $(RM) debian/tomboy-ng.substvars $(RMDIR) $(CLEANDIR) $(RM) $(OUTFILES) $(RM) source/Tomboy_NG source/tomboy-ng $(RM) kcontrols/package/kcontrols/KControls.log # clean is pretty useless here, any change to tree upsets debuild and apparently # kcontrols changes some src file during package build. So, refresh ! install: installdirs $(info ========== Installing ....) $(INSTALL_PROGRAM) source/tomboy-ng $(DESTDIR)$(BIN_DIR)/$(PROGRAM_NAME) $(INSTALL_DATA) doc/tomboy-ng.1 $(DESTDIR)$(MAN_DIR)/$(PROGRAM_NAME).1 $(CP) doc/HELP $(DESTDIR)$(HELP_DIR)/ $(CP) doc/overrides $(DESTDIR)$(SHARE_DIR)/lintian/overrides/tomboy-ng $(CP) glyphs/icons $(DESTDIR)$(SHARE_DIR)/ $(INSTALL_DATA) glyphs/tomboy-ng.desktop $(DESTDIR)$(SHARE_DIR)/applications/tomboy-ng.desktop $(foreach LANG, $(LANGUAGES), $(CPLANG);) installdirs: test -d $(DESTDIR)$(BIN_DIR) || $(MKDIR) $(DESTDIR)$(BIN_DIR) test -d $(DESTDIR)$(MAN_DIR) || $(MKDIR) $(DESTDIR)$(MAN_DIR) test -d $(DESTDIR)$(DOC_DIR) || $(MKDIR) $(DESTDIR)$(DOC_DIR) test -d $(DESTDIR)/share/applications || $(MKDIR) $(DESTDIR)$(SHARE_DIR)/applications test -d $(DESTDIR)/share/lintian/overrides || $(MKDIR) $(DESTDIR)$(SHARE_DIR)/lintian/overrides $(foreach LANG, $(LANGUAGES), $(MKDIRLANG);) tomboy-ng_0.34-1/scripts/0000755000175000017500000000000014145033507015104 5ustar dbannondbannontomboy-ng_0.34-1/scripts/prepare.debian0000644000175000017500000002245514145033507017716 0ustar dbannondbannon#!/bin/bash # copyright David Bannon, 2019, 2020, 2021 use as you see fit, but retain this statement. # # This stript is useful to prepare the tomboy-ng source tree to make an # Debian Source Package # For detailed instructions including ready to copy command lines see- # https://github.com/tomboy-notes/tomboy-ng/blob/master/prepare.md # # David Bannon, Jan 2021 # History - # 2020-09-02 Added -D distro switch # 2020-12-17 Restructed the multi control system to make it clearer. # 2020-12-29 Split script into seperate Debian one, only Qt5. # 2021-01-27 More detailed instructions on use. # 2021-02-03 Include enough of first changelog to keep lintian off my back # 2021-06-19 Made swichable between GTK2 and Qt5 # Moved Howto docs to github APP="tomboy-ng" # These are mine, they are used as defaults if NOT set in env. Ignored unless signing. DEF_EMAIL="tomboy-ng@bannons.id.au" # This matches cert I use to sign tomboy-ng stuff DEF_FULLNAME="David Bannon" # and this ... UBUNTU_FULLNAME="tomboy-ng" # My stuff up, different cert with different name in Ubuntu PPA ! DEBVER="-1" # Package version, not source, starts at 1 # Housekeeping stuff, helpers for debugging etc. Set with command line, not here ! VER="unknown" LAZ_BLD="" UFILES="NO" # debug tool, update Makefile CLEAN="NO" # debug tool, remove files from previous run, assume same ver. WIDGET="" # empty says make a GTK2, only other possibility is Qt5 # Looks for fpc and lazbuild on PATH, if in root space, do nothing, # if in user space, because debuild will miss them, makes two files. function CheckFPC_LAZ () { FPC=`which fpc` if [ -x "$FPC" ]; then PREFIX="${FPC:0:4}" if [ "$PREFIX" = "/usr" ]; then echo "---------- root space fpc, all good" else echo "---------- Leaving a fpc file for buildit" echo "$FPC" > WHICHFPC fi else echo "----------- ERROR, no fpc found ------------" exit 1 fi if [ "$LAZ_BLD" = "" ]; then # we had better try to find it LAZ_BLD=`which lazbuild` fi if [ -x "$LAZ_BLD" ]; then PREFIX="${LAZ_BLD:0:4}" if [ "$PREFIX" = "/usr" ]; then echo "---------- root space Lazarus, all good" else echo "---------- Leaving a lazbuild file for buildit" echo "$LAZ_BLD" > WHICHLAZ fi else echo " --- ERROR, no lazbuild found, try -l ? ---" exit 1 fi } # Here we remove file that are not needed in the Debian SRC kit. function CleanSource () { rm -Rf experimental rm -Rf patches rm -Rf doc/gallery rm -Rf doc/html rm -Rf doc/wiki rm -Rf po/*.mo rm -f doc/*.svg doc/*.png doc/*.note rm -f glyphs/*.png glyphs/*.ico glyphs/*.svg glyphs/*.icns rm -fR glyphs/help rm -fR glyphs/demos KC="kcontrols" KCS="$KC/source" rm -fR "$KC"/demos rm -fR "$KC"/help rm -Rf "$KC"/packages kcontrols/tools rm -Rf "$KC"/resource_src/khexeditor_icons "$KC"/resource_src/kgrid_icons rm "$KCS"/kbuttons.pas "$KCS"/kdbgrids.pas "$KCS"/kgrids.* "$KCS"/kicon.pas rm "$KCS"/klabels.pas "$KCS"/kmemodlg*.* "$KCS"/kxml.pas "$KCS"/kwidewinprocs.pas rm "$KCS"/kmemofrm.* "$KCS"/kpagecontrol.* "$KCS"/kprogress.* "$KCS"/ksplitter.pas rm "$KC"/*.txt "$KC"/*.json "$KC"/*.bat rm -Rf "$KC"/packages "$KC"/tools "$KC"/resource_src/khexeditor_icons "$KC"/resource_src/kgrid_icons chmod 664 doc/HELP/EN/* chmod 664 doc/HELP/ES/* chmod 664 doc/HELP/FR/* } function KControls () { if [ -e "kcontrols-master.zip" ]; then echo "---------- Note: reusing KControls zip" else wget https://github.com/davidbannon/KControls/archive/master.zip # watch this name does not change. mv master.zip kcontrols-master.zip fi unzip -q kcontrols-master.zip # rm -f master.zip mv KControls-master "$APP"_"$VER""$DEBVER"/kcontrols } function ShowHelp () { echo " " echo "Prepares to generate changes from existing .orig file in Debian." echo "Assumes FPC of some sort in path, available and working, ideally 3.2.0." echo "Needs Lazarus, <=2.0.10 in root space or specified with -l option." echo "Needs devscripts preinstalled and maybe an edit of email address above." echo "If doing a tomboy-ng release, provide -n and a new orig file is made." echo "Else, repackaging, needs the .orig file, and current tomboy-ng-master.zip" echo "Will download kcontrols, cleanup and prepare to run debuild -S" echo "REMEMBER to feed changlog back to github tree" echo "David Bannon, June 2021" echo "-h print help message" echo "-l a path to a viable lazbuild, eg at least where lazbuild and lcl is." echo "-C clean deb files from previous run, exit, debug use only, Unreliable" echo "-D distro, eg unstable, bullseye" echo "-n New orig file, required for fresh release" echo "-q Make a Qt5 version instead of GTK2" echo "" echo " Typically, new release bash ./prepare.debian -D unstable -n" exit } function MakeOrigFile () { echo "---------- Creating a new .orig file" # Note, when called we are in the unzipped and renamed tomboy-ng dir. # We move most of the debian dir out of harms way and tar up the dir. # We have to do this to avoid the dreaded lintian no-debian-changes # The copyright file in there alone does not generate that error ?? # But before moving it, we will create a new changelog # cd "$APP"_"$VER""$DEBVER" # rm debian/changelog # Must have a new changelog if new orig file # dch "$DISTRO1" "$DISTRO2" --create --package="$APP" --newversion="$VER""$DEBVER" "New Version Release" # dch --append "Please see github for change details" # dch --release "blar" # echo "" >> debian/changelog # echo "tomboy-ng (0.31a-1) unstable; urgency=medium" >> debian/changelog # echo "" >> debian/changelog # echo " * Initial release. (Closes: #897688)" >> debian/changelog # echo "" >> debian/changelog # echo " -- David Bannon Fri, 18 Dec 2020 22:08:09 +1100" >> debian/changelog cd .. mv "$APP"_"$VER""$DEBVER"/debian ./debian mkdir "$APP"_"$VER""$DEBVER"/debian cp debian/copyright "$APP"_"$VER""$DEBVER"/debian/. tar czf "$APP"_"$VER".orig.tar.gz "$APP"_"$VER""$DEBVER" # OK, we now have our .orig. file, put most of it back. rm -Rf "$APP"_"$VER""$DEBVER"/debian mv ./debian "$APP"_"$VER""$DEBVER"/. } while getopts "hUCl:D:nq" opt; do case $opt in h) ShowHelp ;; l) LAZ_BLD="$OPTARG" ;; C) CLEAN="YES" ;; D) DISTRO1="-D""$OPTARG" DISTRO2="--force-distribution" ;; n) NEWORIG="YES" ;; q) WIDGET="Qt5" ;; \?) echo "Invalid option: -$OPTARG" >&2 ShowHelp ;; esac done echo "---------- laz_bld is $LAZ_BLD" echo "---------- CLEAN is $CLEAN" echo "---------- UFILES is $UFILES" rm -f WHICHFPC WHICHLAZ if [ ! -f tomboy-ng-master.zip ]; then echo "---------- Downloading a new tomboy-ng" wget https://github.com/tomboy-notes/tomboy-ng/archive/master.zip mv master.zip tomboy-ng-master.zip fi if [ -f tomboy-ng-master.zip ]; then CheckFPC_LAZ # In practise, we should have these env set, my defaults just in case. if [ "$DEBEMAIL" = "" ]; then DEBEMAIL="$DEF_EMAIL" export DEBEMAIL fi if [ "$DEBFULLNAME" = "" ]; then DEBFULLNAME="$DEF_FULLNAME" export DEBFULLNAME fi if [ "$CLEAN" = "YES" ]; then rm -Rf "tomboy-ng-master" # probably not here anyway .... fi unzip -q tomboy-ng-master.zip VER=`cat tomboy-ng-master/package/version` if [ "$CLEAN" = "YES" ]; then rm -Rf "tomboy-ng-master" echo "---------- Removing existing DEB files" rm -Rf "$APP"_"$VER"-? rm -f "tomboy-ng_$VER-"?_source.buildinfo rm -f "tomboy-ng_$VER-"?_source.changes rm -f "tomboy-ng_$VER-"?_amd64.deb rm -f "tomboy-ng_$VER-"?.debian.tar.xz rm -f "tomboy-ng_$VER-"?.dsc rm -f "tomboy-ng_$VER.orig.tar.gz" # echo "Like a coward, not removing .orig file, tomboy-ng_$VER.orig.tar.gz" exit fi mv "tomboy-ng-master" "$APP"_"$VER""$DEBVER" KControls cd "$APP"_"$VER""$DEBVER" # This is orig tomboy-ng dir made from zip if [ "$WIDGET" = "Qt5" ]; then touch Qt5 # leave semaphore file fi CleanSource if [ "$NEWORIG" = "YES" ]; then MakeOrigFile # create new .orig (and no longer a new change log) # else # This happens below for both new and fix up mode ??? # dch -v "$VER""$DEBVER" "$DISTRO1" "$DISTRO2" "Release of new version" fi cd "$APP"_"$VER""$DEBVER" dch -v "$VER""$DEBVER" "$DISTRO1" "$DISTRO2" "Release of new version" if [ -f whatsnew ]; then echo "---------- Including whatsnew in changelog" while IFS= read -r Line; do dch --append "$Line" done < whatsnew fi dch --append "Please see github for further change details" cp debian/control.debian debian/control # thats the GTK2 version if [ "$WIDGET" = "Qt5" ]; then cp debian/control.qt5-DEBIAN debian/control # thats the Qt5 version fi rm -f debian/control.qt5 rm -f debian/rules.qt5 # never need that here, its for PPA where qt5 has different name rm -f debian/control.qt5-DEBIAN rm -f debian/control.debian cd .. echo "If no errrors, you should now cd ""$APP"_"$VER""$DEBVER""; debuild -S; cd .." else echo "" echo " Sorry, I cannot see a tomboy-ng-master.zip file. This" echo " script must be run in a directory containing that file" echo " (obtained from github) and probably little else." echo " If you used wget to download tomboy-ng, it will be named master.zip," echo " you should rename it tomboy-ng-master.zip to avoid confusion." echo "" fi tomboy-ng_0.34-1/scripts/test-deb.bash0000644000175000017500000000301714145033507017453 0ustar dbannondbannon#!/bin/bash # ------------------------------------------------------------------- # A script to build tomboy-ng Deb packages, gtk2 only. Download # this script, run it from your home dir. It depends on a suitable # FPC and Lazarus installed in root space. # If using your own build FPC or Lazarus, you will have to use the # the prepare scripts. # If you have had a bad build and need to inc the -1 after the ver # then you will have to resort to using the prepare.debian manually. # copyright David Bannon 2021, License unlimited. # ------------------------------------------------------ # VER="33e" VER="$1" DebVer="Debv""$VER" if [ "$1" == "" ]; then echo " ERROR, must provide a ver numb, eg 33e or 34" exit 1 fi cd rm -Rf "Build""$DebVer" "Test""$DebVer" mkdir "Build""$DebVer"; cd "Build""$DebVer" wget https://raw.githubusercontent.com/tomboy-notes/tomboy-ng/master/scripts/prepare.debian bash ./prepare.debian -D unstable -n cd "tomboy-ng_0.""$VER""-1" debuild -S cd .. if [ ! -f "tomboy-ng_0.""$VER""-1.dsc" ]; then echo "======== Failed to make dsc file, exiting ======" exit 1 fi mkdir ../Test"$DebVer" cp *.xz *.gz *.dsc ../Test"$DebVer" cd ../Test"$DebVer" dpkg-source -x *.dsc echo "================" pwd ls -l cd "tomboy-ng-0.""$VER" # note '-' at start of ver number, not underscore echo "================" pwd ls -l dpkg-buildpackage -us -uc cd .. if [ ! -f "tomboy-ng_0.""$VER""-1_amd64.deb" ]; then echo "======== Failed to make Deb file, exiting ========" exit 1 fi lintian -IiE --pedantic *.changes tomboy-ng_0.34-1/scripts/test-ppa.bash0000644000175000017500000000426314145033507017505 0ustar dbannondbannon#!/bin/bash set -e # ------------------------------------------------------------------- # A script to build tomboy-ng PPA packages, gtk2 and Qt5. Download # this script, run it from your home dir. It depends on a suitable # FPC and Lazarus installed in root space. # If using your own build FPC or Lazarus, you will have to use the # the prepare scripts. Easy for Debian because it builds only GTK2 # but if you want to build a QT5 PPA, better look at code below. # Similarly, if you have had a bad build, and need to inc the # -1 after the tomboy-ng version number, its manual. # copyright David Bannon 2021, License unlimited. # ------------------------------------------------------ # VER="33e" VER="$1" DebVer="PPA""$VER" if [ "$1" == "" ]; then echo " ERROR, must provide a ver numb, eg 33e or 34" exit 1 fi cd rm -Rf "Build""$DebVer" "Test""$DebVer" mkdir "Build""$DebVer"; cd "Build""$DebVer" wget https://raw.githubusercontent.com/tomboy-notes/tomboy-ng/master/scripts/prepare.ppa #cp ../prepare.ppa . bash ./prepare.ppa -D bionic # Bionic for GTK2 cd "tomboy-ng_0.""$VER""-1" debuild -S cd .. if [ ! -f "tomboy-ng_0.""$VER""-1.dsc" ]; then echo "======== Failed to make tomboy-ng_0.""$VER""-1.dsc exiting ======" exit 1 fi cd #DebVer="$DebVer""QT" rm -Rf "Build""$DebVer"QT "Test""$DebVer"QT mkdir "Build""$DebVer"QT; cd "Build""$DebVer"QT wget https://raw.githubusercontent.com/tomboy-notes/tomboy-ng/master/prepare.ppa #cp ../prepare.ppa . bash ./prepare.ppa -D focal -Q cd "tomboy-ng-qt5_0.""$VER""-1" debuild -S cd .. if [ ! -f "tomboy-ng-qt5_0.""$VER""-1.dsc" ]; then echo "======== Failed to make dsc file, exiting ======" exit 1 fi # exit 1 cd cd "Build""$DebVer" mkdir ../Test"$DebVer" cp *.xz *.gz *.dsc ../Test"$DebVer" cd ../Test"$DebVer" dpkg-source -x *.dsc cd "tomboy-ng-0.""$VER" # note '-' at start of ver number, not underscore dpkg-buildpackage -us -uc cd .. if [ ! -f "tomboy-ng_0.""$VER""-1_amd64.deb" ]; then echo "======== Failed to make Deb file, exiting ========" exit 1 fi lintian -IiE --pedantic *.changes echo "--------- OK, if it looks OK, go back to each build directoy and run -" echo " dput ppa:d-bannon/ppa-tomboy-ng *.changes" tomboy-ng_0.34-1/scripts/prepare.ppa0000644000175000017500000002227014145033507017247 0ustar dbannondbannon#!/bin/bash set -e # copyright David Bannon, 2019, 2020, use as you see fit, but retain this statement. # This stript is useful to prepare the tomboy-ng source tree to make an # Ubuntu PPA # For detailed instructions including ready to copy command lines see- # https://github.com/tomboy-notes/tomboy-ng/blob/master/prepare.md # Remember that we don't build a Qt5 for Bionic, its libqt5pas is too old. # So, -Dbionic and -Q -Dfocal # David Bannon, July 2020 # History - # 2020-09-02 Added -D distro switch # 2020-12-17 Restructed the multi control system to make it clearer. # 2021-02-23 Allow for fact that we keep changelog (for Debian). # Remove some Debian specific things # 2021-06-19 cleanup and move how to doc to github # 2021-11-12 Now update changelog with whatsnew contents # --------------------------------------------------------- APP="tomboy-ng" # These are mine, they are used as defaults if NOT set in env. Ignored unless signing. DEF_EMAIL="tomboy-ng@bannons.id.au" # This matches cert I use to sign tomboy-ng stuff # DEF_FULLNAME="David Bannon" # not in this script ! UBUNTU_FULLNAME="tomboy-ng" # My stuff up, different cert with different name in Ubuntu PPA ! # Housekeeping stuff, helpers for debugging etc. Set with command line, not here ! VER="unknown" LAZ_BLD="" UFILES="NO" # debug tool, update Makefile CLEAN="NO" # debug tool, remove files from previous run. WIDGET="" # empty says make a GTK2, only other possibility is Qt5 QT5INNAME="" # May have content we add to qt5 package name (when -Q) PACKVER="-1" # -1 is normal, if you have to submit again, must inc. # Looks for fpc and lazbuild on PATH, if in root space, do nothing, # if in user space, because debuild will miss them, makes two files. function CheckFPC_LAZ () { FPC=`which fpc` if [ -x "$FPC" ]; then PREFIX="${FPC:0:4}" if [ "$PREFIX" = "/usr" ]; then echo "---------- root space fpc, all good" else echo "---------- Leaving a fpc file for buildit" echo "$FPC" > WHICHFPC fi else echo "----------- ERROR, no fpc found ------------" exit 1 fi if [ "$LAZ_BLD" = "" ]; then # we had better try to find it LAZ_BLD=`which lazbuild` fi if [ -x "$LAZ_BLD" ]; then PREFIX="${LAZ_BLD:0:4}" if [ "$PREFIX" = "/usr" ]; then echo "---------- root space Lazarus, all good" else echo "---------- Leaving a lazbuild file for buildit" echo "$LAZ_BLD" > WHICHLAZ fi else echo " --- ERROR, no lazbuild found, try -l ? ---" exit 1 fi } # Here we remove file that are not needed in the Debian SRC kit. function CleanSource () { rm -Rf experimental rm -Rf patches rm -Rf doc/gallery rm -Rf doc/html rm -Rf doc/wiki rm -Rf po/*.mo rm -f doc/*.svg doc/*.png doc/*.note rm -f glyphs/*.png glyphs/*.ico glyphs/*.svg glyphs/*.icns rm -fR glyphs/help rm -fR glyphs/demos KC="kcontrols" KCS="$KC/source" rm -fR "$KC"/demos rm -fR "$KC"/help rm -Rf "$KC"/packages kcontrols/tools rm -Rf "$KC"/resource_src/khexeditor_icons "$KC"/resource_src/kgrid_icons rm "$KCS"/kbuttons.pas "$KCS"/kdbgrids.pas "$KCS"/kgrids.* "$KCS"/kicon.pas rm "$KCS"/klabels.pas "$KCS"/kmemodlg*.* "$KCS"/kxml.pas "$KCS"/kwidewinprocs.pas rm "$KCS"/kmemofrm.* "$KCS"/kpagecontrol.* "$KCS"/kprogress.* "$KCS"/ksplitter.pas rm "$KC"/*.txt "$KC"/*.json "$KC"/*.bat rm -Rf "$KC"/packages "$KC"/tools "$KC"/resource_src/khexeditor_icons "$KC"/resource_src/kgrid_icons } function KControls () { if [ -e "master.zip" ]; then echo "Note: reusing KControls zip" else # wget https://github.com/kryslt/KControls/archive/master.zip # watch this name does not change. wget https://github.com/davidbannon/KControls/archive/master.zip # watch this name does not change. fi unzip -q master.zip # rm -f master.zip mv KControls-master "$APP"_"$VER""$PACKVER"/kcontrols } function ShowHelp () { echo " " echo "Use this script to make Ubuntu PPA (or plain binary), always make .orig" echo "Assumes FPC 3.2.0 in path. Will no longer build with FPC304." echo "Needs Lazarus, <=2.0.10 in root space or specified with -l option." echo "Needs devscripts preinstalled and maybe an edit of email address above if" echo "it is to be used in the DEB SRC tool chain. Its role there is just to create" echo "an initial tarball and working directory (including inserting kcontrols)." echo "David Bannon, December 2020" echo "-h print help message" echo "-l a full path to a viable lazbuild executable, eg also lcl dir is." echo "-C clean out deb files from previous run, debug use only." echo "-U update Makefile and/or buildit.bash, debug use only." echo "-Q Make a Qt5 version instead of default GTK2" #echo "-q Make a Qt5 one for a Debian Repo" echo "-p Pause before creating .orig. to change content, use another term." echo "-D distro, eg bionic, focal" echo "" echo "eg bash ./prepare.bash -Dbionic [-Q] ; cd tomboy[tab] " echo " debuild -S // check for errors !" echo " cd .. ; dput ppa:d-bannon/ppa-tomboy-ng *.changes [enter]" echo " ----- or, just build a binary ---------" echo "eg bash ./prepare.bash -Dbionic [-Q] ; cd tomboy[tab] " echo " bash ./buildit.bash " exit } while getopts "hpQUCl:D:" opt; do case $opt in h) ShowHelp ;; l) LAZ_BLD="$OPTARG" ;; U) UFILES="YES" ;; C) CLEAN="YES" ;; p) PAUSE="YES" ;; Q) WIDGET="Qt5" APP="$APP""-qt5" # QT5INNAME="YES" ;; D) DISTRO1="-D""$OPTARG" DISTRO2="--force-distribution" ;; \?) echo "Invalid option: -$OPTARG" >&2 ShowHelp ;; esac done echo "---------- laz_bld is $LAZ_BLD" echo "---------- CLEAN is $CLEAN" echo "---------- UFILES is $UFILES" rm -f WHICHFPC WHICHLAZ if [ ! -f tomboy-ng-master.zip ]; then echo "---------- Downloading a new tomboy-ng" wget https://github.com/tomboy-notes/tomboy-ng/archive/master.zip mv master.zip tomboy-ng-master.zip fi if [ -f tomboy-ng-master.zip ]; then CheckFPC_LAZ # In practise, we should have these env set, my defaults just in case. if [ "$DEBEMAIL" = "" ]; then DEBEMAIL="$DEF_EMAIL" export DEBEMAIL fi if [ "$DEBFULLNAME" = "" ]; then DEBFULLNAME="$UBUNTU_FULLNAME" export DEBFULLNAME fi unzip -q tomboy-ng-master.zip if [ "$UFILES" = "YES" ]; then if [ "Makefile" -nt "tomboy-ng-master/Makefile" ]; then echo "---------- UPDATING Makefile" cp Makefile tomboy-ng-master/Makefile fi if [ "buildit.bash" -nt "tomboy-ng-master/buildit.bash" ]; then echo "---------- UPDATING buildit.bash" cp buildit.bash tomboy-ng-master/buildit.bash fi fi VER=`cat tomboy-ng-master/package/version` if [ "$CLEAN" = "YES" ]; then echo "---------- Removing existing DEB files" rm -Rf "$APP"_"$VER""$PACKVER" rm -f *.changes *.buildinfo *.orig.tar.gz *.dsc *.tar.gz *.tar.xz *.upload fi mv "tomboy-ng-master" "$APP"_"$VER""$PACKVER" KControls cd "$APP"_"$VER""$PACKVER" CleanSource # https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=897688 # dch "$DISTRO1" "$DISTRO2" --create --package="$APP" --newversion="$VER""$PACKVER" "Initial release. (Closes: #897688)" # because we use the same changelog, we need to tweak the qt5 one if [ "$WIDGET" = "Qt5" ]; then sed -i 's/tomboy-ng\ /tomboy-ng-qt5\ /g' debian/changelog fi dch -v "$VER""$PACKVER" "$DISTRO1" "$DISTRO2" "Release of new version" if [ -f whatsnew ]; then echo "---------- Including whatsnew in changelog" while IFS= read -r Line; do dch --append "$Line" done < whatsnew fi dch --append "Please see github for details" if [ "$WIDGET" = "Qt5" ]; then dch --append "Qt5 version" cp debian/rules.qt5 debian/rules cp debian/control.qt5 debian/control # sed "s/#REPLACEME_QT5/DESTDIR += -qt5/" Makefile > Makefile.temp # mv Makefile.temp Makefile touch Qt5 fi dch --release "blar" cd .. if [ "$PAUSE" = "YES" ]; then read -p "Edit things in another term, press Enter." fi # Next block is to avoid the dreaded lintian no-debian-changes # The copyright file in there alone does not generate that error mv "$APP"_"$VER""$PACKVER"/debian ./debian # tuck a copy away for later mkdir "$APP"_"$VER""$PACKVER"/debian cp debian/copyright "$APP"_"$VER""$PACKVER"/debian/. # we must have copyright tar czf "$APP"_"$VER".orig.tar.gz "$APP"_"$VER""$PACKVER" # create the orig file # OK, we have our .orig. file, put most of it back. rm -Rf "$APP"_"$VER""$PACKVER"/debian # dump that one for simplicity rm debian/control.qt5-DEBIAN debian/control.qt5 # we don't need that rm debian/rules.qt5 # or that mv ./debian "$APP"_"$VER""$PACKVER"/. # put remainder back where it belongs echo "If no errrors, you should now cd ""$APP"_"$VER""$PACKVER; debuild -S" else echo "" echo " Sorry, I cannot see or get a tomboy-ng-master.zip file. This script can" echo " be run in a directory containing that file or will try to download it" echo " from github, seems even that failed." echo " If you used wget to download tomboy-ng, it will be named master.zip," echo " you should rename it tomboy-ng-master.zip to avoid confusion." echo "" fi tomboy-ng_0.34-1/po/0000755000175000017500000000000014145033507014033 5ustar dbannondbannontomboy-ng_0.34-1/po/tomboy-ng.es.po0000644000175000017500000014533514145033507016727 0ustar dbannondbannon# Spanish translation for Tomboy-ng. # This file is put in the public domain. # Roy W. Reese , 2018-2021. msgid "" msgstr "" "Content-Type: text/plain; charset=UTF-8\n" "Project-Id-Version: tomboy-ng v0.34\n" "POT-Creation-Date: \n" "PO-Revision-Date: 2021-11-14 15:00+0100\n" "Last-Translator: RWR\n" "Language-Team: \n" "MIME-Version: 1.0\n" "Content-Transfer-Encoding: 8bit\n" "Language: es\n" "X-Generator: Poedit 2.4.3\n" "Plural-Forms: nplurals=2; plural=(n != 1);\n" #: editbox.rsunabletoevaluate msgid "Unable to find an expression to evaluate" msgstr "No encontró ninguna expresión para calcular" #: jsontools.sindexoutofbounds msgid "Index out of bounds" msgstr "Indice fuera de los limites" #: jsontools.snodenotcollection msgid "Node is not a container" msgstr "El nódulo no es contenedor" #: jsontools.sparsingerror msgid "Error while parsing text" msgstr "Error en analizar el texto" #: jsontools.srootnodekind msgid "Root node must be an array or object" msgstr "Nódulo raíz tiene que ser matriz o objeto" #: mainunit.rsabout1 msgid "This is tomboy-ng, a rewrite of Tomboy Notes using Lazarus" msgstr "Esto es tomboy-ng, la refundición de Notas Tomboy usando Lazarus" #: mainunit.rsabout2 msgid "and FPC. While its ready for production" msgstr "y FPC. A pesar de estar listo para emplear en producción," #: mainunit.rsabout3 msgid "use, you still need to be careful and have good backups." msgstr "hay que tener cuidado y hacer buenas copias de seguridad." #: mainunit.rsaboutbdate msgid "Build date" msgstr "Fecha de compilación" #: mainunit.rsaboutcpu msgid "TargetCPU" msgstr "Arquitectura" #: mainunit.rsaboutoperatingsystem msgid "OS" msgstr "SO" #: mainunit.rsaboutver msgid "Version" msgstr "Versión" #: mainunit.rsfailedtoindex msgid "Failed to index one or more notes." msgstr "tomboy-ng no pudo indizar una nota o más." #: resourcestr.rsaddnotestonotebook msgid "Add notes to this Notebook" msgstr "Añadir notas al cuaderno" #: resourcestr.rsalldone msgctxt "resourcestr.rsalldone" msgid "All Done" msgstr "Todo terminado" #: resourcestr.rsallrestored msgctxt "resourcestr.rsallrestored" msgid "Notes and config files Restored, restart suggested." msgstr "Notas y configuración restablecidos. Se recomienda reiniciar." #: resourcestr.rsautosnapshotrun msgid "Completed autosnapshot run." msgstr "Instantánea automática hecha." #: resourcestr.rsautosyncnotpossible msgid "Auto sync not possible right now" msgstr "Sincronización automática imposible ahora mismo" #: resourcestr.rsbadnotes #, object-pascal-format msgid "You have %d bad notes in Notes Directory" msgstr "Tiene %d notas corrompidas en el directorio" #: resourcestr.rsbadnotesfound1 msgctxt "resourcestr.rsbadnotesfound1" msgid "Please go to Settings -> Recover -> Recover Notes" msgstr "Por favor, vaya a Preferencias -> Recuperar -> Recuperar notas" #: resourcestr.rsbadnotesfound2 msgctxt "resourcestr.rsbadnotesfound2" msgid "You should do so to ensure your notes are safe." msgstr "Debería hacerlo para salvaguardar sus notas." #: resourcestr.rscannotdelete msgctxt "resourcestr.rscannotdelete" msgid "Cannot delete " msgstr "No se puede eliminar " #: resourcestr.rscannotfindnote msgctxt "resourcestr.rscannotfindnote" msgid "ERROR, cannot find " msgstr "ERROR: no se encuentra " #: resourcestr.rschangenameofnotebook msgid "Change the name of this Notebook" msgstr "Cambiar el nombre de este cuaderno" #: resourcestr.rschangesync msgid "Change Sync Repo" msgstr "Cambiar repositorio de sincronización" #: resourcestr.rsclickbadnote msgctxt "resourcestr.rsclickbadnote" msgid "Double click on any Bad Notes" msgstr "Hacer doble clic en las notas corrompidas" #: resourcestr.rsclicksnapshot msgctxt "resourcestr.rsclicksnapshot" msgid "Click an Available Snapshot" msgstr "Hacer clic en una instantánea" # Puede ser contenido viejo #: resourcestr.rscontentdated msgid "Content Dated" msgstr "Contenido con fecha" #: resourcestr.rscopyfailed msgctxt "resourcestr.rscopyfailed" msgid "Copying orig to Backup directory failed" msgstr "No se copió al directorio de copias de seguridad" #: resourcestr.rscreatenewrepo msgctxt "resourcestr.rscreatenewrepo" msgid "Create a new Repo ?" msgstr "¿Crear un repositorio nuevo?" #: resourcestr.rsdeleteandreplace_1 msgctxt "resourcestr.rsdeleteandreplace_1" msgid "Notes at risk !" msgstr "¡Notas en peligro!" # Hecho más corto #: resourcestr.rsdeleteandreplace_2 #, object-pascal-format msgctxt "resourcestr.rsdeleteandreplace_2" msgid "Delete all notes in %s and replace with snapshot dated %s ?" msgstr "Eliminar todas en %s y reemplazarlas con la instantánea con fecha %s?" #: resourcestr.rsdeleteddamaged #, object-pascal-format msgid "OK, deleted %d damaged notes" msgstr "Eliminadas %d notas corrompidas" # Supongo refiere a descargar unas notas #: resourcestr.rsdownloaded msgid "Downloaded" msgstr "Descargadas" #: resourcestr.rsdownloadnotes msgid "Downloading notes" msgstr "Descargando notas" #: resourcestr.rsenternewnotebook msgctxt "resourcestr.rsenternewnotebook" msgid "Enter a new notebook name please" msgstr "Introduzca un nuevo nombre de cuaderno, por favor" #: resourcestr.rserrorcopyfile msgctxt "resourcestr.rserrorcopyfile" msgid "Failed to copy file, does destination dir exist ?" msgstr "El archivo no se copió. ¿Existe el directorio?" #: resourcestr.rsfilesyncinfo1 msgid "tomboy-ng uses File Sync to sync to eg DropBox, Google Drive, a USB drive" msgstr "tomboy-ng usa Sincronización de Archivos a DropBox, Google Drive, un disco USB, etc" #: resourcestr.rsfilesyncinfo2 msgid "or uses a remote server over the internet with sshfs" msgstr "o use un servidor remoto por internet con sshfs" #: resourcestr.rsfindnavlefthint msgid "Backward Find : Shift-F3 or Shift-Ctrl-G" msgstr "Buscar atrás: Mayús-F3 o Mayús-Ctrl-G" #: resourcestr.rsfindnavlefthintmac msgid "Backward Find : Shift-Command-G" msgstr "Buscar atrás: Mayús-Cmd-G" #: resourcestr.rsfindnavrighthint msgid "Find : F3 or Ctrl-G" msgstr "Buscar: F3 o Ctrl-G" #: resourcestr.rsfindnavrighthintmac msgid "Find : Command-G" msgstr "Buscar: Cmd-G" #: resourcestr.rsfound msgctxt "resourcestr.rsfound" msgid "Found" msgstr "Encontrada" #: resourcestr.rsgithubsyncinfo1 msgid "tomboy-ng can use Github to both sync and display or edit notes" msgstr "tomboy-ng puede usar Github para sincronizar o editar notas" #: resourcestr.rsgithubsyncinfo2 msgid "you should read the tomboy-ng wiki page for instructions." msgstr "debería leer las instrucciones en la wiki de tomboy-ng." #: resourcestr.rsgithubtokenexpired msgid "Github Token may have expired" msgstr "Puede que el autentificador haya caducado" #: resourcestr.rshelpconfig msgctxt "resourcestr.rshelpconfig" msgid "Create or use an alternative config" msgstr "Crear o usar una configuración alternativa" #: resourcestr.rshelpdebug msgctxt "resourcestr.rshelpdebug" msgid "Direct debug output to SOME.LOG." msgstr "Enviar salida de depuración a SOME.LOG." #: resourcestr.rshelpdebugindex msgctxt "resourcestr.rshelpdebugindex" msgid "Show debug msgs while indexing notes" msgstr "Mostrar mensajes de depuración durante indización" #: resourcestr.rshelpdebugspell msgctxt "resourcestr.rshelpdebugspell" msgid "Show debug messages while spell setup" msgstr "Mostrar mensajes de depuración durante configuración de ortografía" #: resourcestr.rshelpdebugsync msgctxt "resourcestr.rshelpdebugsync" msgid "Show debug messages during Sync" msgstr "Mostrar mensajes de depuración durante Sincronización" #: resourcestr.rshelpdelay msgctxt "resourcestr.rshelpdelay" msgid "Delay startup 2 sec to allow OS to settle" msgstr "Retrasar arranque 2 segs para dejar asentarse el SO" #: resourcestr.rshelphelp msgctxt "resourcestr.rshelphelp" msgid "Show this help message and exit." msgstr "Mostrar mensaje de ayuda y salir." #: resourcestr.rshelplang msgctxt "resourcestr.rshelplang" msgid "Force Language, supported en, es, fr, nl" msgstr "Forzar idioma. Idiomas suportados: en, es, fr, nl" #: resourcestr.rshelpnosplash msgctxt "resourcestr.rshelpnosplash" msgid "Do not show small status/splash window" msgstr "No mostrar ventana de estado/bienvenida" #: resourcestr.rshelpsaveexit msgctxt "resourcestr.rshelpsaveexit" msgid "After import single note, save & exit" msgstr "Después de importar una sola nota, guardar y salir." #: resourcestr.rshelpsinglenote msgctxt "resourcestr.rshelpsinglenote" msgid "Open indicated note, switch is optional" msgstr "Abrir nota marcada, parámetro es opcional" #: resourcestr.rshelpversion msgctxt "resourcestr.rshelpversion" msgid "Print version and exit" msgstr "Imprimir versión y salir" #: resourcestr.rslastchange msgctxt "resourcestr.rslastchange" msgid "Last Change" msgstr "Último cambio" #: resourcestr.rslastsync msgid "Last Sync" msgstr "Última sincronización" #: resourcestr.rslookingatnotes msgctxt "resourcestr.rslookingatnotes" msgid "Looking at notes ...." msgstr "Examinando las notas ..." #: resourcestr.rslookingserverid msgid "Looking for ServerID" msgstr "Buscando ServerID" #: resourcestr.rsmenuabout msgctxt "resourcestr.rsmenuabout" msgid "About" msgstr "Acerca de" #: resourcestr.rsmenuhelp msgctxt "resourcestr.rsmenuhelp" msgid "Help" msgstr "Ayuda" #: resourcestr.rsmenunewnote msgctxt "resourcestr.rsmenunewnote" msgid "New Note" msgstr "Nota nueva" #: resourcestr.rsmenuquit msgctxt "resourcestr.rsmenuquit" msgid "Quit" msgstr "Salir" #: resourcestr.rsmenusearch msgctxt "resourcestr.rsmenusearch" msgid "Search" msgstr "Buscar" #: resourcestr.rsmenusettings msgctxt "resourcestr.rsmenusettings" msgid "Settings" msgstr "Preferencias" #: resourcestr.rsmenusync msgctxt "resourcestr.rsmenusync" msgid "Synchronise" msgstr "Sincronizar" #: resourcestr.rsmetadirwarning msgid "Please remember that to ensure a reliable sync, you must not change files in the Meta directory." msgstr "Recuerde que para tener una sincronización fiable, no deba cambiar archivos en el directorio Meta." #: resourcestr.rsmultiplenotebooks msgctxt "resourcestr.rsmultiplenotebooks" msgid "Settings allow multiple Notebooks" msgstr "Las preferencias permiten cuadernos múltiples" #: resourcestr.rsname msgctxt "resourcestr.rsname" msgid "Name" msgstr "Nombre" #: resourcestr.rsnewerversionexits msgctxt "resourcestr.rsnewerversionexits" msgid "A newer version exists in main repo" msgstr "Hay una versión más nueva en el repositorio principal" #: resourcestr.rsnotavailable msgid "Not Available" msgstr "No disponible" #: resourcestr.rsnotealreadyinrepo msgctxt "resourcestr.rsnotealreadyinrepo" msgid "Note already in Repo" msgstr "Ya está en el repositorio" #: resourcestr.rsnotebookoptionctrl msgid "Ctrl click for Notebook Options" msgstr "Ctrl+Clic para Opciones de Cuaderno" #: resourcestr.rsnotebookoptionright msgid "Right click for Notebook Options" msgstr "Clic derecho para opciones de cuaderno" #: resourcestr.rsnotebooks msgctxt "resourcestr.rsnotebooks" msgid "Notebooks" msgstr "Cuadernos" #: resourcestr.rsnoteopen msgctxt "resourcestr.rsnoteopen" msgid "You have that note open, please close and try again" msgstr "La nota está abierta, por favor cerrarla y intentarlo de nuevo" #: resourcestr.rsnotes msgctxt "resourcestr.rsnotes" msgid "notes" msgstr "notas" #: resourcestr.rsnotesdeleted msgid "Note or notes deleted" msgstr "Nota(s) eliminada(s)" #: resourcestr.rsnotesinsnap msgid "Notes in Snapshot" msgstr "Notas en instantánea" #: resourcestr.rsnotpresent msgctxt "resourcestr.rsnotpresent" msgid "Not present in main repo" msgstr "No está en el repositorio principal" #: resourcestr.rsnumbnotesaffected #, object-pascal-format msgid "This will affect %d notes" msgstr "Esto afectará %d notas." #: resourcestr.rsonenotebook msgctxt "resourcestr.rsonenotebook" msgid "Settings allow only one Notebook" msgstr "Preferencias permiten un solo cuaderno" #: resourcestr.rsoverwritenote msgctxt "resourcestr.rsoverwritenote" msgid "Overwrite newer version of that note" msgstr "Sobrescribir la versión más nueva de la nota" #: resourcestr.rspressclose msgctxt "resourcestr.rspressclose" msgid "Press Close" msgstr "Pulse Cerrar" #: resourcestr.rsrecoverok msgctxt "resourcestr.rsrecoverok" msgid "OK, File recovered." msgstr "Archivo recuperado." #: resourcestr.rsrenamefailed msgctxt "resourcestr.rsrenamefailed" msgid "ERROR, could not rename Backup File " msgstr "ERROR: No se pudo renombrar el Archivo de Seguridad " #: resourcestr.rsrollbackintro msgid "You can roll back to previous version of this note" msgstr "Puede volver a la versión anterior de esta nota" #: resourcestr.rsrunningsync msgctxt "resourcestr.rsrunningsync" msgid "Running Sync" msgstr "Sincronizando" #: resourcestr.rssaveandsync msgctxt "resourcestr.rssaveandsync" msgid "Press Save and Sync if this looks OK" msgstr "Pulse Guardar y Sincronizar si todo le parece bien" #: resourcestr.rsscanremote msgid "Scanning remote files" msgstr "Escaneando archivos remotos" #: resourcestr.rssearchhint msgctxt "resourcestr.rssearchhint" msgid "Exact matches for terms between \" \"" msgstr "Búsqueda exacta para términos entre \" \"" #: resourcestr.rssetthenotebooks msgctxt "resourcestr.rssetthenotebooks" msgid "Set the notebooks this note is a member of" msgstr "Establezca los cuadernos a cuales pertenece esta nota" #: resourcestr.rssetup msgctxt "resourcestr.rssetup" msgid "Setup" msgstr "Configurar" #: resourcestr.rssetupnotesdirfirst msgctxt "resourcestr.rssetupnotesdirfirst" msgid "Please setup a notes directory first" msgstr "Primero establezca un directorio para notas" #: resourcestr.rssetupsyncfirst msgctxt "resourcestr.rssetupsyncfirst" msgid "Please config sync system first" msgstr "Primero configure el sistema de sincronización" #: resourcestr.rssnapshotcreated msgctxt "resourcestr.rssnapshotcreated" msgid "created, do you want to copy it elsewhere ?" msgstr "creada. ¿Quiere copiarla en otro sitio?" #: resourcestr.rssyncerror msgctxt "resourcestr.rssyncerror" msgid "A Sync Error occurred" msgstr "Error de sincronización" #: resourcestr.rssyncnotconfig msgctxt "resourcestr.rssyncnotconfig" msgid "not configured" msgstr "sin configurar" #: resourcestr.rstestingcredentials msgid "Testing Credentials" msgstr "Probando credenciales" #: resourcestr.rstestingrepo msgctxt "resourcestr.rstestingrepo" msgid "Testing Repo ...." msgstr "Probando repositorio ..." #: resourcestr.rstestingsync msgctxt "resourcestr.rstestingsync" msgid "Testing Sync" msgstr "Probando sincronización" #: resourcestr.rstryrecover_1 msgid "Try to recover a bad note by double clicking below," msgstr "Intente recuperar una nota corrompida con clic doble abajo," #: resourcestr.rstryrecover_2 msgctxt "resourcestr.rstryrecover_2" msgid "if that fails, you may be able to recover it from a Snapshot." msgstr "si falla, puede que se pueda recuperar desde una instantánea." #: resourcestr.rsunabletoproceed msgctxt "resourcestr.rsunabletoproceed" msgid "Unable to proceed because" msgstr "No se puede continuar porque" #: resourcestr.rsunabletosync msgctxt "resourcestr.rsunabletosync" msgid "Unable to sync because " msgstr "No se puede sincronizar porque " # Supongo notas #: resourcestr.rsuploaded msgid "Uploaded" msgstr "Subidas" #: resourcestr.rsuploading msgid "Uploading" msgstr "Subiendo" #: resourcestr.rswarnnossystray msgid "WARNING, your Desktop might not display SysTray" msgstr "AVISO: Puede que su Escritorio no muestre la SysTray" #: resourcestr.rswehavesnapshots #, object-pascal-format msgid "We have %d snapshots" msgstr "Hay %d instantáneas" # Creo que está bien. #: settings.rsdictionaryfailed msgid "Library Not Loaded" msgstr "Biblioteca no cargada" #: settings.rsdictionaryloaded msgid "Dictionary Loaded OK" msgstr "Diccionario cargada OK" # ¿Revisar? #: settings.rsdictionarynotfound msgid "No Dictionary Found" msgstr "Ningún diccionario encontrado" #: settings.rsdirhasnonotes msgid "That directory does not contain any notes. That is OK, if I can make my own there." msgstr "El directorio no tiene ninguna nota. Está bien, si puedo hacer las mías aquí." #: settings.rserrorcannotwrite msgid "Cannot write into" msgstr "No se puede escribir en" #: settings.rserrorcreatedir msgid "Unable to Create Directory" msgstr "No se puedo crear el directorio" #: settings.rsselectdictionary msgid "Select the dictionary you want to use" msgstr "Seleccione el directorio que quiere usar" #: settings.rsselectlibrary msgid "Select your hunspell library" msgstr "Seleccione su biblioteca Hunspell" #: spelling.rscheckingfull msgid "Checking full document" msgstr "Comprobando todo el documento" #: spelling.rscheckingselection msgid "Checking selection" msgstr "Comprobando selección" #: spelling.rsreplace_with_1 msgid "replace" msgstr "reemplazar" #: spelling.rsreplace_with_2 msgid "with" msgstr "con" #: spelling.rsspellcomplete msgid "Spell check complete" msgstr "Revisión ortográfica terminada" #: spelling.rsspellnotconfig msgid "Spelling not configured" msgstr "Ortografía sin configurar" #: syncutils.rschangeexistingsync msgid "Change existing sync connection ?" msgstr "¿Cambiar conexión de sincronización actual?" #: syncutils.rsclashes msgid "Clashes " msgstr "Conflictos" #: syncutils.rsdonothing msgid "Do Nothing " msgstr "No hacer nada" #: syncutils.rsdownloads msgid "Downloads " msgstr "Descargas" # ¿Editar las notas, la lista, cual? #: syncutils.rsedituploads msgid "Edit Uploads " msgstr "Notas cambiadas a subir" #: syncutils.rslocaldeletes msgid "Local Deletes " msgstr "Borrados locales" # Revisar #: syncutils.rsnewuploads msgid "New Uploads " msgstr "Nuevas notas para subir" #: syncutils.rsnextbitslow msgid "Next bit can be a bit slow, please wait" msgstr "El próximo paso se puede tardar. Espere por favor." #: syncutils.rsnonotesneededsync msgid "No notes needed syncing. You need to write more." msgstr "No hay notas que necesitan sincronizar. Tiene que escribir otras." # ¿Contexto? # ¿Espacio delante? #: syncutils.rsnotesweredealt msgid " notes were dealt with." msgstr " notas fueron procesadas." # ¿Y el sujeto? #: syncutils.rsnotrecommend msgid "Generally not recommended." msgstr "En general, poco aconsejable" #: syncutils.rsremotedeletes msgid "Remote Deletes " msgstr "Borrados remotos " #: syncutils.rssyncerrors msgid "ERRORS (see console log) " msgstr "ERRORES: vea registro en el terminal" #: teditboxform.buttmaintbmenu.caption msgctxt "teditboxform.buttmaintbmenu.caption" msgid "Menu" msgstr "Menú" #: teditboxform.editfind.text msgid "EditFind" msgstr "Término" #: teditboxform.label2.caption msgid "Read Only" msgstr "Sólo lectura" #: teditboxform.label3.caption msgid "This note has been changed by the Sync Process" msgstr "Esta nota ha sido cambiado por el proceso de sincronizar." #: teditboxform.label4.caption msgid "Please close it (and re-open if it was a download)" msgstr "Por favor, cierrela (y reabrirla si fue descargada)" #: teditboxform.labelfindinfo.caption msgid "LabelFindInfo" msgstr "BuscarInfo" #: teditboxform.menubold.caption msgctxt "teditboxform.menubold.caption" msgid "Bold" msgstr "Negrita" #: teditboxform.menufindnext.caption msgid "Find Next" msgstr "Buscar siguiente" #: teditboxform.menufindprev.caption msgctxt "teditboxform.menufindprev.caption" msgid "Find Prev" msgstr "Buscar anterior" #: teditboxform.menufixedwidth.caption msgid "Fixed Width" msgstr "Monoespaciada" #: teditboxform.menuhighlight.caption msgctxt "teditboxform.menuhighlight.caption" msgid "Highlight" msgstr "Resaltar" #: teditboxform.menuhuge.caption msgctxt "teditboxform.menuhuge.caption" msgid "Huge" msgstr "Enorme" #: teditboxform.menuitalic.caption msgid "Italic" msgstr "Cursiva" #: teditboxform.menuitembulletleft.caption msgid "Bullet <<" msgstr "Viñeta <<" #: teditboxform.menuitembulletright.caption msgid "Bullet >>" msgstr "Viñeta >>" #: teditboxform.menuitemcopy.caption msgid "Copy" msgstr "Copiar" #: teditboxform.menuitemcut.caption msgid "Cut" msgstr "Cortar" #: teditboxform.menuitemdelete.caption msgctxt "teditboxform.menuitemdelete.caption" msgid "Delete" msgstr "Eliminar" #: teditboxform.menuitemevaluate.caption msgid "Evaluate" msgstr "Calcular" #: teditboxform.menuitemexport.caption msgid "Export" msgstr "Exportar" #: teditboxform.menuitemexportmarkdown.caption msgid "Export Markdown" msgstr "Exportar Markdown" #: teditboxform.menuitemexportplaintext.caption msgid "Export Plain Text" msgstr "Exportar texto plano" #: teditboxform.menuitemexportrtf.caption msgid "Export RTF" msgstr "Exportar RTF" #: teditboxform.menuitemfind.caption msgid "Find in this Note" msgstr "Buscar en esta nota" #: teditboxform.menuitemindex.caption msgid "Index" msgstr "Indizar" #: teditboxform.menuitempaste.caption msgid "Paste" msgstr "Pegar" #: teditboxform.menuitemprint.caption msgid "Print" msgstr "Imprimir" #: teditboxform.menuitemselectall.caption msgid "Select All" msgstr "Seleccionar todo" #: teditboxform.menuitemsettings.caption msgctxt "teditboxform.menuitemsettings.caption" msgid "Settings" msgstr "Preferencias" #: teditboxform.menuitemspell.caption msgid "Spell Check" msgstr "Revisar ortográfica" #: teditboxform.menuitemsync.caption msgid "Synchronize" msgstr "Sincronizar" #: teditboxform.menularge.caption msgid "Large Font" msgstr "Fuente grande" #: teditboxform.menunormal.caption msgid "Normal Font" msgstr "Fuente normal" #: teditboxform.menusmall.caption msgid "Small Font" msgstr "Fuente pequeña" #: teditboxform.menustayontop.caption msgid "Stay On Top" msgstr "Siempre encima" #: teditboxform.menustrikeout.caption msgid "Strikeout" msgstr "Tachado" #: teditboxform.menuunderline.caption msgid "Underline" msgstr "Subrayado" #: teditboxform.speedbuttondelete.hint msgid "Delete this note" msgstr "Eliminar esta nota" #: teditboxform.speedbuttonlink.hint msgid "Link highlighted text to a new note" msgstr "Vincular texto resaltado a una nota nueva" #: teditboxform.speedbuttonnotebook.hint msgid "Manage Notebooks" msgstr "Gestionar cuadernos" #: teditboxform.speedbuttonsearch.hint msgid "Search All Notes Ctrl-Shift-F" msgstr "Buscar en todas las notas: Ctrl-Shift-F" #: teditboxform.speedbuttontext.hint msgid "Font size, bold, italics etc" msgstr "Fuente: tamaño, negrita, cursiva, etc" #: teditboxform.speedbuttontools.hint msgid "Tools - Sync, Export, Spell" msgstr "Herramientas - Sincronizar, Exportar, Ortografía" #: teditboxform.speedrollback.hint msgid "Roll Back" msgstr "Volver a la anterior" #: tformbackupview.buttondelete.caption msgctxt "tformbackupview.buttondelete.caption" msgid "Delete" msgstr "Eliminar" #: tformbackupview.buttondelete.hint msgid "Really, totally delete this note." msgstr "Eliminar esta nota completamente." #: tformbackupview.buttonok.caption msgctxt "tformbackupview.buttonok.caption" msgid "Close" msgstr "Cerrar" #: tformbackupview.buttonok.hint msgid "My work here is done." msgstr "Mi trabajo aquí se ha terminado." #: tformbackupview.buttonopen.caption msgid "View" msgstr "Ver" #: tformbackupview.buttonopen.hint msgid "Open and view the whole note" msgstr "Abrir y ver la nota entera" #: tformbackupview.buttonrecover.caption msgctxt "tformbackupview.buttonrecover.caption" msgid "Recover" msgstr "Recuperar" #: tformbackupview.buttonrecover.hint msgid "Restore this note to main repo" msgstr "Restaurar esta nota al repositorio principal" #: tformbackupview.caption msgid "View, recover or delete Backup Files" msgstr "Ver, recuperar o elimina copias de seguridad" #: tformbackupview.listbox1.hint msgid "Use Ctrl or Shift to select multiple entries" msgstr "Seleccione entradas múltiples con Ctrl o Mayús " #: tformcolours.label1.caption msgid "Sample" msgstr "Muestra" #: tformcolours.label2.caption msgctxt "tformcolours.label2.caption" msgid "Set Colours" msgstr "Establecer colores" #: tformcolours.speedbackground.caption msgid "Background" msgstr "Fondo" #: tformcolours.speedcancel.caption msgctxt "tformcolours.speedcancel.caption" msgid "Cancel" msgstr "Cancelar" #: tformcolours.speeddefault.caption msgid "Default" msgstr "Defecto" #: tformcolours.speedhighlight.caption msgctxt "tformcolours.speedhighlight.caption" msgid "Highlight" msgstr "Resaltar" #: tformcolours.speedok.caption msgctxt "tformcolours.speedok.caption" msgid "OK" msgstr "OK" #: tformcolours.speedtext.caption msgid "Text" msgstr "Texto" #: tformcolours.speedtitle.caption msgctxt "tformcolours.speedtitle.caption" msgid "Title" msgstr "Título" #: tformindex.caption msgid "Heading in this Note" msgstr "Cabecera de esta nota" #: tformindex.panel1.caption msgid "Single lines, all Huge, Large Bold or Large" msgstr "Líneas únicas, todas Enormes, Grandes-Negritas o Grandes" #: tformrecover.buttondeletebadnotes.caption msgid "Delete Bad Notes" msgstr "Eliminar Notas Corrompidas" #: tformrecover.buttonmakesafetysnap.caption msgid "Take a manual Snapshot" msgstr "Hacer una instantánea manual" #: tformrecover.buttonmakesafetysnap.hint msgid "Take a initial snapshot of your notes and config. Overwritten each time." msgstr "Haga una instantánea de sus notas y configuración. Sobrescrita cada vez." #: tformrecover.buttonrecoversnap.caption msgctxt "tformrecover.buttonrecoversnap.caption" msgid "Recover" msgstr "Recuperar" #: tformrecover.buttonsnaphelp.caption msgid "Snapshot Help" msgstr "Ayuda para Instantaneas" #: tformrecover.label10.caption msgid "Please close any notes you may have open." msgstr "Por favor, si hay notas abiertas, ciérrelas." #: tformrecover.label12.caption msgid "Don't even consider this unless you have a backup Snapshot, Intro Tab." msgstr "Ni pensarlo sin tener una instantánea de seguridad reciente. (Pestaña \\\"Introducción\\\")" #: tformrecover.label14.caption msgid "Click an available snapshot to see its contents." msgstr "Haga clic en una instantánea para ver los contenidos." #: tformrecover.label15.caption msgid "Click an available snapshot, click Recover" msgstr "Haga clic primero en una instantánea, luego en Recuperar." #: tformrecover.label16.caption msgid "You may chose to view, copy and paste into a new note." msgstr "Puede elegir ver, copiar y pegar en una nota nueva." #: tformrecover.label2.caption msgid "Please be careful, this is a dangerous place!" msgstr "Por favor ¡tenga cuidado! ¡Es un sitio peligroso!" #: tformrecover.label3.caption msgid "Restore any notes in the snapshot that are not in the existing notes directory." msgstr "Restaurar las notas de la instantánea que no están en el directorio de notas." #: tformrecover.label4.caption msgid "Remove all existing notes and use the ones in the Snapshot." msgstr "Remove all existing notes and use the ones in the Snapshot." #: tformrecover.label5.caption msgid "Looking for notes with damaged XML" msgstr "Buscando notas con el XML corrompido" #: tformrecover.label6.caption msgid "This tool might help you recover lost or damaged notes." msgstr "Esta herramienta puede ayudarle recuperar las notas." #: tformrecover.label7.caption msgid "Before you start, take a Snapshot of your notes directory." msgstr "Antes de empezar, haga un instantánea de las notas." #: tformrecover.label9.caption msgid "From here you can view snapshot notes, one by one." msgstr "Aquí puede ver las notas de la instantánea una por una." #: tformrecover.listboxsnapshots.hint msgid "These are the currently known snapshots. " msgstr "Éstas son las instantáneas actuales encontradas. " #: tformrecover.panelsnapshots.caption msgid "Available Snapshots" msgstr "Instantáneas disponibles" #: tformrecover.tabsheetbadnotes.caption msgid "Bad Notes" msgstr "Notas corrumpidas" #: tformrecover.tabsheetintro.caption msgid "Introduction" msgstr "Introducción" #: tformrecover.tabsheetmergesnapshot.caption msgid "Merge Snapshot" msgstr "Combinar Instantánea" #: tformrecover.tabsheetrecovernotes.caption msgid "Recover Notes" msgstr "Recuperar notas" #: tformrecover.tabsheetrecoversnapshot.caption msgid "Recover Snapshot" msgstr "Recuperar notas" #: tformrollback.speedcancel.caption msgctxt "tformrollback.speedcancel.caption" msgid "Cancel" msgstr "Cancelar" #: tformrollback.speedrolltoopen.caption msgid "Opening Backup" msgstr "Abriendo copia de seguridad" #: tformrollback.speedrolltotitle.caption msgid "Title Change Backup" msgstr "Copia por cambio de título" #: tformsdiff.bitbtnuselocal.caption msgid "Use Local" msgstr "Usar Local" #: tformsdiff.bitbtnuseremote.caption msgid "Use Remote" msgstr "Usar Remota" #: tformsdiff.buttalllocal.caption msgid "Local" msgstr "Local" #: tformsdiff.buttallnewest.caption msgid "Newest" msgstr "Más reciente" #: tformsdiff.buttalloldest.caption msgid "Oldest" msgstr "Más vieja" #: tformsdiff.buttallremote.caption msgid "Remote" msgstr "Remota" #: tformsdiff.caption msgid "A Note Sync Clash has been Detected" msgstr "Se ha detectado un conflicto entre notas" #: tformsdiff.label1.caption msgid "Or make a choice for remainder of this run" msgstr "O seleccione una opción para el proceso" #: tformsdiff.label3.caption msgid "Remote Changed" msgstr "Nota remota cambiada" #: tformsdiff.label4.caption msgid "Local Changed" msgstr "Nota local cambiada" #: tformsdiff.radiolong.caption msgid "Long Lines" msgstr "Líneas largas" #: tformsdiff.radiolong.hint msgid "Maybe necessary to show difference" msgstr "Quizás hace falta mostrar la diferencia" #: tformsdiff.radioshort.caption msgid "Short Lines" msgstr "Líneas cortas" #: tformsdiff.radioshort.hint msgid "Easier to read" msgstr "Más fácil de leer" #: tformspell.buttonignore.caption msgid "Ignore" msgstr "Omitir todas" #: tformspell.buttonignore.hint msgid "Ignore all instances for the run" msgstr "Omitir todas las instancias" #: tformspell.buttonskip.caption msgid "Skip" msgstr "Omitir una vez" #: tformspell.buttonskip.hint msgid "Skip just this instance" msgstr "Omitir sola esta instancia" #: tformspell.buttonuseandnextword.caption msgid "Use and Next Word" msgstr "Usar y sigiente palabra" #: tformspell.caption msgctxt "tformspell.caption" msgid "Spell" msgstr "Ortografía" #: tformspell.label4.caption msgid "Suspect word -" msgstr "Palabra dudosa -" #: tformspell.labelprompt.caption msgid "Click a word to use it." msgstr "Haga clic en una palabra." #: tformsync.buttoncancel.caption msgctxt "tformsync.buttoncancel.caption" msgid "Cancel" msgstr "Cancelar" #: tformsync.buttonclose.caption msgctxt "tformsync.buttonclose.caption" msgid "Close" msgstr "Cerrar" #: tformsync.buttonsave.caption msgid "Save and Sync" msgstr "Guardar y sincronizar" #: tformsync.caption msgctxt "tformsync.caption" msgid "Sync" msgstr "Sincronizar" #: tformsync.labelprogress.caption msgid "LabelProgress" msgstr "EtiquetaProgre" #: tformsync.listviewreport.columns[0].caption msgid "Action" msgstr "Acción" #: tformsync.listviewreport.columns[1].caption msgctxt "tformsync.listviewreport.columns[1].caption" msgid "Title" msgstr "Título" #: tformsync.listviewreport.columns[2].caption msgid "Note ID" msgstr "ID nota" #: tformtomdroid.buttonclose.caption msgctxt "tformtomdroid.buttonclose.caption" msgid "Close" msgstr "Cerrar" #: tformtomdroid.buttondelete.caption msgid "Delete Profile" msgstr "Delete Profile" #: tformtomdroid.buttonhelp.caption msgctxt "tformtomdroid.buttonhelp.caption" msgid "Help" msgstr "Ayuda" #: tformtomdroid.buttonjoin.caption msgctxt "tformtomdroid.buttonjoin.caption" msgid "Join" msgstr "Unirse" #: tformtomdroid.buttonsaveprofile.caption msgid "Save Profile" msgstr "Guardar perfil" #: tformtomdroid.buttonsync.caption msgctxt "tformtomdroid.buttonsync.caption" msgid "Sync" msgstr "Sincronizar" #: tformtomdroid.caption msgctxt "tformtomdroid.caption" msgid "Tomdroid" msgstr "Tomdroid" #: tformtomdroid.checkboxdebugmode.caption msgid "Debug Mode" msgstr "Modo de depuración" #: tformtomdroid.checkboxdebugmode.hint msgid "writes debug messages to terminal" msgstr "escribe mensajes de depuración al terminal" #: tformtomdroid.checkboxtestrun.caption msgctxt "tformtomdroid.checkboxtestrun.caption" msgid "Test Run" msgstr "Prueba" #: tformtomdroid.checksavepassword.caption msgctxt "tformtomdroid.checksavepassword.caption" msgid "Save" msgstr "Guardar" #: tformtomdroid.editprofilename.hint msgid "eg MySamsungNote7" msgstr "ej., MySamsungNote7" #: tformtomdroid.label1.caption msgid "Tomdroid SSH Sync - deprecated, will be dropped soon." msgstr "Sincronización Tomdroid SSH - obsoleto, se elimina pronto." #: tformtomdroid.label2.caption msgid "Select an existing profile (or enter data) " msgstr "Seleccione un perfil existente (o entre datos) " #: tformtomdroid.label3.caption msgid "Profile Name" msgstr "Nombre del perfil" #: tformtomdroid.label4.caption msgid "IP address of device" msgstr "Dirección IP del dispositivo" #: tformtomdroid.label5.caption msgid "SSH Password for device" msgstr "SSH Password for device" #: tformtomdroid.label6.caption msgctxt "tformtomdroid.label6.caption" msgid "Upload means from tomboy-ng to Android Device" msgstr "Subir significa de tomboy-ng a un dispositivo Android" #: tformtomdroidfile.buttonclose.caption msgctxt "tformtomdroidfile.buttonclose.caption" msgid "Close" msgstr "Cerrar" #: tformtomdroidfile.buttonhelp.caption msgctxt "tformtomdroidfile.buttonhelp.caption" msgid "Help" msgstr "Ayuda" #: tformtomdroidfile.buttonjoin.caption msgctxt "tformtomdroidfile.buttonjoin.caption" msgid "Join" msgstr "Unirse" #: tformtomdroidfile.buttonoldssh.caption msgid "Use old SSH model" msgstr "Usar método SSH" #: tformtomdroidfile.buttonsync.caption msgctxt "tformtomdroidfile.buttonsync.caption" msgid "Sync" msgstr "Sincronizar" #: tformtomdroidfile.caption msgctxt "tformtomdroidfile.caption" msgid "Tomdroid" msgstr "Tomdroid" #: tformtomdroidfile.checkboxtestrun.caption msgctxt "tformtomdroidfile.checkboxtestrun.caption" msgid "Test Run" msgstr "Prueba" #: tformtomdroidfile.label1.caption msgid "Tomdroid Sync - be aware of limitations !" msgstr "Sincronización Tomdroid - ¡dese cuenta de las limitaciones!" #: tformtomdroidfile.label6.caption msgctxt "tformtomdroidfile.label6.caption" msgid "Upload means from tomboy-ng to Android Device" msgstr "Subir significa de tomboy-ng a un dispositivo Android" #: tmainform.bitbtnhide.caption msgid "Hide" msgstr "Ocultar" #: tmainform.bitbtnquit.caption msgctxt "tmainform.bitbtnquit.caption" msgid "Quit" msgstr "Salir" #: tmainform.buttmenu.caption msgctxt "tmainform.buttmenu.caption" msgid "Menu" msgstr "Menú" #: tmainform.buttsystrayhelp.caption msgid "SysTray Help" msgstr "Ayuda, SysTray" #: tmainform.caption msgid "tomboy-ng" msgstr "Bienvenida a tomboy-ng" #: tmainform.checkboxdontshow.caption msgid "Don't Show for normal startup" msgstr "No mostrar al inicio" #: tmainform.checkboxdontshow.hint msgid "You can reverse this from Settings" msgstr "You can reverse this from Settings" #: tmainform.hint msgid "If the yellow tomboy-ng icon is visible in your System Tray, you can dismiss this window." msgstr "Si el icono amarillo de tomboy-ng se puede ver in la bandeja del sistema, puede despachar esta ventana." #: tmainform.label3.caption msgid "Dictionary Config (optional)" msgstr "Configuración del diccionario (opcional)" #: tmainform.label4.caption msgid "Sync Config (optional)" msgstr "Configuración de sincronización (opcional)" #: tmainform.label5.caption msgid "Welcome to tomboy-ng !" msgstr "¡Bienvenido a tomboy-ng!" #: tmainform.labelerror.hint msgid "Launch from commandline to see errors or see Config->SnapShot->Recover ..." msgstr "Lanzar desde la terminal para ver errores o ir a Preferencias->Instantánea->Recuperar ..." #: tnotebookpick.button1.caption msgctxt "tnotebookpick.button1.caption" msgid "Cancel" msgstr "Cancelar" #: tnotebookpick.buttonok.caption msgctxt "tnotebookpick.buttonok.caption" msgid "OK" msgstr "OK" #: tnotebookpick.label4.caption msgid "Name of the New Notebook" msgstr "Nombre del cuaderno nuevo" #: tnotebookpick.label5.caption msgid "Press OK and we will make the Note Book AND add this note to it." msgstr "Pulse OK y crearemos el cuaderno y añadiremos esta nota a ello." #: tnotebookpick.label6.caption msgid "Existing Name" msgstr "Nombre actual" #: tnotebookpick.label8.caption msgid "New Name" msgstr "Nuevo nombre" #: tnotebookpick.label9.caption msgid "If you sync and are not absolutely sure its up to date, Cancel now !" msgstr "Si no está seguro que todo está al día, cancele la sincronización ¡ahora!" #: tnotebookpick.tabchangename.caption msgid "Change Notebook Name" msgstr "Cambiar nombre del cuaderno" #: tnotebookpick.tabexisting.caption msgid "Existing Note Books" msgstr "Cuadernos actuales" #: tnotebookpick.tabnewnotebook.caption msgid "New Note Book" msgstr "Cuaderno nuevo" #: tnotebookpick.tabsetnotes.caption msgid "Set Notes" msgstr "Establecer notas" #: tomdroid.rscheckingforexistingsync msgctxt "tomdroid.rscheckingforexistingsync" msgid "Checking for an existing sync ...." msgstr "Comprobando si ya hay una sincronización ..." #: tomdroid.rsconnectiongood msgctxt "tomdroid.rsconnectiongood" msgid "Connection is looking Good." msgstr "La conexión parece ser buena." #: tomdroid.rsfailedtoconnect msgctxt "tomdroid.rsfailedtoconnect" msgid "Failed to connect." msgstr "No se conectó." #: tomdroid.rsfailedtofindconnection_1 msgctxt "tomdroid.rsfailedtofindconnection_1" msgid "Failed to find an existing connection." msgstr "o se encontró ninguna conexión." #: tomdroid.rsfailedtofindconnection_2 msgctxt "tomdroid.rsfailedtofindconnection_2" msgid "If you are sure there should be an existing connection, check settings." msgstr "Si cree que debería ser una conexión existente, compruebe las preferencias." #: tomdroid.rsfailedtofindconnection_3 msgctxt "tomdroid.rsfailedtofindconnection_3" msgid "Otherwise, try joining a new connection." msgstr "De lo contrario, intente unirse a una conexión nueva." #: tomdroid.rsfixconnection msgctxt "tomdroid.rsfixconnection" msgid "If you are sure its there, check settings." msgstr "Si cree que está allí, compruebe las preferencias." #: tomdroid.rshavevalidsync msgctxt "tomdroid.rshavevalidsync" msgid "Looking Good. Last sync date " msgstr "Parece bien. Fecha de la última sincronización " #: tomdroid.rsinstalltomdroid msgctxt "tomdroid.rsinstalltomdroid" msgid "Install Tomdroid, config filesync, and run a sync" msgstr "Instale Tomdroid, configure la sincronización, y sincronize" #: tomdroid.rsnoconnection msgctxt "tomdroid.rsnoconnection" msgid "Failed to establish a connection. " msgstr "No se pudo conectar. " #: tomdroid.rsnotcorrectprofile msgctxt "tomdroid.rsnotcorrectprofile" msgid "This is not correct profile for that device" msgstr "No es el perfil correcto para el dispositivo" #: tomdroid.rsnotexistingrepo msgctxt "tomdroid.rsnotexistingrepo" msgid "That's not an existing Repo, maybe click \"Join\" ?" msgstr "No existe el Repositorio, ¿tal vez hacer clic en \"Unirse\"?" #: tomdroid.rsnotomdroid msgctxt "tomdroid.rsnotomdroid" msgid "Unable to find Tomdroid sync dir on that device." msgstr "No se encontró directorio de sincronización en el dispositivo." #: tomdroid.rsselectprofile msgid "Select a profile" msgstr "Seleccione un perfil" #: tomdroid.rssetupnewsync msgctxt "tomdroid.rssetupnewsync" msgid "Setting up a new sync ...." msgstr "Estableciendo un sincronización nueva ..." #: tomdroid.rstalkingtodevice msgctxt "tomdroid.rstalkingtodevice" msgid "OK, talking to device. Wait for it ...." msgstr "OK, comunicando con es dispositivo. Espere ..." #: tomdroidfile.rsconnectiongood msgctxt "tomdroidfile.rsconnectiongood" msgid "Connection is looking Good." msgstr "La conexión parece ser buena." #: tomdroidfile.rsfailedtoconnect msgctxt "tomdroidfile.rsfailedtoconnect" msgid "Failed to connect." msgstr "No se conectó." #: tomdroidfile.rsfailedtofindconnection_2 msgctxt "tomdroidfile.rsfailedtofindconnection_2" msgid "If you are sure there should be an existing connection, check settings." msgstr "Si cree que debería haber sido una conexión , compruebe las preferencias." #: tomdroidfile.rsfixconnection msgctxt "tomdroidfile.rsfixconnection" msgid "If you are sure its there, check settings." msgstr "Si cree que está allí, compruebe las preferencias." #: tomdroidfile.rshavevalidsync msgctxt "tomdroidfile.rshavevalidsync" msgid "Looking Good. Last sync date " msgstr "Parece bien. Fecha de la última sincronización " #: tomdroidfile.rsinstalltomdroid msgctxt "tomdroidfile.rsinstalltomdroid" msgid "Install Tomdroid, config filesync, and run a sync" msgstr "Instale Tomdroid, configure la sincronización, y sincronize" #: tomdroidfile.rsjoinanyway msgid "Forcing a Join may \"recover\" some notes you thought you have deleted." msgstr "Forzar \"Unirse\" puede que \"recupere\" notas que pensó haber sido eliminadas." #: tomdroidfile.rsnoconnection msgctxt "tomdroidfile.rsnoconnection" msgid "Failed to establish a connection. " msgstr "No se conectó. " #: tomdroidfile.rsnotcorrectprofile msgctxt "tomdroidfile.rsnotcorrectprofile" msgid "This is not correct profile for that device" msgstr "No es el perfil correcto para el dispositivo" #: tomdroidfile.rsnotexistingrepo msgctxt "tomdroidfile.rsnotexistingrepo" msgid "That's not an existing Repo, maybe click \"Join\" ?" msgstr "El repositorio no existe, ¿tal vez hacer clic en \"Unirse\"?" #: tomdroidfile.rsnotomdroid msgctxt "tomdroidfile.rsnotomdroid" msgid "Unable to find Tomdroid sync dir on that device." msgstr "No se encontró directorio de sincronización en el dispositivo." #: tomdroidfile.rssetupnewsync msgctxt "tomdroidfile.rssetupnewsync" msgid "Setting up a new sync ...." msgstr "Estableciendo un sincronización nueva ..." #: tomdroidfile.rstalking msgctxt "tomdroidfile.rstalking" msgid "OK, talking to device. Wait for it ...." msgstr "OK, comunicando con el dispositivo. Espere ..." #: tsearchform.buttonclearfilters.caption msgid "Clear Filters" msgstr "Quitar filtros" #: tsearchform.buttonmenu.caption msgctxt "tsearchform.buttonmenu.caption" msgid "Menu" msgstr "Menú" #: tsearchform.buttonrefresh.caption msgid "Refresh" msgstr "Actualizar" #: tsearchform.buttonrefresh.hint msgid "Update Search Results" msgstr "Actualizar resultados" #: tsearchform.caption msgid "tomboy-ng_Search" msgstr "Búsqueda de tombo-ng" #: tsearchform.checkautorefresh.caption msgid "Auto Refresh" msgstr "Actualización automática" #: tsearchform.checkcasesensitive.caption msgid "Case Sensitive" msgstr "Sensible a mayúsculas" #: tsearchform.listboxnotebooks.hint msgid "Right Click to manage Notebooks" msgstr "Clic derecho para gestionar cuadernos" #: tsearchform.menucreatenotebook.caption msgid "Create new Note Book" msgstr "Crear cuaderno nuevo" #: tsearchform.menudeletenotebook.caption msgid "Delete Notebook" msgstr "Eliminar cuaderno" #: tsearchform.menueditnotebooktemplate.caption msgid "Edit Notebook Template" msgstr "Editar plantilla del cuaderno" #: tsearchform.menuitemmanagenbook.caption msgid "Manage Notes in Note Book" msgstr "Gestionar las notas en el cuaderno" #: tsearchform.menunewnotefromtemplate.caption msgid "Create New Note from Template" msgstr "Crear nota nueva desde una plantilla" #: tsearchform.menurenamenotebook.caption msgid "Rename NoteBook" msgstr "Renombrar cuaderno" #: tsearchform.panel2.caption msgctxt "tsearchform.panel2.caption" msgid "Notebooks" msgstr "Cuadernos" #: tsett.buttdefaultnotedir.caption msgid "Use Default Notes Location" msgstr "Usar Ubicación Predeterminada" #: tsett.buttdefaultnotedir.hint msgid "Will work for many new users" msgstr "Funcionará para muchos usuarios nuevos" #: tsett.buttonfixedfont.caption msgid "Fixed Font" msgstr "Fuente monoespaciada" #: tsett.buttonfont.caption msgid "Usual Font" msgstr "Fuente habitual" #: tsett.buttonmanualsnap.caption msgid "Take a Manual Snapshot" msgstr "Hacer una Instantánea Manual" #: tsett.buttonmanualsnap.hint msgid "Take a time stamped snapshot of notes and config" msgstr "Hacer una instantánea de notas, preferencias con fecha de creación" #: tsett.buttonsetcolours.caption msgctxt "tsett.buttonsetcolours.caption" msgid "Set Colours" msgstr "Establecer colores" #: tsett.buttonsetdictionary.caption msgid "Set Dictionary" msgstr "Establecer Diccionario" #: tsett.buttonsetnotepath.caption msgid "Set Path to Note Files" msgstr "Establecer Ruta a las Notas" #: tsett.buttonsetnotepath.hint msgid "If you have notes somewhere else" msgstr "Si tienes notas en otro sitio" #: tsett.buttonsetspelllibrary.caption msgid "Set Spell Library" msgstr "Establecer Biblioteca Ortográfica" #: tsett.buttonshowbackup.caption msgid "Show Me" msgstr "Ver nota(s)" #: tsett.buttonsnaprecover.caption msgid "Recover Lost Notes" msgstr "Recuperar notas perdidas" #: tsett.buttonsnaprecover.hint msgid "If you have previously taken a snapshot ..." msgstr "Si has hecho una instantánia antes ..." #: tsett.checkautosnapenabled.caption msgid "Use auto snapshots" msgstr "Use instantáneas automáticas" #: tsett.checkautostart.caption msgid "Autostart at Logon" msgstr "Ejecutar al iniciar sesión" #: tsett.checkboxautosync.caption msgid "Auto Sync" msgstr "Sincronización automática" #: tsett.checkboxautosync.hint msgid "Sync, if possible once an hour." msgstr "Sincronizar cada hora si es posible" #: tsett.checkmanynotebooks.caption msgid "Allow a Note to be in Multiple Notebooks." msgstr "Permitir que una nota aparece en más de un cuaderno." #: tsett.checkmanynotebooks.hint msgid "This may adversly affect traditional Tomboy, take care." msgstr "Puede que perjudique Tomboy tradicional. Tenga cuidado." #: tsett.checknotifications.caption msgid "Show Notifications" msgstr "Mostrar Notificaciones" #: tsett.checkshowextlinks.caption msgid "Show External Links" msgstr "Mostrar Enlaces Externos" #: tsett.checkshowintlinks.caption msgid "Show Internal Links" msgstr "Mostrar Enlaces Internos" #: tsett.checkshowsearchatstart.caption msgid "Show Search at Start" msgstr "Mostrar Búsqueda al iniciar" #: tsett.checkshowsplash.caption msgid "Show Splash at Start" msgstr "Mostrar Bienvenida al iniciar" #: tsett.checkshowsplash.hint msgid "Always shown if error loading notes." msgstr "Se muestra siempre si hay un error al cargar las notas." #: tsett.checkshowtomdroid.caption msgid "Show Tomdroid Sync (experimental)" msgstr "Mostrar Sincronización Tomdroid (experimental)" #: tsett.checkstampbold.caption msgctxt "tsett.checkstampbold.caption" msgid "Bold" msgstr "Negrita" #: tsett.checkstampitalics.caption msgid "Italics" msgstr "Cursiva" #: tsett.checkstampsmall.caption msgctxt "tsett.checkstampsmall.caption" msgid "Small" msgstr "Pequeña" #: tsett.checksyncenabled.caption msgid "Sync Enabled" msgstr "Sincronización habilitada" #: tsett.checkuseundo.caption msgid "Use Undo Redo (may slow editing)" msgstr "Usar Deshacer-Rehacer (podría ralentizar redacción)" #: tsett.checkuseundo.hint msgid "Close and reopen a note to take effect. Use Ctrl-Z Ctrl-Y" msgstr "Cierre y reabra una nota para que tenga efecto. Use Ctrl-Z Ctrl-Y" #: tsett.combosynctype.text msgid "ComboSyncType" msgstr "TipoSincCombi" #: tsett.editusername.text msgid "EditUserName" msgstr "CambiarNombre" #: tsett.groupbox4.caption msgid " Options " msgstr " Opciones " #: tsett.groupbox5.caption msgid "Font Size" msgstr "Tamaño de la fuente" #: tsett.groupboxsync.caption msgid " Sync " msgstr " Sincronizar " #: tsett.label1.caption msgid "Settings will be saved in :" msgstr "Preferencias se guardarán en:" #: tsett.label10.caption msgid "Help Notes Language" msgstr "Idioma de las notas de ayuda" #: tsett.label11.caption msgid "Backup Files" msgstr "Archivos de seguridad" #: tsett.label13.caption msgid "Spell Check requires the Hunspell Libraries and" msgstr "Revisión ortográfica requiere las bibliotecas de Hunspell y" #: tsett.label14.caption msgid "an appropriate Hunspell Dictionary set." msgstr "un diccionario Hunspell apropiado." #: tsett.label16.caption msgid "Maximum number of snapshots" msgstr "Número máximo de instantáneas" #: tsett.label17.caption msgid "Date Stamp Format" msgstr "Formato del sello con la fecha" #: tsett.label2.caption msgid "Notes will be looked for and saved in :" msgstr "Notes will be looked for and saved in :" #: tsett.label3.caption msgid "When a conflict is detected between a local note and remote one :" msgstr "Al detectar un conflicto entre una nota local y una remota:" #: tsett.label4.caption msgid "Repo : " msgstr "Repositorio:" #: tsett.label5.caption msgid "Days per snapshot" msgstr "Días por instantánea" #: tsett.label6.caption msgid "Backup files are made when you delete a note or the sync system" msgstr "Se crean copias de seguridad cuando se borra una nota o el sistema de sincronización" #: tsett.label7.caption msgid "is about to overwrite one. " msgstr "está a punto de sobreescribir una. " #: tsett.label8.caption msgid "They remain, forever, unless you do something about them." msgstr "Estas notas se quedan para siempre, al meno que haga algo al respecto." #: tsett.label9.caption msgid "A snaphot is a copy of your current note directory." msgstr "Una instantánea es una copia de sus notas actuales." #: tsett.labellabeltoken.caption msgctxt "tsett.labellabeltoken.caption" msgid "Token" msgstr "Autentificador" #: tsett.labelsnapdir.caption msgid "Snap dir" msgstr "Directorio, instantáneas" #: tsett.labelsyncinfo1.caption msgid "LabelSyncInfo1" msgstr "EtiquetaSincInfo1" #: tsett.labelsyncinfo2.caption msgid "LabelSyncInfo2" msgstr "EtiquetaSincInfo2" #: tsett.labelsyncrepo.caption msgctxt "tsett.labelsyncrepo.caption" msgid "not configured" msgstr "sin configurar" # ¿Se puede ser más corto? ¿como solamente tipo? #: tsett.labelsynctype.caption msgid "Sync Type" msgstr "Tipo sincronización" #: tsett.labeltoken.caption msgid "LabelToken" msgstr "EtiquetaAuten" #: tsett.labelusername.caption msgid "User" msgstr "Usuario" #: tsett.radioalwaysask.caption msgid "Always Ask me what to do." msgstr "Siempre preguntarme que hacer." #: tsett.radiofontbig.caption msgid "Big" msgstr "Grande" #: tsett.radiofonthuge.caption msgctxt "tsett.radiofonthuge.caption" msgid "Huge" msgstr "Enorme" #: tsett.radiofontmedium.caption msgid "Medium" msgstr "Media" #: tsett.radiofontsmall.caption msgctxt "tsett.radiofontsmall.caption" msgid "Small" msgstr "Pequeña" #: tsett.radiouselocal.caption msgid "Use Local Note and Overwrite Server Note." msgstr "Usar la nota local y sobrescribir la nota del servidor." #: tsett.radiouseserver.caption msgid "Use Server Note and Rename Local Note." msgstr "Usar la nota del servidor y renombrar la nota local." #: tsett.speedbuthelp.caption msgctxt "tsett.speedbuthelp.caption" msgid "Help" msgstr "Ayuda" #: tsett.speedbuthide.caption msgctxt "tsett.speedbuthide.caption" msgid "Close" msgstr "Cerrar" #: tsett.speedbutttbmenu.caption msgctxt "tsett.speedbutttbmenu.caption" msgid "Menu" msgstr "Menú" #: tsett.speedsetupsync.caption msgctxt "tsett.speedsetupsync.caption" msgid "Setup" msgstr "Configurar" #: tsett.speedtokencopy.hint msgid "Copy Token" msgstr "Copiar autentificador" #: tsett.speedtokenpaste.hint msgid "Paste Token" msgstr "Pegar autentificador" #: tsett.tabbackup.caption msgid "BackUp" msgstr "Copia de Seguridad" #: tsett.tabbasic.caption msgid "Basic" msgstr "Básico" #: tsett.tabdisplay.caption msgid "Notes" msgstr "Notas" #: tsett.tabrecover.caption msgctxt "tsett.tabrecover.caption" msgid "Recover" msgstr "Recuperar" #: tsett.tabspell.caption msgctxt "tsett.tabspell.caption" msgid "Spell" msgstr "Ortografía" #: tsett.tabsync.caption msgctxt "tsett.tabsync.caption" msgid "Sync" msgstr "Sync" tomboy-ng_0.34-1/po/tomboy-ng.fr.po0000644000175000017500000014166714145033507016733 0ustar dbannondbannonmsgid "" msgstr "" "Content-Type: text/plain; charset=UTF-8\n" "Project-Id-Version: \n" "POT-Creation-Date: \n" "PO-Revision-Date: \n" "Last-Translator: \n" "Language-Team: \n" "MIME-Version: 1.0\n" "Content-Transfer-Encoding: 8bit\n" "Language: fr\n" "X-Generator: Poedit 2.0.6\n" #: editbox.rsunabletoevaluate msgid "Unable to find an expression to evaluate" msgstr "Impossible de trouver une expression à évaluer" #: mainunit.rsabout1 msgid "This is tomboy-ng, a rewrite of Tomboy Notes using Lazarus" msgstr "Tomboy-ng est une réécriture de \"Tomboy Notes\"" #: mainunit.rsabout2 msgid "and FPC. While its ready for production" msgstr "sur Lazarus et FPC. Bien que stable la prudence" #: mainunit.rsabout3 msgid "use, you still need to be careful and have good backups." msgstr "suggère de faire des sauvegardes régulières." #: mainunit.rsaboutbdate msgid "Build date" msgstr "Compilé le" #: mainunit.rsaboutcpu msgid "TargetCPU" msgstr "CPUcible" #: mainunit.rsaboutoperatingsystem msgid "OS" msgstr "OS" #: mainunit.rsaboutver msgid "Version" msgstr "Version" #: mainunit.rsfailedtoindex msgid "Failed to index one or more notes." msgstr "Échec de l'indexation des notes." #: resourcestr.rsaddnotestonotebook msgid "Add notes to this Notebook" msgstr "" #: resourcestr.rsalldone msgctxt "resourcestr.rsalldone" msgid "All Done" msgstr "Terminé" #: resourcestr.rsallrestored msgctxt "resourcestr.rsallrestored" msgid "Notes and config files Restored, restart suggested." msgstr "Notes et fichiers config rechargés, redémarrer svp." #: resourcestr.rsautosnapshotrun msgid "Completed autosnapshot run." msgstr "\"autosnapshot\" terminé." #: resourcestr.rsautosyncnotpossible msgid "Auto sync not possible right now" msgstr "Auto sync impossible pour l'instant" #: resourcestr.rsbadnotes #, object-pascal-format msgctxt "resourcestr.rsbadnotes" msgid "You have %d bad notes in Notes Directory" msgstr "Le répertoire contient %d notes vérolées" #: resourcestr.rsbadnotesfound1 msgctxt "resourcestr.rsbadnotesfound1" msgid "Please go to Settings -> Recover -> Recover Notes" msgstr "SVP utiliser Réglages -> Récup -> Récup des notes" #: resourcestr.rsbadnotesfound2 msgctxt "resourcestr.rsbadnotesfound2" msgid "You should do so to ensure your notes are safe." msgstr "Faites-le pour garantir des notes bien sauvegardées." #: resourcestr.rscannotdelete msgctxt "resourcestr.rscannotdelete" msgid "Cannot delete " msgstr "Suppression impossible " #: resourcestr.rscannotfindnote msgctxt "resourcestr.rscannotfindnote" msgid "ERROR, cannot find " msgstr "ERREUR, non trouvé " #: resourcestr.rschangenameofnotebook msgid "Change the name of this Notebook" msgstr "Change le nom du Carnet" #: resourcestr.rschangesync msgid "Change Sync Repo" msgstr "Changer le dépôt" #: resourcestr.rsclickbadnote msgctxt "resourcestr.rsclickbadnote" msgid "Double click on any Bad Notes" msgstr "Double-cliquer sur une note vérolée" #: resourcestr.rsclicksnapshot msgctxt "resourcestr.rsclicksnapshot" msgid "Click an Available Snapshot" msgstr "Sélectionner un Snapshot" #: resourcestr.rscontentdated msgid "Content Dated" msgstr "Contenu daté" #: resourcestr.rscopyfailed msgctxt "resourcestr.rscopyfailed" msgid "Copying orig to Backup directory failed" msgstr "Échec de la copie vers le répertoire de sauvegarde" #: resourcestr.rscreatenewrepo msgctxt "resourcestr.rscreatenewrepo" msgid "Create a new Repo ?" msgstr "Créer un nouveau Dépôt ?" #: resourcestr.rsdeleteandreplace_1 msgctxt "resourcestr.rsdeleteandreplace_1" msgid "Notes at risk !" msgstr "Notes exposées !" #: resourcestr.rsdeleteandreplace_2 #, object-pascal-format msgctxt "resourcestr.rsdeleteandreplace_2" msgid "Delete all notes in %s and replace with snapshot dated %s ?" msgstr "Écraser toutes les notes de %s par le snapshot du %s ?" #: resourcestr.rsdeleteddamaged #, object-pascal-format msgid "OK, deleted %d damaged notes" msgstr "OK, %d carnets vérolés supprimés" #: resourcestr.rsdownloaded msgid "Downloaded" msgstr "" #: resourcestr.rsdownloadnotes msgid "Downloading notes" msgstr "" #: resourcestr.rsenternewnotebook msgctxt "resourcestr.rsenternewnotebook" msgid "Enter a new notebook name please" msgstr "Entrer un nom de carnet svp" #: resourcestr.rserrorcopyfile msgctxt "resourcestr.rserrorcopyfile" msgid "Failed to copy file, does destination dir exist ?" msgstr "Échec de la copie, répertoire inexistant ?" #: resourcestr.rsfilesyncinfo1 msgid "tomboy-ng uses File Sync to sync to eg DropBox, Google Drive, a USB drive" msgstr "tomboy-ng utilise File Sync pour se synchroniser avec Dropbox, Google Drive," #: resourcestr.rsfilesyncinfo2 #, fuzzy #| msgid "or use a remote server over the internet with sshfs" msgid "or uses a remote server over the internet with sshfs" msgstr "un disque externe ou encore un quelconque serveur distant avec sshfs" #: resourcestr.rsfindnavlefthint msgid "Backward Find : Shift-F3 or Shift-Ctrl-G" msgstr "" #: resourcestr.rsfindnavlefthintmac msgid "Backward Find : Shift-Command-G" msgstr "" #: resourcestr.rsfindnavrighthint msgid "Find : F3 or Ctrl-G" msgstr "" #: resourcestr.rsfindnavrighthintmac msgid "Find : Command-G" msgstr "" #: resourcestr.rsfound msgctxt "resourcestr.rsfound" msgid "Found" msgstr "Trouvé" #: resourcestr.rsgithubsyncinfo1 msgid "tomboy-ng can use Github to both sync and display or edit notes" msgstr "" #: resourcestr.rsgithubsyncinfo2 msgid "you should read the tomboy-ng wiki page for instructions." msgstr "" #: resourcestr.rsgithubtokenexpired msgid "Github Token may have expired" msgstr "" #: resourcestr.rshelpconfig msgctxt "resourcestr.rshelpconfig" msgid "Create or use an alternative config" msgstr "Créer ou utiliser une config alternative" #: resourcestr.rshelpdebug msgctxt "resourcestr.rshelpdebug" msgid "Direct debug output to SOME.LOG." msgstr "Debug direct dans SOME.LOG." #: resourcestr.rshelpdebugindex msgctxt "resourcestr.rshelpdebugindex" msgid "Show debug msgs while indexing notes" msgstr "Debug verbeux pour l'indexation" #: resourcestr.rshelpdebugspell msgctxt "resourcestr.rshelpdebugspell" msgid "Show debug messages while spell setup" msgstr "Debug verbeux pour la config de l'épellation" #: resourcestr.rshelpdebugsync msgctxt "resourcestr.rshelpdebugsync" msgid "Show debug messages during Sync" msgstr "Mode verbeux pour la synchro" #: resourcestr.rshelpdelay msgctxt "resourcestr.rshelpdelay" msgid "Delay startup 2 sec to allow OS to settle" msgstr "2 sec. de pause pour que l'OS s'installe" #: resourcestr.rshelphelp msgctxt "resourcestr.rshelphelp" msgid "Show this help message and exit." msgstr "Afficher ce message d'aide et quitter." #: resourcestr.rshelplang #, fuzzy #| msgid "Force Language, supported en, es, nl" msgctxt "resourcestr.rshelplang" msgid "Force Language, supported en, es, fr, nl" msgstr "Choix de la langue (en, es, fr, nl)" #: resourcestr.rshelpnosplash #, fuzzy #| msgid "Dont show small status/splash window" msgctxt "resourcestr.rshelpnosplash" msgid "Do not show small status/splash window" msgstr "Cacher les petites fenêtres d'avertissement" #: resourcestr.rshelpsaveexit msgctxt "resourcestr.rshelpsaveexit" msgid "After import single note, save & exit" msgstr "Sauver & quitter après import de la note" #: resourcestr.rshelpsinglenote msgctxt "resourcestr.rshelpsinglenote" msgid "Open indicated note, switch is optional" msgstr "Ouvrir la note, commutation optionnelle" #: resourcestr.rshelpversion msgctxt "resourcestr.rshelpversion" msgid "Print version and exit" msgstr "Imprimer la version et quitter" #: resourcestr.rslastchange msgid "Last Change" msgstr "Modifiée le" #: resourcestr.rslastsync msgid "Last Sync" msgstr "Dernière synchro" #: resourcestr.rslookingatnotes msgctxt "resourcestr.rslookingatnotes" msgid "Looking at notes ...." msgstr "Journal de la gestion des notes :" #: resourcestr.rslookingserverid msgid "Looking for ServerID" msgstr "" #: resourcestr.rsmenuabout msgctxt "resourcestr.rsmenuabout" msgid "About" msgstr "À propos" #: resourcestr.rsmenuhelp msgctxt "resourcestr.rsmenuhelp" msgid "Help" msgstr "Aide" #: resourcestr.rsmenunewnote msgctxt "resourcestr.rsmenunewnote" msgid "New Note" msgstr "Nouvelle note" #: resourcestr.rsmenuquit msgctxt "resourcestr.rsmenuquit" msgid "Quit" msgstr "Quitter" #: resourcestr.rsmenusearch msgctxt "resourcestr.rsmenusearch" msgid "Search" msgstr "Recherche" #: resourcestr.rsmenusettings msgctxt "resourcestr.rsmenusettings" msgid "Settings" msgstr "Réglages" #: resourcestr.rsmenusync msgctxt "resourcestr.rsmenusync" msgid "Synchronise" msgstr "Synchronisation" #: resourcestr.rsmetadirwarning msgid "Please remember that to ensure a reliable sync, you must not change files in the Meta directory." msgstr "" #: resourcestr.rsmultiplenotebooks msgctxt "resourcestr.rsmultiplenotebooks" msgid "Settings allow multiple Notebooks" msgstr "L'option multi carnets est active" #: resourcestr.rsname msgid "Name" msgstr "Nom de la note" #: resourcestr.rsnewerversionexits msgctxt "resourcestr.rsnewerversionexits" msgid "A newer version exists in main repo" msgstr "Une nouvelle version est dispo. dans le dépôt principal" #: resourcestr.rsnotavailable msgid "Not Available" msgstr "Non disponible" #: resourcestr.rsnotealreadyinrepo msgctxt "resourcestr.rsnotealreadyinrepo" msgid "Note already in Repo" msgstr "Note déjà dans le dépôt" #: resourcestr.rsnotebookoptionctrl msgid "Ctrl click for Notebook Options" msgstr "Ctrl+clic pour les options du Carnet" #: resourcestr.rsnotebookoptionright msgid "Right click for Notebook Options" msgstr "Clic droit pour les options du Carnet" #: resourcestr.rsnotebooks msgctxt "resourcestr.rsnotebooks" msgid "Notebooks" msgstr "Carnets" #: resourcestr.rsnoteopen msgctxt "resourcestr.rsnoteopen" msgid "You have that note open, please close and try again" msgstr "Fermer cette note déjà ouverte et réessayer" #: resourcestr.rsnotes msgctxt "resourcestr.rsnotes" msgid "notes" msgstr "note(s)" #: resourcestr.rsnotesdeleted msgid "Note or notes deleted" msgstr "Note(s) effacée(s)" #: resourcestr.rsnotesinsnap msgctxt "resourcestr.rsnotesinsnap" msgid "Notes in Snapshot" msgstr "Notes placées dans le snapshot" #: resourcestr.rsnotpresent msgctxt "resourcestr.rsnotpresent" msgid "Not present in main repo" msgstr "Absent du dépôt principal" #: resourcestr.rsnumbnotesaffected #, object-pascal-format msgid "This will affect %d notes" msgstr "Impacte %d notes" #: resourcestr.rsonenotebook msgctxt "resourcestr.rsonenotebook" msgid "Settings allow only one Notebook" msgstr "Un seul carnet autorisé (cf. Réglages)" #: resourcestr.rsoverwritenote msgctxt "resourcestr.rsoverwritenote" msgid "Overwrite newer version of that note" msgstr "Écrase la note avec la nouvelle version" #: resourcestr.rspressclose msgctxt "resourcestr.rspressclose" msgid "Press Close" msgstr "Presser \"Fermer\"" #: resourcestr.rsrecoverok msgctxt "resourcestr.rsrecoverok" msgid "OK, File recovered." msgstr "Fichier restauré." #: resourcestr.rsrenamefailed msgctxt "resourcestr.rsrenamefailed" msgid "ERROR, could not rename Backup File " msgstr "Échec de renommage du fichier sauvé " #: resourcestr.rsrollbackintro msgid "You can roll back to previous version of this note" msgstr "Vous pouvez revenir à la précédente version de la note" #: resourcestr.rsrunningsync msgctxt "resourcestr.rsrunningsync" msgid "Running Sync" msgstr "Synchro active" #: resourcestr.rssaveandsync msgctxt "resourcestr.rssaveandsync" msgid "Press Save and Sync if this looks OK" msgstr "Pour terminer presser \"Sauver + Synchro\"" #: resourcestr.rsscanremote msgid "Scanning remote files" msgstr "" #: resourcestr.rssearchhint msgid "Exact matches for terms between \" \"" msgstr "Correspondance exacte si placé entre \"\"" #: resourcestr.rssetthenotebooks msgctxt "resourcestr.rssetthenotebooks" msgid "Set the notebooks this note is a member of" msgstr "Choisir le(s) carnet(s) où ajouter la note courante." #: resourcestr.rssetup msgctxt "resourcestr.rssetup" msgid "Setup" msgstr "Configurer" #: resourcestr.rssetupnotesdirfirst msgctxt "resourcestr.rssetupnotesdirfirst" msgid "Please setup a notes directory first" msgstr "Définir d'abord un répertoire de notes" #: resourcestr.rssetupsyncfirst msgctxt "resourcestr.rssetupsyncfirst" msgid "Please config sync system first" msgstr "Configurer d'abord la synchro" #: resourcestr.rssnapshotcreated msgctxt "resourcestr.rssnapshotcreated" msgid "created, do you want to copy it elsewhere ?" msgstr "créé, faire une autre copie ailleurs ?" #: resourcestr.rssyncerror #, fuzzy #| msgid "A Sync Error occured" msgctxt "resourcestr.rssyncerror" msgid "A Sync Error occurred" msgstr "Erreur de synchro" #: resourcestr.rssyncnotconfig msgctxt "resourcestr.rssyncnotconfig" msgid "not configured" msgstr "non configuré" #: resourcestr.rstestingcredentials msgid "Testing Credentials" msgstr "" #: resourcestr.rstestingrepo msgctxt "resourcestr.rstestingrepo" msgid "Testing Repo ...." msgstr "Test du dépôt..." #: resourcestr.rstestingsync msgctxt "resourcestr.rstestingsync" msgid "Testing Sync" msgstr "Tst de la Synchro" #: resourcestr.rstryrecover_1 msgid "Try to recover a bad note by double clicking below," msgstr "Cliquer ci-dessous pour tenter de récupérer la note vérolé," #: resourcestr.rstryrecover_2 msgctxt "resourcestr.rstryrecover_2" msgid "if that fails, you may be able to recover it from a Snapshot." msgstr "Essai de restauration d'une note vérolée depuis un snapshot." #: resourcestr.rsunabletoproceed msgctxt "resourcestr.rsunabletoproceed" msgid "Unable to proceed because" msgstr "Impossible d'exécuter car" #: resourcestr.rsunabletosync msgctxt "resourcestr.rsunabletosync" msgid "Unable to sync because " msgstr "Synchro impossible car " #: resourcestr.rsuploaded msgid "Uploaded" msgstr "" #: resourcestr.rsuploading msgid "Uploading" msgstr "" #: resourcestr.rswarnnossystray msgid "WARNING, your Desktop might not display SysTray" msgstr "" #: resourcestr.rswehavesnapshots #, object-pascal-format msgid "We have %d snapshots" msgstr "Il y a %d snapshot" #: settings.rsdictionaryfailed msgid "Library Not Loaded" msgstr "Bibliothèque non chargée" #: settings.rsdictionaryloaded msgid "Dictionary Loaded OK" msgstr "La correction orthographique est correctement chargée." #: settings.rsdictionarynotfound msgid "No Dictionary Found" msgstr "Aucun dictionnaire trouvé" #: settings.rsdirhasnonotes #, fuzzy #| msgid "That directory does not contain any notes. Thats OK, if I can make my own there." msgid "That directory does not contain any notes. That is OK, if I can make my own there." msgstr "Aucune note dans ce répertoire mais une création est possible." #: settings.rserrorcannotwrite msgid "Cannot write into" msgstr "Échec d'écriture dans" #: settings.rserrorcreatedir msgid "Unable to Create Directory" msgstr "Échec de création du répertoire" #: settings.rsselectdictionary msgid "Select the dictionary you want to use" msgstr "Choisir le dictionnaire à utiliser" #: settings.rsselectlibrary msgid "Select your hunspell library" msgstr "Choisir la bibliothèque Hunspell" #: spelling.rscheckingfull msgid "Checking full document" msgstr "Vérification du document" #: spelling.rscheckingselection msgid "Checking selection" msgstr "Vérification de la sélection" #: spelling.rsreplace_with_1 msgid "replace" msgstr "remplacer" #: spelling.rsreplace_with_2 msgid "with" msgstr "avec" #: spelling.rsspellcomplete msgid "Spell check complete" msgstr "Orthographe vérifiée" #: spelling.rsspellnotconfig msgid "Spelling not configured" msgstr "Vérification orthographique non configurée" #: syncutils.rschangeexistingsync msgid "Change existing sync connection ?" msgstr "Changer la connexion synchro existante ?" #: syncutils.rsclashes msgid "Clashes " msgstr "Nbre de collisions = " #: syncutils.rsdonothing msgid "Do Nothing " msgstr "Nbre de notes sans action = " #: syncutils.rsdownloads msgid "Downloads " msgstr "Nbre de downloads = " #: syncutils.rsedituploads msgid "Edit Uploads " msgstr "Nbre d'uploads modifiés = " #: syncutils.rslocaldeletes msgid "Local Deletes " msgstr "Nbre de suppressions locales = " #: syncutils.rsnewuploads msgid "New Uploads " msgstr "Nbre de nouveaux uploads = " #: syncutils.rsnextbitslow msgid "Next bit can be a bit slow, please wait" msgstr "Prochain bit possiblement lent, merci de patienter" #: syncutils.rsnonotesneededsync msgid "No notes needed syncing. You need to write more." msgstr "Pas de synchro requise pour l'instant." #: syncutils.rsnotesweredealt msgid " notes were dealt with." msgstr " notes ont été traitées." #: syncutils.rsnotrecommend msgid "Generally not recommended." msgstr "Plutôt déconseillé." #: syncutils.rsremotedeletes msgid "Remote Deletes " msgstr "Nbre d'effacements distants = " #: syncutils.rssyncerrors #, fuzzy #| msgid "ERRORS (see consol log) " msgid "ERRORS (see console log) " msgstr "Nbre d'erreurs (cf. log console) = " #: teditboxform.buttmaintbmenu.caption msgctxt "teditboxform.buttmaintbmenu.caption" msgid "Menu" msgstr "Menu" #: teditboxform.editfind.text msgid "EditFind" msgstr "" #: teditboxform.label2.caption msgid "Read Only" msgstr "Mode lecture" #: teditboxform.label3.caption msgid "This note has been changed by the Sync Process" msgstr "Note changée par le processus de synchro" #: teditboxform.label4.caption msgid "Please close it (and re-open if it was a download)" msgstr "Fermer (puis rouvrir si c'était un téléchargement)" #: teditboxform.labelfindinfo.caption msgid "LabelFindInfo" msgstr "" #: teditboxform.menubold.caption msgctxt "teditboxform.menubold.caption" msgid "Bold" msgstr "Gras" #: teditboxform.menufindnext.caption msgid "Find Next" msgstr "" #: teditboxform.menufindprev.caption msgctxt "teditboxform.menufindprev.caption" msgid "Find Prev" msgstr "" #: teditboxform.menufixedwidth.caption msgid "Fixed Width" msgstr "Chasse fixe" #: teditboxform.menuhighlight.caption msgctxt "teditboxform.menuhighlight.caption" msgid "Highlight" msgstr "Surlignement" #: teditboxform.menuhuge.caption msgctxt "teditboxform.menuhuge.caption" msgid "Huge" msgstr "Police énorme" #: teditboxform.menuitalic.caption msgid "Italic" msgstr "Italique" #: teditboxform.menuitembulletleft.caption msgid "Bullet <<" msgstr "" #: teditboxform.menuitembulletright.caption msgid "Bullet >>" msgstr "" #: teditboxform.menuitemcopy.caption msgid "Copy" msgstr "Copier" #: teditboxform.menuitemcut.caption msgid "Cut" msgstr "Couper" #: teditboxform.menuitemdelete.caption msgctxt "teditboxform.menuitemdelete.caption" msgid "Delete" msgstr "Effacer" #: teditboxform.menuitemevaluate.caption msgid "Evaluate" msgstr "Evaluer" #: teditboxform.menuitemexport.caption msgid "Export" msgstr "Export" #: teditboxform.menuitemexportmarkdown.caption msgid "Export Markdown" msgstr "Export réduit" #: teditboxform.menuitemexportplaintext.caption msgid "Export Plain Text" msgstr "Export en texte brut" #: teditboxform.menuitemexportrtf.caption msgid "Export RTF" msgstr "Export au format RTF" #: teditboxform.menuitemfind.caption msgid "Find in this Note" msgstr "Chercher dans la note" #: teditboxform.menuitemindex.caption msgid "Index" msgstr "Index" #: teditboxform.menuitempaste.caption msgid "Paste" msgstr "Coller" #: teditboxform.menuitemprint.caption msgid "Print" msgstr "Imprimer" #: teditboxform.menuitemselectall.caption msgid "Select All" msgstr "Tout sélectionner" #: teditboxform.menuitemsettings.caption msgctxt "teditboxform.menuitemsettings.caption" msgid "Settings" msgstr "Réglages" #: teditboxform.menuitemspell.caption msgid "Spell Check" msgstr "Vérification orthographique" #: teditboxform.menuitemsync.caption #, fuzzy #| msgid "Syncronize" msgid "Synchronize" msgstr "Synchroniser" #: teditboxform.menularge.caption msgid "Large Font" msgstr "Police grande" #: teditboxform.menunormal.caption msgid "Normal Font" msgstr "Police normale" #: teditboxform.menusmall.caption msgid "Small Font" msgstr "Police petite" #: teditboxform.menustayontop.caption msgid "Stay On Top" msgstr "Toujours visible" #: teditboxform.menustrikeout.caption msgid "Strikeout" msgstr "Barré" #: teditboxform.menuunderline.caption msgid "Underline" msgstr "Souligné" #: teditboxform.speedbuttondelete.hint msgid "Delete this note" msgstr "Supprimer la note" #: teditboxform.speedbuttonlink.hint msgid "Link highlighted text to a new note" msgstr "Créer une note avec la sélection" #: teditboxform.speedbuttonnotebook.hint msgid "Manage Notebooks" msgstr "Gestion des Carnets" #: teditboxform.speedbuttonsearch.hint msgid "Search All Notes Ctrl-Shift-F" msgstr "Rechercher (ctrl+shft+F)" #: teditboxform.speedbuttontext.hint msgid "Font size, bold, italics etc" msgstr "Formatage du texte" #: teditboxform.speedbuttontools.hint msgid "Tools - Sync, Export, Spell" msgstr "Outils - Synchro, Export, Orthographe" #: teditboxform.speedrollback.hint msgid "Roll Back" msgstr "Annuler" #: tformbackupview.buttondelete.caption msgctxt "tformbackupview.buttondelete.caption" msgid "Delete" msgstr "Supprimer" #: tformbackupview.buttondelete.hint msgid "Really, totally delete this note." msgstr "Suppression de la note." #: tformbackupview.buttonok.caption msgctxt "tformbackupview.buttonok.caption" msgid "Close" msgstr "Fermer" #: tformbackupview.buttonok.hint msgid "My work here is done." msgstr "Travail terminé." #: tformbackupview.buttonopen.caption msgid "View" msgstr "Voir" #: tformbackupview.buttonopen.hint msgid "Open and view the whole note" msgstr "Affichage intégrale de la note" #: tformbackupview.buttonrecover.caption msgctxt "tformbackupview.buttonrecover.caption" msgid "Recover" msgstr "Récupérer" #: tformbackupview.buttonrecover.hint msgid "Restore this note to main repo" msgstr "Récupérer la note dans le dépôt principal" #: tformbackupview.caption msgid "View, recover or delete Backup Files" msgstr "Gestion des fichiers de sauvegarde" #: tformbackupview.listbox1.hint msgid "Use Ctrl or Shift to select multiple entries" msgstr "Presser Ctrl ou Shift pour la sélection multiple" #: tformcolours.label1.caption msgid "Sample" msgstr "Échantillon" #: tformcolours.label2.caption msgctxt "tformcolours.label2.caption" msgid "Set Colours" msgstr "Réglages des couleurs" #: tformcolours.speedbackground.caption msgid "Background" msgstr "Arrière-plan" #: tformcolours.speedcancel.caption msgctxt "tformcolours.speedcancel.caption" msgid "Cancel" msgstr "Annuler" #: tformcolours.speeddefault.caption msgid "Default" msgstr "Défaut" #: tformcolours.speedhighlight.caption msgctxt "tformcolours.speedhighlight.caption" msgid "Highlight" msgstr "Surlignement" #: tformcolours.speedok.caption msgctxt "tformcolours.speedok.caption" msgid "OK" msgstr "OK" #: tformcolours.speedtext.caption msgid "Text" msgstr "Texte" #: tformcolours.speedtitle.caption msgctxt "tformcolours.speedtitle.caption" msgid "Title" msgstr "Titre" #: tformindex.caption msgid "Heading in this Note" msgstr "Entête de la note" #: tformindex.panel1.caption msgid "Single lines, all Huge, Large Bold or Large" msgstr "Ligne normale, énorme, ou grand (+gras)" #: tformrecover.buttondeletebadnotes.caption msgid "Delete Bad Notes" msgstr "Effacer les notes vérolées" #: tformrecover.buttonmakesafetysnap.caption msgid "Take a manual Snapshot" msgstr "Prendre un snapshot" #: tformrecover.buttonmakesafetysnap.hint msgid "Take a initial snapshot of your notes and config. Overwritten each time." msgstr "1er snapshot des notes & config puis remplacement à chaque màj." #: tformrecover.buttonrecoversnap.caption msgctxt "tformrecover.buttonrecoversnap.caption" msgid "Recover" msgstr "Récupérer" #: tformrecover.buttonsnaphelp.caption msgctxt "tformrecover.buttonsnaphelp.caption" msgid "Snapshot Help" msgstr "Aide snapshot" #: tformrecover.label10.caption msgid "Please close any notes you may have open." msgstr "Fermer les notes possiblement ouvertes." #: tformrecover.label12.caption msgid "Don't even consider this unless you have a backup Snapshot, Intro Tab." msgstr "Impossibe sauf à disposer d'un snapshot déjà sauvé, cf. onglet Intro." #: tformrecover.label14.caption msgid "Click an available snapshot to see its contents." msgstr "Sélectionner le snapshot à visualiser." #: tformrecover.label15.caption msgid "Click an available snapshot, click Recover" msgstr "Sélectionner un snapshot, cliquer sur Restauration" #: tformrecover.label16.caption msgid "You may chose to view, copy and paste into a new note." msgstr "Choisir de voir, copier et coller dans une note." #: tformrecover.label2.caption #, fuzzy #| msgid "Please be carefull, this is a dangerous place!" msgid "Please be careful, this is a dangerous place!" msgstr "Attention, cette fonctionnalité est instable !" #: tformrecover.label3.caption msgid "Restore any notes in the snapshot that are not in the existing notes directory." msgstr "Récupérer les notes du snapshot n'existant pas dans le répertoire local." #: tformrecover.label4.caption msgid "Remove all existing notes and use the ones in the Snapshot." msgstr "Effacer toutes les notes pour utiliser celles du snapshot." #: tformrecover.label5.caption msgid "Looking for notes with damaged XML" msgstr "Recherche de notes avec XML vérolé" #: tformrecover.label6.caption msgid "This tool might help you recover lost or damaged notes." msgstr "Outil d'aide à la restauration des notes perdues ou vérolées." #: tformrecover.label7.caption msgid "Before you start, take a Snapshot of your notes directory." msgstr "Faire préalablement un snapshot des notes du répertoire." #: tformrecover.label9.caption msgid "From here you can view snapshot notes, one by one." msgstr "Endroit permettant la visu snapshot par snapshot." #: tformrecover.listboxsnapshots.hint msgid "These are the currently known snapshots. " msgstr "Voici les snapshots actuellement connus." #: tformrecover.panelsnapshots.caption msgid "Available Snapshots" msgstr "Snapshots disponibles" #: tformrecover.tabsheetbadnotes.caption msgid "Bad Notes" msgstr "Notes vérolées" #: tformrecover.tabsheetintro.caption msgid "Introduction" msgstr "Introduction" #: tformrecover.tabsheetmergesnapshot.caption msgid "Merge Snapshot" msgstr "Fusionner le snapshot" #: tformrecover.tabsheetrecovernotes.caption msgid "Recover Notes" msgstr "Restauration des notes" #: tformrecover.tabsheetrecoversnapshot.caption msgid "Recover Snapshot" msgstr "Récupérer un snapshot" #: tformrollback.speedcancel.caption msgctxt "tformrollback.speedcancel.caption" msgid "Cancel" msgstr "Annuler" #: tformrollback.speedrolltoopen.caption msgid "Opening Backup" msgstr "Ouvrir une sauvegarde" #: tformrollback.speedrolltotitle.caption msgid "Title Change Backup" msgstr "Renommer la sauvegarde" #: tformsdiff.bitbtnuselocal.caption msgid "Use Local" msgstr "Utilisation Local" #: tformsdiff.bitbtnuseremote.caption msgid "Use Remote" msgstr "Utilisation Distante" #: tformsdiff.buttalllocal.caption msgid "Local" msgstr "Locale" #: tformsdiff.buttallnewest.caption msgid "Newest" msgstr "Nouveau" #: tformsdiff.buttalloldest.caption msgid "Oldest" msgstr "Ancien" #: tformsdiff.buttallremote.caption msgid "Remote" msgstr "Distant" #: tformsdiff.caption msgid "A Note Sync Clash has been Detected" msgstr "Détection d'une erreur de synchro de notes" #: tformsdiff.label1.caption msgid "Or make a choice for remainder of this run" msgstr "Ou faire une autre choix pour cette exécution" #: tformsdiff.label3.caption msgid "Remote Changed" msgstr "Distant changé" #: tformsdiff.label4.caption msgid "Local Changed" msgstr "Local changé" #: tformsdiff.radiolong.caption msgid "Long Lines" msgstr "Lignes longues" #: tformsdiff.radiolong.hint msgid "Maybe necessary to show difference" msgstr "Possible nécessité de voir la différence" #: tformsdiff.radioshort.caption msgid "Short Lines" msgstr "Lignes Courtes" #: tformsdiff.radioshort.hint msgid "Easier to read" msgstr "Plus facile à lire" #: tformspell.buttonignore.caption msgid "Ignore" msgstr "Ignorer" #: tformspell.buttonignore.hint msgid "Ignore all instances for the run" msgstr "Tout ignorer" #: tformspell.buttonskip.caption msgid "Skip" msgstr "Sauter" #: tformspell.buttonskip.hint msgid "Skip just this instance" msgstr "Sauter juste cette instance" #: tformspell.buttonuseandnextword.caption msgid "Use and Next Word" msgstr "Utiliser & passer au mot suivant" #: tformspell.caption msgctxt "tformspell.caption" msgid "Spell" msgstr "Vérifier" #: tformspell.label4.caption msgid "Suspect word -" msgstr "Mot suspect -" #: tformspell.labelprompt.caption msgid "Click a word to use it." msgstr "Cliquer sur un mot." #: tformsync.buttoncancel.caption msgctxt "tformsync.buttoncancel.caption" msgid "Cancel" msgstr "Annuler" #: tformsync.buttonclose.caption msgctxt "tformsync.buttonclose.caption" msgid "Close" msgstr "Fermer" #: tformsync.buttonsave.caption msgid "Save and Sync" msgstr "Sauver + Synchro" #: tformsync.caption msgctxt "tformsync.caption" msgid "Sync" msgstr "Synchro" #: tformsync.labelprogress.caption msgid "LabelProgress" msgstr "" #: tformsync.listviewreport.columns[0].caption msgid "Action" msgstr "Action" #: tformsync.listviewreport.columns[1].caption msgctxt "tformsync.listviewreport.columns[1].caption" msgid "Title" msgstr "Titre" #: tformsync.listviewreport.columns[2].caption msgid "Note ID" msgstr "ID de la note" #: tformtomdroid.buttonclose.caption msgctxt "tformtomdroid.buttonclose.caption" msgid "Close" msgstr "Fermer" #: tformtomdroid.buttondelete.caption msgid "Delete Profile" msgstr "Effacer le profile" #: tformtomdroid.buttonhelp.caption msgctxt "tformtomdroid.buttonhelp.caption" msgid "Help" msgstr "Aide" #: tformtomdroid.buttonjoin.caption msgctxt "tformtomdroid.buttonjoin.caption" msgid "Join" msgstr "Rejoindre" #: tformtomdroid.buttonsaveprofile.caption msgid "Save Profile" msgstr "Sauver le profil" #: tformtomdroid.buttonsync.caption msgctxt "tformtomdroid.buttonsync.caption" msgid "Sync" msgstr "Synchro" #: tformtomdroid.caption msgctxt "tformtomdroid.caption" msgid "Tomdroid" msgstr "Tomdroid" #: tformtomdroid.checkboxdebugmode.caption msgid "Debug Mode" msgstr "Mode debug" #: tformtomdroid.checkboxdebugmode.hint msgid "writes debug messages to terminal" msgstr "envoeyr les debug vers le terminal" #: tformtomdroid.checkboxtestrun.caption msgctxt "tformtomdroid.checkboxtestrun.caption" msgid "Test Run" msgstr "Exécution test" #: tformtomdroid.checksavepassword.caption msgctxt "tformtomdroid.checksavepassword.caption" msgid "Save" msgstr "Sauver" #: tformtomdroid.editprofilename.hint msgid "eg MySamsungNote7" msgstr "ex: MySamsungNote7" #: tformtomdroid.label1.caption #, fuzzy #| msgid "Tomdroid Sync - be aware of limitations !" msgid "Tomdroid SSH Sync - deprecated, will be dropped soon." msgstr "Attention aux limites de la synchro Tomdroid !" #: tformtomdroid.label2.caption msgid "Select an existing profile (or enter data) " msgstr "Choisir un profil existant (ou saisir une valeur) " #: tformtomdroid.label3.caption msgid "Profile Name" msgstr "Nom du profil" #: tformtomdroid.label4.caption msgid "IP address of device" msgstr "Adresse IP du périphérique" #: tformtomdroid.label5.caption msgid "SSH Password for device" msgstr "Mot de passe SSH du périphérique" #: tformtomdroid.label6.caption msgctxt "tformtomdroid.label6.caption" msgid "Upload means from tomboy-ng to Android Device" msgstr "\"Upload\" = depuis tomboy-ng vers le périphérique Android" #: tformtomdroidfile.buttonclose.caption #, fuzzy msgctxt "tformtomdroidfile.buttonclose.caption" msgid "Close" msgstr "Fermer" #: tformtomdroidfile.buttonhelp.caption #, fuzzy msgctxt "tformtomdroidfile.buttonhelp.caption" msgid "Help" msgstr "Aide" #: tformtomdroidfile.buttonjoin.caption #, fuzzy msgctxt "tformtomdroidfile.buttonjoin.caption" msgid "Join" msgstr "Rejoindre" #: tformtomdroidfile.buttonoldssh.caption msgid "Use old SSH model" msgstr "" #: tformtomdroidfile.buttonsync.caption #, fuzzy msgctxt "tformtomdroidfile.buttonsync.caption" msgid "Sync" msgstr "Synchro" #: tformtomdroidfile.caption #, fuzzy msgctxt "tformtomdroidfile.caption" msgid "Tomdroid" msgstr "Tomdroid" #: tformtomdroidfile.checkboxtestrun.caption #, fuzzy msgctxt "tformtomdroidfile.checkboxtestrun.caption" msgid "Test Run" msgstr "Exécution test" #: tformtomdroidfile.label1.caption msgid "Tomdroid Sync - be aware of limitations !" msgstr "" #: tformtomdroidfile.label6.caption #, fuzzy msgctxt "tformtomdroidfile.label6.caption" msgid "Upload means from tomboy-ng to Android Device" msgstr "\"Upload\" = depuis tomboy-ng vers le périphérique Android" #: tmainform.bitbtnhide.caption #, fuzzy msgctxt "tmainform.bitbtnhide.caption" msgid "Hide" msgstr "Cacher" #: tmainform.bitbtnquit.caption #, fuzzy msgctxt "tmainform.bitbtnquit.caption" msgid "Quit" msgstr "Quitter" #: tmainform.buttmenu.caption msgctxt "tmainform.buttmenu.caption" msgid "Menu" msgstr "Menu" #: tmainform.buttsystrayhelp.caption msgid "SysTray Help" msgstr "" #: tmainform.caption msgid "tomboy-ng" msgstr "tomboy-ng" #: tmainform.checkboxdontshow.caption msgid "Don't Show for normal startup" msgstr "Ne plus afficher au prochain démarrage" #: tmainform.checkboxdontshow.hint msgid "You can reverse this from Settings" msgstr "Inversion possible dans les réglages" #: tmainform.hint #, fuzzy #| msgid "If the green tomboy-ng icon is visible in your System Tray, you can dismiss this window." msgid "If the yellow tomboy-ng icon is visible in your System Tray, you can dismiss this window." msgstr "Si l'icône verte de tomboy-ng est présente dans le dock, la fenêtre peut être fermée." #: tmainform.label3.caption msgid "Dictionary Config (optional)" msgstr "Vérificateur orthographique (optionnel)" #: tmainform.label4.caption msgid "Sync Config (optional)" msgstr "Configuration de la synchro (optionnel)" #: tmainform.label5.caption msgid "Welcome to tomboy-ng !" msgstr "Bienvenue dans tomboy-ng !" #: tmainform.labelerror.hint msgid "Launch from commandline to see errors or see Config->SnapShot->Recover ..." msgstr "Lancer par le CLI pour voir les erreurs, la Config->Snapshot->Restauration, etc." #: tnotebookpick.button1.caption msgctxt "tnotebookpick.button1.caption" msgid "Cancel" msgstr "Annuler" #: tnotebookpick.buttonok.caption msgctxt "tnotebookpick.buttonok.caption" msgid "OK" msgstr "OK" #: tnotebookpick.label4.caption msgid "Name of the New Notebook" msgstr "Nom du nouveau Carnet" #: tnotebookpick.label5.caption msgid "Press OK and we will make the Note Book AND add this note to it." msgstr "\"OK\" crée le carnet et y ajoute la note courante." #: tnotebookpick.label6.caption msgid "Existing Name" msgstr "Nom existant" #: tnotebookpick.label8.caption msgid "New Name" msgstr "Nouveau nom" #: tnotebookpick.label9.caption #, fuzzy #| msgid "If you sync and are not absolutly sure its up to date, Cancel now !" msgid "If you sync and are not absolutely sure its up to date, Cancel now !" msgstr "S'assurer d'être à jour avant une synchro ou annuler maintenant !" #: tnotebookpick.tabchangename.caption msgid "Change Notebook Name" msgstr "Renommer le Carnet" #: tnotebookpick.tabexisting.caption msgid "Existing Note Books" msgstr "Carnets existant" #: tnotebookpick.tabnewnotebook.caption msgid "New Note Book" msgstr "Nouveau carnet" #: tnotebookpick.tabsetnotes.caption msgid "Set Notes" msgstr "" #: tomdroid.rscheckingforexistingsync msgid "Checking for an existing sync ...." msgstr "Vérif. de l'existence d'une synchro..." #: tomdroid.rsconnectiongood msgctxt "tomdroid.rsconnectiongood" msgid "Connection is looking Good." msgstr "La connexion semble bonne." #: tomdroid.rsfailedtoconnect msgctxt "tomdroid.rsfailedtoconnect" msgid "Failed to connect." msgstr "Échec de la connexion." #: tomdroid.rsfailedtofindconnection_1 msgid "Failed to find an existing connection." msgstr "Impossible de localiser la connexion." #: tomdroid.rsfailedtofindconnection_2 msgctxt "tomdroid.rsfailedtofindconnection_2" msgid "If you are sure there should be an existing connection, check settings." msgstr "Pour être sûr de l'existence d'une connexion, vérifier dans les réglages." #: tomdroid.rsfailedtofindconnection_3 msgid "Otherwise, try joining a new connection." msgstr "Sinon tenter d'établir une nouvelle connexion." #: tomdroid.rsfixconnection msgctxt "tomdroid.rsfixconnection" msgid "If you are sure its there, check settings." msgstr "Pour confirmer son existence vérifier dans les réglages." #: tomdroid.rshavevalidsync msgctxt "tomdroid.rshavevalidsync" msgid "Looking Good. Last sync date " msgstr "Ça semble bon. Dernière synchro le " #: tomdroid.rsinstalltomdroid msgctxt "tomdroid.rsinstalltomdroid" msgid "Install Tomdroid, config filesync, and run a sync" msgstr "Installer Tomdroid puis configurer/exécuter une synchro" #: tomdroid.rsnoconnection msgctxt "tomdroid.rsnoconnection" msgid "Failed to establish a connection. " msgstr "Échec de la connexion." #: tomdroid.rsnotcorrectprofile msgctxt "tomdroid.rsnotcorrectprofile" msgid "This is not correct profile for that device" msgstr "Profil incorrect pour ce périphérique" #: tomdroid.rsnotexistingrepo msgctxt "tomdroid.rsnotexistingrepo" msgid "That's not an existing Repo, maybe click \"Join\" ?" msgstr "Dépôt inconnu, cliquer \"Rejoindre\" ?" #: tomdroid.rsnotomdroid msgctxt "tomdroid.rsnotomdroid" msgid "Unable to find Tomdroid sync dir on that device." msgstr "Répertoire à synchroniser non trouvé sur ce périphérique." #: tomdroid.rsselectprofile msgid "Select a profile" msgstr "Choisir un profil" #: tomdroid.rssetupnewsync msgctxt "tomdroid.rssetupnewsync" msgid "Setting up a new sync ...." msgstr "Créer une nouvelle synchro..." #: tomdroid.rstalkingtodevice msgctxt "tomdroid.rstalkingtodevice" msgid "OK, talking to device. Wait for it ...." msgstr "Contact établi, attente d'une réponse..." #: tomdroidfile.rsconnectiongood #, fuzzy msgctxt "tomdroidfile.rsconnectiongood" msgid "Connection is looking Good." msgstr "La connexion semble bonne." #: tomdroidfile.rsfailedtoconnect #, fuzzy msgctxt "tomdroidfile.rsfailedtoconnect" msgid "Failed to connect." msgstr "Échec de la connexion." #: tomdroidfile.rsfailedtofindconnection_2 #, fuzzy msgctxt "tomdroidfile.rsfailedtofindconnection_2" msgid "If you are sure there should be an existing connection, check settings." msgstr "Pour être sûr de l'existence d'une connexion, vérifier dans les réglages." #: tomdroidfile.rsfixconnection #, fuzzy msgctxt "tomdroidfile.rsfixconnection" msgid "If you are sure its there, check settings." msgstr "Pour confirmer son existence vérifier dans les réglages." #: tomdroidfile.rshavevalidsync #, fuzzy msgctxt "tomdroidfile.rshavevalidsync" msgid "Looking Good. Last sync date " msgstr "Ça semble bon. Dernière synchro le " #: tomdroidfile.rsinstalltomdroid #, fuzzy msgctxt "tomdroidfile.rsinstalltomdroid" msgid "Install Tomdroid, config filesync, and run a sync" msgstr "Installer Tomdroid puis configurer/exécuter une synchro" #: tomdroidfile.rsjoinanyway msgid "Forcing a Join may \"recover\" some notes you thought you have deleted." msgstr "" #: tomdroidfile.rsnoconnection #, fuzzy msgctxt "tomdroidfile.rsnoconnection" msgid "Failed to establish a connection. " msgstr "Échec de la connexion." #: tomdroidfile.rsnotcorrectprofile #, fuzzy msgctxt "tomdroidfile.rsnotcorrectprofile" msgid "This is not correct profile for that device" msgstr "Profil incorrect pour ce périphérique" #: tomdroidfile.rsnotexistingrepo #, fuzzy msgctxt "tomdroidfile.rsnotexistingrepo" msgid "That's not an existing Repo, maybe click \"Join\" ?" msgstr "Dépôt inconnu, cliquer \"Rejoindre\" ?" #: tomdroidfile.rsnotomdroid #, fuzzy msgctxt "tomdroidfile.rsnotomdroid" msgid "Unable to find Tomdroid sync dir on that device." msgstr "Répertoire à synchroniser non trouvé sur ce périphérique." #: tomdroidfile.rssetupnewsync #, fuzzy msgctxt "tomdroidfile.rssetupnewsync" msgid "Setting up a new sync ...." msgstr "Créer une nouvelle synchro..." #: tomdroidfile.rstalking #, fuzzy msgctxt "tomdroidfile.rstalking" msgid "OK, talking to device. Wait for it ...." msgstr "Échange en cours avec le périphérique" #: tsearchform.buttonclearfilters.caption msgid "Clear Filters" msgstr "Effacer les filtres" #: tsearchform.buttonmenu.caption msgctxt "tsearchform.buttonmenu.caption" msgid "Menu" msgstr "Menu" #: tsearchform.buttonrefresh.caption msgid "Refresh" msgstr "Rafraîchir" #: tsearchform.buttonrefresh.hint msgid "Update Search Results" msgstr "Mettre à jour la recherche" #: tsearchform.caption msgid "tomboy-ng_Search" msgstr "Recherche tomboy-ng" #: tsearchform.checkautorefresh.caption msgid "Auto Refresh" msgstr "" #: tsearchform.checkcasesensitive.caption msgctxt "tsearchform.checkcasesensitive.caption" msgid "Case Sensitive" msgstr "Tenir compte de la casse" #: tsearchform.listboxnotebooks.hint msgid "Right Click to manage Notebooks" msgstr "" #: tsearchform.menucreatenotebook.caption msgid "Create new Note Book" msgstr "" #: tsearchform.menudeletenotebook.caption msgid "Delete Notebook" msgstr "Effacer le carnet" #: tsearchform.menueditnotebooktemplate.caption msgid "Edit Notebook Template" msgstr "Éditer le modèle du carnet" #: tsearchform.menuitemmanagenbook.caption msgid "Manage Notes in Note Book" msgstr "" #: tsearchform.menunewnotefromtemplate.caption msgid "Create New Note from Template" msgstr "Créer une note à partir du modèle" #: tsearchform.menurenamenotebook.caption #, fuzzy #| msgid "Rename Note Book" msgid "Rename NoteBook" msgstr "Renommer le Carnet" #: tsearchform.panel2.caption msgctxt "tsearchform.panel2.caption" msgid "Notebooks" msgstr "Carnets" #: tsett.buttdefaultnotedir.caption msgid "Use Default Notes Location" msgstr "Emplacement par défaut" #: tsett.buttdefaultnotedir.hint msgid "Will work for many new users" msgstr "Fonctionnera en multi-utilisateurs" #: tsett.buttonfixedfont.caption msgid "Fixed Font" msgstr "Police fixe" #: tsett.buttonfont.caption msgid "Usual Font" msgstr "Police courante" #: tsett.buttonmanualsnap.caption msgid "Take a Manual Snapshot" msgstr "Snapshot manuel" #: tsett.buttonmanualsnap.hint msgid "Take a time stamped snapshot of notes and config" msgstr "Prendre un snapshot horodaté des notes + config" #: tsett.buttonsetcolours.caption msgctxt "tsett.buttonsetcolours.caption" msgid "Set Colours" msgstr "Choix des couleurs" #: tsett.buttonsetdictionary.caption msgid "Set Dictionary" msgstr "Choix du dictionnaire" #: tsett.buttonsetnotepath.caption msgid "Set Path to Note Files" msgstr "Choisir l'emplacement" #: tsett.buttonsetnotepath.hint msgid "If you have notes somewhere else" msgstr "S'il y a des notes ailleurs" #: tsett.buttonsetspelllibrary.caption msgid "Set Spell Library" msgstr "Choisir la bibliothèque" #: tsett.buttonshowbackup.caption msgid "Show Me" msgstr "Afficher" #: tsett.buttonsnaprecover.caption msgid "Recover Lost Notes" msgstr "Récupérer les notes perdues" #: tsett.buttonsnaprecover.hint msgid "If you have previously taken a snapshot ..." msgstr "Si un précédent snapshot existe..." #: tsett.checkautosnapenabled.caption msgctxt "tsett.checkautosnapenabled.caption" msgid "Use auto snapshots" msgstr "snapshot automatique" #: tsett.checkautostart.caption msgid "Autostart at Logon" msgstr "Ouvrir au démarrage" #: tsett.checkboxautosync.caption msgid "Auto Sync" msgstr "Synchro auto" #: tsett.checkboxautosync.hint msgid "Sync, if possible once an hour." msgstr "Une synchro par heure si possible." #: tsett.checkmanynotebooks.caption msgid "Allow a Note to be in Multiple Notebooks." msgstr "Une note peut figurer dans plusieurs carnets." #: tsett.checkmanynotebooks.hint msgid "This may adversly affect traditional Tomboy, take care." msgstr "Attention, risque d'impact sur le Tomboy traditionnel." #: tsett.checknotifications.caption msgid "Show Notifications" msgstr "" #: tsett.checkshowextlinks.caption msgid "Show External Links" msgstr "Voir les liens externes" #: tsett.checkshowintlinks.caption msgid "Show Internal Links" msgstr "Voir les liens internes" #: tsett.checkshowsearchatstart.caption msgid "Show Search at Start" msgstr "Afficher la recherche au démarrage" #: tsett.checkshowsplash.caption msgid "Show Splash at Start" msgstr "Afficher la fenêtre de démarrage" #: tsett.checkshowsplash.hint msgid "Always shown if error loading notes." msgstr "Toujours affiché en cas d'erreur de chargement des notes." #: tsett.checkshowtomdroid.caption msgid "Show Tomdroid Sync (experimental)" msgstr "Afficher la synchro Tomdroid (expérimental)" #: tsett.checkstampbold.caption #, fuzzy msgctxt "tsett.checkstampbold.caption" msgid "Bold" msgstr "Gras" #: tsett.checkstampitalics.caption msgid "Italics" msgstr "" #: tsett.checkstampsmall.caption #, fuzzy msgctxt "tsett.checkstampsmall.caption" msgid "Small" msgstr "Police petite" #: tsett.checksyncenabled.caption msgid "Sync Enabled" msgstr "" #: tsett.checkuseundo.caption msgid "Use Undo Redo (may slow editing)" msgstr "" #: tsett.checkuseundo.hint msgid "Close and reopen a note to take effect. Use Ctrl-Z Ctrl-Y" msgstr "" #: tsett.combosynctype.text msgid "ComboSyncType" msgstr "" #: tsett.editusername.text msgid "EditUserName" msgstr "" #: tsett.groupbox4.caption msgid " Options " msgstr " Options " #: tsett.groupbox5.caption msgid "Font Size" msgstr "Taille de police" #: tsett.groupboxsync.caption msgid " Sync " msgstr " Synchro " #: tsett.label1.caption msgid "Settings will be saved in :" msgstr "Les réglages seront sauvegardés dans :" #: tsett.label10.caption msgctxt "tsett.label10.caption" msgid "Help Notes Language" msgstr "Langue pour les notes" #: tsett.label11.caption msgid "Backup Files" msgstr "Fichiers de sauvegarde" #: tsett.label13.caption msgid "Spell Check requires the Hunspell Libraries and" msgstr "Le contrôle de l'orthographe requiert des bibliothèques Hunspell" #: tsett.label14.caption msgid "an appropriate Hunspell Dictionary set." msgstr "et un réglage approprié du dictionnaire." #: tsett.label16.caption #, fuzzy #| msgid "Maxium number of snapshots" msgid "Maximum number of snapshots" msgstr "snaphots au maximum" #: tsett.label17.caption msgid "Date Stamp Format" msgstr "" #: tsett.label2.caption msgid "Notes will be looked for and saved in :" msgstr "Les notes seront sauvegardées dans :" #: tsett.label3.caption msgid "When a conflict is detected between a local note and remote one :" msgstr "Lors d'un conflit entre les notes locales et distantes :" #: tsett.label4.caption msgid "Repo : " msgstr "Dépôt : " #: tsett.label5.caption msgid "Days per snapshot" msgstr "jours entre 2 synchro" #: tsett.label6.caption msgid "Backup files are made when you delete a note or the sync system" msgstr "Une sauvegarde est réalisé quand une note est effacée" #: tsett.label7.caption msgid "is about to overwrite one. " msgstr "manuellement ou par une synchronisation." #: tsett.label8.caption #, fuzzy #| msgid "They remain, for ever, unless you do something about them." msgid "They remain, forever, unless you do something about them." msgstr "Elle reste ensuite présente jusqu'à son effacement manuel." #: tsett.label9.caption msgid "A snaphot is a copy of your current note directory." msgstr "Un snapshot est une copie en l'état du répertoire des notes" #: tsett.labellabeltoken.caption msgctxt "tsett.labellabeltoken.caption" msgid "Token" msgstr "" #: tsett.labelsnapdir.caption msgid "Snap dir" msgstr "Répertoire des snap" #: tsett.labelsyncinfo1.caption msgid "LabelSyncInfo1" msgstr "" #: tsett.labelsyncinfo2.caption msgid "LabelSyncInfo2" msgstr "" #: tsett.labelsyncrepo.caption #, fuzzy msgctxt "tsett.labelsyncrepo.caption" msgid "not configured" msgstr "non configuré" #: tsett.labelsynctype.caption msgid "Sync Type" msgstr "" #: tsett.labeltoken.caption msgid "LabelToke" msgstr "" #: tsett.labelusername.caption msgid "User" msgstr "" #: tsett.radioalwaysask.caption msgid "Always Ask me what to do." msgstr "Demander quoi faire à chaque fois." #: tsett.radiofontbig.caption msgid "Big" msgstr "Police grande" #: tsett.radiofonthuge.caption msgctxt "tsett.radiofonthuge.caption" msgid "Huge" msgstr "Police énorme" #: tsett.radiofontmedium.caption msgid "Medium" msgstr "Police moyenne" #: tsett.radiofontsmall.caption msgctxt "tsett.radiofontsmall.caption" msgid "Small" msgstr "Police petite" #: tsett.radiouselocal.caption msgid "Use Local Note and Overwrite Server Note." msgstr "Préférer la note locale, écraser la note serveur." #: tsett.radiouseserver.caption msgid "Use Server Note and Rename Local Note." msgstr "Préférer la note serveur, écraser la note locale." #: tsett.speedbuthelp.caption msgctxt "tsett.speedbuthelp.caption" msgid "Help" msgstr "Aide" #: tsett.speedbuthide.caption msgctxt "tsett.speedbuthide.caption" msgid "Close" msgstr "Fermer" #: tsett.speedbutttbmenu.caption msgctxt "tsett.speedbutttbmenu.caption" msgid "Menu" msgstr "Menu" #: tsett.speedsetupsync.caption msgctxt "tsett.speedsetupsync.caption" msgid "Setup" msgstr "Réglages" #: tsett.speedtokencopy.hint msgid "Copy Token" msgstr "" #: tsett.speedtokenpaste.hint msgid "Paste Token" msgstr "" #: tsett.tabbackup.caption msgid "BackUp" msgstr "Sauvegarde" #: tsett.tabbasic.caption msgid "Basic" msgstr "Général" #: tsett.tabdisplay.caption msgid "Notes" msgstr "Notes" #: tsett.tabrecover.caption msgctxt "tsett.tabrecover.caption" msgid "Recover" msgstr "Restauration" #: tsett.tabspell.caption msgctxt "tsett.tabspell.caption" msgid "Spell" msgstr "Orthographe" #: tsett.tabsync.caption msgctxt "tsett.tabsync.caption" msgid "Sync" msgstr "Synchro" tomboy-ng_0.34-1/po/tomboy-ng.pot0000644000175000017500000011332714145033507016501 0ustar dbannondbannonmsgid "" msgstr "Content-Type: text/plain; charset=UTF-8" #: editbox.rsunabletoevaluate msgid "Unable to find an expression to evaluate" msgstr "" #: mainunit.rsabout1 msgid "This is tomboy-ng, a rewrite of Tomboy Notes using Lazarus" msgstr "" #: mainunit.rsabout2 msgid "and FPC. While its ready for production" msgstr "" #: mainunit.rsabout3 msgid "use, you still need to be careful and have good backups." msgstr "" #: mainunit.rsaboutbdate msgid "Build date" msgstr "" #: mainunit.rsaboutcpu msgid "TargetCPU" msgstr "" #: mainunit.rsaboutoperatingsystem msgid "OS" msgstr "" #: mainunit.rsaboutver msgid "Version" msgstr "" #: mainunit.rsfailedtoindex msgid "Failed to index one or more notes." msgstr "" #: resourcestr.rsaddnotestonotebook msgid "Add notes to this Notebook" msgstr "" #: resourcestr.rsalldone msgctxt "resourcestr.rsalldone" msgid "All Done" msgstr "" #: resourcestr.rsallrestored msgctxt "resourcestr.rsallrestored" msgid "Notes and config files Restored, restart suggested." msgstr "" #: resourcestr.rsautosnapshotrun msgid "Completed autosnapshot run." msgstr "" #: resourcestr.rsautosyncnotpossible msgid "Auto sync not possible right now" msgstr "" #: resourcestr.rsbadnotes #, object-pascal-format msgctxt "resourcestr.rsbadnotes" msgid "You have %d bad notes in Notes Directory" msgstr "" #: resourcestr.rsbadnotesfound1 msgctxt "resourcestr.rsbadnotesfound1" msgid "Please go to Settings -> Recover -> Recover Notes" msgstr "" #: resourcestr.rsbadnotesfound2 msgctxt "resourcestr.rsbadnotesfound2" msgid "You should do so to ensure your notes are safe." msgstr "" #: resourcestr.rscannotdelete msgctxt "resourcestr.rscannotdelete" msgid "Cannot delete " msgstr "" #: resourcestr.rscannotfindnote msgctxt "resourcestr.rscannotfindnote" msgid "ERROR, cannot find " msgstr "" #: resourcestr.rschangenameofnotebook msgid "Change the name of this Notebook" msgstr "" #: resourcestr.rschangesync msgid "Change Sync Repo" msgstr "" #: resourcestr.rsclickbadnote msgctxt "resourcestr.rsclickbadnote" msgid "Double click on any Bad Notes" msgstr "" #: resourcestr.rsclicksnapshot msgctxt "resourcestr.rsclicksnapshot" msgid "Click an Available Snapshot" msgstr "" #: resourcestr.rscontentdated msgid "Content Dated" msgstr "" #: resourcestr.rscopyfailed msgctxt "resourcestr.rscopyfailed" msgid "Copying orig to Backup directory failed" msgstr "" #: resourcestr.rscreatenewrepo msgctxt "resourcestr.rscreatenewrepo" msgid "Create a new Repo ?" msgstr "" #: resourcestr.rsdeleteandreplace_1 msgctxt "resourcestr.rsdeleteandreplace_1" msgid "Notes at risk !" msgstr "" #: resourcestr.rsdeleteandreplace_2 #, object-pascal-format msgctxt "resourcestr.rsdeleteandreplace_2" msgid "Delete all notes in %s and replace with snapshot dated %s ?" msgstr "" #: resourcestr.rsdeleteddamaged #, object-pascal-format msgid "OK, deleted %d damaged notes" msgstr "" #: resourcestr.rsdownloaded msgid "Downloaded" msgstr "" #: resourcestr.rsdownloadnotes msgid "Downloading notes" msgstr "" #: resourcestr.rsenternewnotebook msgctxt "resourcestr.rsenternewnotebook" msgid "Enter a new notebook name please" msgstr "" #: resourcestr.rserrorcopyfile msgctxt "resourcestr.rserrorcopyfile" msgid "Failed to copy file, does destination dir exist ?" msgstr "" #: resourcestr.rsfilesyncinfo1 msgid "tomboy-ng uses File Sync to sync to eg DropBox, Google Drive, a USB drive" msgstr "" #: resourcestr.rsfilesyncinfo2 msgid "or uses a remote server over the internet with sshfs" msgstr "" #: resourcestr.rsfindnavlefthint msgid "Backward Find : Shift-F3 or Shift-Ctrl-G" msgstr "" #: resourcestr.rsfindnavlefthintmac msgid "Backward Find : Shift-Command-G" msgstr "" #: resourcestr.rsfindnavrighthint msgid "Find : F3 or Ctrl-G" msgstr "" #: resourcestr.rsfindnavrighthintmac msgid "Find : Command-G" msgstr "" #: resourcestr.rsfound msgctxt "resourcestr.rsfound" msgid "Found" msgstr "" #: resourcestr.rsgithubsyncinfo1 msgid "tomboy-ng can use Github to both sync and display or edit notes" msgstr "" #: resourcestr.rsgithubsyncinfo2 msgid "you should read the tomboy-ng wiki page for instructions." msgstr "" #: resourcestr.rsgithubtokenexpired msgid "Github Token may have expired" msgstr "" #: resourcestr.rshelpconfig msgctxt "resourcestr.rshelpconfig" msgid "Create or use an alternative config" msgstr "" #: resourcestr.rshelpdebug msgctxt "resourcestr.rshelpdebug" msgid "Direct debug output to SOME.LOG." msgstr "" #: resourcestr.rshelpdebugindex msgctxt "resourcestr.rshelpdebugindex" msgid "Show debug msgs while indexing notes" msgstr "" #: resourcestr.rshelpdebugspell msgctxt "resourcestr.rshelpdebugspell" msgid "Show debug messages while spell setup" msgstr "" #: resourcestr.rshelpdebugsync msgctxt "resourcestr.rshelpdebugsync" msgid "Show debug messages during Sync" msgstr "" #: resourcestr.rshelpdelay msgctxt "resourcestr.rshelpdelay" msgid "Delay startup 2 sec to allow OS to settle" msgstr "" #: resourcestr.rshelphelp msgctxt "resourcestr.rshelphelp" msgid "Show this help message and exit." msgstr "" #: resourcestr.rshelplang msgctxt "resourcestr.rshelplang" msgid "Force Language, supported en, es, fr, nl" msgstr "" #: resourcestr.rshelpnosplash msgctxt "resourcestr.rshelpnosplash" msgid "Do not show small status/splash window" msgstr "" #: resourcestr.rshelpsaveexit msgctxt "resourcestr.rshelpsaveexit" msgid "After import single note, save & exit" msgstr "" #: resourcestr.rshelpsinglenote msgctxt "resourcestr.rshelpsinglenote" msgid "Open indicated note, switch is optional" msgstr "" #: resourcestr.rshelpversion msgctxt "resourcestr.rshelpversion" msgid "Print version and exit" msgstr "" #: resourcestr.rslastchange msgid "Last Change" msgstr "" #: resourcestr.rslastsync msgid "Last Sync" msgstr "" #: resourcestr.rslookingatnotes msgctxt "resourcestr.rslookingatnotes" msgid "Looking at notes ...." msgstr "" #: resourcestr.rslookingserverid msgid "Looking for ServerID" msgstr "" #: resourcestr.rsmenuabout msgctxt "resourcestr.rsmenuabout" msgid "About" msgstr "" #: resourcestr.rsmenuhelp msgctxt "resourcestr.rsmenuhelp" msgid "Help" msgstr "" #: resourcestr.rsmenunewnote msgctxt "resourcestr.rsmenunewnote" msgid "New Note" msgstr "" #: resourcestr.rsmenuquit msgctxt "resourcestr.rsmenuquit" msgid "Quit" msgstr "" #: resourcestr.rsmenusearch msgctxt "resourcestr.rsmenusearch" msgid "Search" msgstr "" #: resourcestr.rsmenusettings msgctxt "resourcestr.rsmenusettings" msgid "Settings" msgstr "" #: resourcestr.rsmenusync msgctxt "resourcestr.rsmenusync" msgid "Synchronise" msgstr "" #: resourcestr.rsmetadirwarning msgid "Please remember that to ensure a reliable sync, you must not change files in the Meta directory." msgstr "" #: resourcestr.rsmultiplenotebooks msgctxt "resourcestr.rsmultiplenotebooks" msgid "Settings allow multiple Notebooks" msgstr "" #: resourcestr.rsname msgid "Name" msgstr "" #: resourcestr.rsnewerversionexits msgctxt "resourcestr.rsnewerversionexits" msgid "A newer version exists in main repo" msgstr "" #: resourcestr.rsnotavailable msgid "Not Available" msgstr "" #: resourcestr.rsnotealreadyinrepo msgctxt "resourcestr.rsnotealreadyinrepo" msgid "Note already in Repo" msgstr "" #: resourcestr.rsnotebookoptionctrl msgid "Ctrl click for Notebook Options" msgstr "" #: resourcestr.rsnotebookoptionright msgid "Right click for Notebook Options" msgstr "" #: resourcestr.rsnotebooks msgctxt "resourcestr.rsnotebooks" msgid "Notebooks" msgstr "" #: resourcestr.rsnoteopen msgctxt "resourcestr.rsnoteopen" msgid "You have that note open, please close and try again" msgstr "" #: resourcestr.rsnotes msgctxt "resourcestr.rsnotes" msgid "notes" msgstr "" #: resourcestr.rsnotesdeleted msgid "Note or notes deleted" msgstr "" #: resourcestr.rsnotesinsnap msgctxt "resourcestr.rsnotesinsnap" msgid "Notes in Snapshot" msgstr "" #: resourcestr.rsnotpresent msgctxt "resourcestr.rsnotpresent" msgid "Not present in main repo" msgstr "" #: resourcestr.rsnumbnotesaffected #, object-pascal-format msgid "This will affect %d notes" msgstr "" #: resourcestr.rsonenotebook msgctxt "resourcestr.rsonenotebook" msgid "Settings allow only one Notebook" msgstr "" #: resourcestr.rsoverwritenote msgctxt "resourcestr.rsoverwritenote" msgid "Overwrite newer version of that note" msgstr "" #: resourcestr.rspressclose msgctxt "resourcestr.rspressclose" msgid "Press Close" msgstr "" #: resourcestr.rsrecoverok msgctxt "resourcestr.rsrecoverok" msgid "OK, File recovered." msgstr "" #: resourcestr.rsrenamefailed msgctxt "resourcestr.rsrenamefailed" msgid "ERROR, could not rename Backup File " msgstr "" #: resourcestr.rsrollbackintro msgid "You can roll back to previous version of this note" msgstr "" #: resourcestr.rsrunningsync msgctxt "resourcestr.rsrunningsync" msgid "Running Sync" msgstr "" #: resourcestr.rssaveandsync msgctxt "resourcestr.rssaveandsync" msgid "Press Save and Sync if this looks OK" msgstr "" #: resourcestr.rsscanremote msgid "Scanning remote files" msgstr "" #: resourcestr.rssearchhint msgid "Exact matches for terms between \" \"" msgstr "" #: resourcestr.rssetthenotebooks msgctxt "resourcestr.rssetthenotebooks" msgid "Set the notebooks this note is a member of" msgstr "" #: resourcestr.rssetup msgctxt "resourcestr.rssetup" msgid "Setup" msgstr "" #: resourcestr.rssetupnotesdirfirst msgctxt "resourcestr.rssetupnotesdirfirst" msgid "Please setup a notes directory first" msgstr "" #: resourcestr.rssetupsyncfirst msgctxt "resourcestr.rssetupsyncfirst" msgid "Please config sync system first" msgstr "" #: resourcestr.rssnapshotcreated msgctxt "resourcestr.rssnapshotcreated" msgid "created, do you want to copy it elsewhere ?" msgstr "" #: resourcestr.rssyncerror msgctxt "resourcestr.rssyncerror" msgid "A Sync Error occurred" msgstr "" #: resourcestr.rssyncnotconfig msgctxt "resourcestr.rssyncnotconfig" msgid "not configured" msgstr "" #: resourcestr.rstestingcredentials msgid "Testing Credentials" msgstr "" #: resourcestr.rstestingrepo msgctxt "resourcestr.rstestingrepo" msgid "Testing Repo ...." msgstr "" #: resourcestr.rstestingsync msgctxt "resourcestr.rstestingsync" msgid "Testing Sync" msgstr "" #: resourcestr.rstryrecover_1 msgid "Try to recover a bad note by double clicking below," msgstr "" #: resourcestr.rstryrecover_2 msgctxt "resourcestr.rstryrecover_2" msgid "if that fails, you may be able to recover it from a Snapshot." msgstr "" #: resourcestr.rsunabletoproceed msgctxt "resourcestr.rsunabletoproceed" msgid "Unable to proceed because" msgstr "" #: resourcestr.rsunabletosync msgctxt "resourcestr.rsunabletosync" msgid "Unable to sync because " msgstr "" #: resourcestr.rsuploaded msgid "Uploaded" msgstr "" #: resourcestr.rsuploading msgid "Uploading" msgstr "" #: resourcestr.rswarnnossystray msgid "WARNING, your Desktop might not display SysTray" msgstr "" #: resourcestr.rswehavesnapshots #, object-pascal-format msgid "We have %d snapshots" msgstr "" #: settings.rsdictionaryfailed msgid "Library Not Loaded" msgstr "" #: settings.rsdictionaryloaded msgid "Dictionary Loaded OK" msgstr "" #: settings.rsdictionarynotfound msgid "No Dictionary Found" msgstr "" #: settings.rsdirhasnonotes msgid "That directory does not contain any notes. That is OK, if I can make my own there." msgstr "" #: settings.rserrorcannotwrite msgid "Cannot write into" msgstr "" #: settings.rserrorcreatedir msgid "Unable to Create Directory" msgstr "" #: settings.rsselectdictionary msgid "Select the dictionary you want to use" msgstr "" #: settings.rsselectlibrary msgid "Select your hunspell library" msgstr "" #: spelling.rscheckingfull msgid "Checking full document" msgstr "" #: spelling.rscheckingselection msgid "Checking selection" msgstr "" #: spelling.rsreplace_with_1 msgid "replace" msgstr "" #: spelling.rsreplace_with_2 msgid "with" msgstr "" #: spelling.rsspellcomplete msgid "Spell check complete" msgstr "" #: spelling.rsspellnotconfig msgid "Spelling not configured" msgstr "" #: syncutils.rschangeexistingsync msgid "Change existing sync connection ?" msgstr "" #: syncutils.rsclashes msgid "Clashes " msgstr "" #: syncutils.rsdonothing msgid "Do Nothing " msgstr "" #: syncutils.rsdownloads msgid "Downloads " msgstr "" #: syncutils.rsedituploads msgid "Edit Uploads " msgstr "" #: syncutils.rslocaldeletes msgid "Local Deletes " msgstr "" #: syncutils.rsnewuploads msgid "New Uploads " msgstr "" #: syncutils.rsnextbitslow msgid "Next bit can be a bit slow, please wait" msgstr "" #: syncutils.rsnonotesneededsync msgid "No notes needed syncing. You need to write more." msgstr "" #: syncutils.rsnotesweredealt msgid " notes were dealt with." msgstr "" #: syncutils.rsnotrecommend msgid "Generally not recommended." msgstr "" #: syncutils.rsremotedeletes msgid "Remote Deletes " msgstr "" #: syncutils.rssyncerrors msgid "ERRORS (see console log) " msgstr "" #: teditboxform.buttmaintbmenu.caption msgctxt "teditboxform.buttmaintbmenu.caption" msgid "Menu" msgstr "" #: teditboxform.editfind.text msgid "EditFind" msgstr "" #: teditboxform.label2.caption msgid "Read Only" msgstr "" #: teditboxform.label3.caption msgid "This note has been changed by the Sync Process" msgstr "" #: teditboxform.label4.caption msgid "Please close it (and re-open if it was a download)" msgstr "" #: teditboxform.labelfindinfo.caption msgid "LabelFindInfo" msgstr "" #: teditboxform.menubold.caption msgctxt "teditboxform.menubold.caption" msgid "Bold" msgstr "" #: teditboxform.menufindnext.caption msgid "Find Next" msgstr "" #: teditboxform.menufindprev.caption msgctxt "teditboxform.menufindprev.caption" msgid "Find Prev" msgstr "" #: teditboxform.menufixedwidth.caption msgid "Fixed Width" msgstr "" #: teditboxform.menuhighlight.caption msgctxt "teditboxform.menuhighlight.caption" msgid "Highlight" msgstr "" #: teditboxform.menuhuge.caption msgctxt "teditboxform.menuhuge.caption" msgid "Huge" msgstr "" #: teditboxform.menuitalic.caption msgid "Italic" msgstr "" #: teditboxform.menuitembulletleft.caption msgid "Bullet <<" msgstr "" #: teditboxform.menuitembulletright.caption msgid "Bullet >>" msgstr "" #: teditboxform.menuitemcopy.caption msgid "Copy" msgstr "" #: teditboxform.menuitemcut.caption msgid "Cut" msgstr "" #: teditboxform.menuitemdelete.caption msgctxt "teditboxform.menuitemdelete.caption" msgid "Delete" msgstr "" #: teditboxform.menuitemevaluate.caption msgid "Evaluate" msgstr "" #: teditboxform.menuitemexport.caption msgid "Export" msgstr "" #: teditboxform.menuitemexportmarkdown.caption msgid "Export Markdown" msgstr "" #: teditboxform.menuitemexportplaintext.caption msgid "Export Plain Text" msgstr "" #: teditboxform.menuitemexportrtf.caption msgid "Export RTF" msgstr "" #: teditboxform.menuitemfind.caption msgid "Find in this Note" msgstr "" #: teditboxform.menuitemindex.caption msgid "Index" msgstr "" #: teditboxform.menuitempaste.caption msgid "Paste" msgstr "" #: teditboxform.menuitemprint.caption msgid "Print" msgstr "" #: teditboxform.menuitemselectall.caption msgid "Select All" msgstr "" #: teditboxform.menuitemsettings.caption msgctxt "teditboxform.menuitemsettings.caption" msgid "Settings" msgstr "" #: teditboxform.menuitemspell.caption msgid "Spell Check" msgstr "" #: teditboxform.menuitemsync.caption msgid "Synchronize" msgstr "" #: teditboxform.menularge.caption msgid "Large Font" msgstr "" #: teditboxform.menunormal.caption msgid "Normal Font" msgstr "" #: teditboxform.menusmall.caption msgid "Small Font" msgstr "" #: teditboxform.menustayontop.caption msgid "Stay On Top" msgstr "" #: teditboxform.menustrikeout.caption msgid "Strikeout" msgstr "" #: teditboxform.menuunderline.caption msgid "Underline" msgstr "" #: teditboxform.speedbuttondelete.hint msgid "Delete this note" msgstr "" #: teditboxform.speedbuttonlink.hint msgid "Link highlighted text to a new note" msgstr "" #: teditboxform.speedbuttonnotebook.hint msgid "Manage Notebooks" msgstr "" #: teditboxform.speedbuttonsearch.hint msgid "Search All Notes Ctrl-Shift-F" msgstr "" #: teditboxform.speedbuttontext.hint msgid "Font size, bold, italics etc" msgstr "" #: teditboxform.speedbuttontools.hint msgid "Tools - Sync, Export, Spell" msgstr "" #: teditboxform.speedrollback.hint msgid "Roll Back" msgstr "" #: tformbackupview.buttondelete.caption msgctxt "tformbackupview.buttondelete.caption" msgid "Delete" msgstr "" #: tformbackupview.buttondelete.hint msgid "Really, totally delete this note." msgstr "" #: tformbackupview.buttonok.caption msgctxt "tformbackupview.buttonok.caption" msgid "Close" msgstr "" #: tformbackupview.buttonok.hint msgid "My work here is done." msgstr "" #: tformbackupview.buttonopen.caption msgid "View" msgstr "" #: tformbackupview.buttonopen.hint msgid "Open and view the whole note" msgstr "" #: tformbackupview.buttonrecover.caption msgctxt "tformbackupview.buttonrecover.caption" msgid "Recover" msgstr "" #: tformbackupview.buttonrecover.hint msgid "Restore this note to main repo" msgstr "" #: tformbackupview.caption msgid "View, recover or delete Backup Files" msgstr "" #: tformbackupview.listbox1.hint msgid "Use Ctrl or Shift to select multiple entries" msgstr "" #: tformcolours.label1.caption msgid "Sample" msgstr "" #: tformcolours.label2.caption msgctxt "tformcolours.label2.caption" msgid "Set Colours" msgstr "" #: tformcolours.speedbackground.caption msgid "Background" msgstr "" #: tformcolours.speedcancel.caption msgctxt "tformcolours.speedcancel.caption" msgid "Cancel" msgstr "" #: tformcolours.speeddefault.caption msgid "Default" msgstr "" #: tformcolours.speedhighlight.caption msgctxt "tformcolours.speedhighlight.caption" msgid "Highlight" msgstr "" #: tformcolours.speedok.caption msgctxt "tformcolours.speedok.caption" msgid "OK" msgstr "" #: tformcolours.speedtext.caption msgid "Text" msgstr "" #: tformcolours.speedtitle.caption msgctxt "tformcolours.speedtitle.caption" msgid "Title" msgstr "" #: tformindex.caption msgid "Heading in this Note" msgstr "" #: tformindex.panel1.caption msgid "Single lines, all Huge, Large Bold or Large" msgstr "" #: tformrecover.buttondeletebadnotes.caption msgid "Delete Bad Notes" msgstr "" #: tformrecover.buttonmakesafetysnap.caption msgid "Take a manual Snapshot" msgstr "" #: tformrecover.buttonmakesafetysnap.hint msgid "Take a initial snapshot of your notes and config. Overwritten each time." msgstr "" #: tformrecover.buttonrecoversnap.caption msgctxt "tformrecover.buttonrecoversnap.caption" msgid "Recover" msgstr "" #: tformrecover.buttonsnaphelp.caption msgid "Snapshot Help" msgstr "" #: tformrecover.label10.caption msgid "Please close any notes you may have open." msgstr "" #: tformrecover.label12.caption msgid "Don't even consider this unless you have a backup Snapshot, Intro Tab." msgstr "" #: tformrecover.label14.caption msgid "Click an available snapshot to see its contents." msgstr "" #: tformrecover.label15.caption msgid "Click an available snapshot, click Recover" msgstr "" #: tformrecover.label16.caption msgid "You may chose to view, copy and paste into a new note." msgstr "" #: tformrecover.label2.caption msgid "Please be careful, this is a dangerous place!" msgstr "" #: tformrecover.label3.caption msgid "Restore any notes in the snapshot that are not in the existing notes directory." msgstr "" #: tformrecover.label4.caption msgid "Remove all existing notes and use the ones in the Snapshot." msgstr "" #: tformrecover.label5.caption msgid "Looking for notes with damaged XML" msgstr "" #: tformrecover.label6.caption msgid "This tool might help you recover lost or damaged notes." msgstr "" #: tformrecover.label7.caption msgid "Before you start, take a Snapshot of your notes directory." msgstr "" #: tformrecover.label9.caption msgid "From here you can view snapshot notes, one by one." msgstr "" #: tformrecover.listboxsnapshots.hint msgid "These are the currently known snapshots. " msgstr "" #: tformrecover.panelsnapshots.caption msgid "Available Snapshots" msgstr "" #: tformrecover.tabsheetbadnotes.caption msgid "Bad Notes" msgstr "" #: tformrecover.tabsheetintro.caption msgid "Introduction" msgstr "" #: tformrecover.tabsheetmergesnapshot.caption msgid "Merge Snapshot" msgstr "" #: tformrecover.tabsheetrecovernotes.caption msgid "Recover Notes" msgstr "" #: tformrecover.tabsheetrecoversnapshot.caption msgid "Recover Snapshot" msgstr "" #: tformrollback.speedcancel.caption msgctxt "tformrollback.speedcancel.caption" msgid "Cancel" msgstr "" #: tformrollback.speedrolltoopen.caption msgid "Opening Backup" msgstr "" #: tformrollback.speedrolltotitle.caption msgid "Title Change Backup" msgstr "" #: tformsdiff.bitbtnuselocal.caption msgid "Use Local" msgstr "" #: tformsdiff.bitbtnuseremote.caption msgid "Use Remote" msgstr "" #: tformsdiff.buttalllocal.caption msgid "Local" msgstr "" #: tformsdiff.buttallnewest.caption msgid "Newest" msgstr "" #: tformsdiff.buttalloldest.caption msgid "Oldest" msgstr "" #: tformsdiff.buttallremote.caption msgid "Remote" msgstr "" #: tformsdiff.caption msgid "A Note Sync Clash has been Detected" msgstr "" #: tformsdiff.label1.caption msgid "Or make a choice for remainder of this run" msgstr "" #: tformsdiff.label3.caption msgid "Remote Changed" msgstr "" #: tformsdiff.label4.caption msgid "Local Changed" msgstr "" #: tformsdiff.radiolong.caption msgid "Long Lines" msgstr "" #: tformsdiff.radiolong.hint msgid "Maybe necessary to show difference" msgstr "" #: tformsdiff.radioshort.caption msgid "Short Lines" msgstr "" #: tformsdiff.radioshort.hint msgid "Easier to read" msgstr "" #: tformspell.buttonignore.caption msgid "Ignore" msgstr "" #: tformspell.buttonignore.hint msgid "Ignore all instances for the run" msgstr "" #: tformspell.buttonskip.caption msgid "Skip" msgstr "" #: tformspell.buttonskip.hint msgid "Skip just this instance" msgstr "" #: tformspell.buttonuseandnextword.caption msgid "Use and Next Word" msgstr "" #: tformspell.caption msgctxt "tformspell.caption" msgid "Spell" msgstr "" #: tformspell.label4.caption msgid "Suspect word -" msgstr "" #: tformspell.labelprompt.caption msgid "Click a word to use it." msgstr "" #: tformsync.buttoncancel.caption msgctxt "tformsync.buttoncancel.caption" msgid "Cancel" msgstr "" #: tformsync.buttonclose.caption msgctxt "tformsync.buttonclose.caption" msgid "Close" msgstr "" #: tformsync.buttonsave.caption msgid "Save and Sync" msgstr "" #: tformsync.caption msgctxt "tformsync.caption" msgid "Sync" msgstr "" #: tformsync.labelprogress.caption msgid "LabelProgress" msgstr "" #: tformsync.listviewreport.columns[0].caption msgid "Action" msgstr "" #: tformsync.listviewreport.columns[1].caption msgctxt "tformsync.listviewreport.columns[1].caption" msgid "Title" msgstr "" #: tformsync.listviewreport.columns[2].caption msgid "Note ID" msgstr "" #: tformtomdroid.buttonclose.caption msgctxt "tformtomdroid.buttonclose.caption" msgid "Close" msgstr "" #: tformtomdroid.buttondelete.caption msgid "Delete Profile" msgstr "" #: tformtomdroid.buttonhelp.caption msgctxt "tformtomdroid.buttonhelp.caption" msgid "Help" msgstr "" #: tformtomdroid.buttonjoin.caption msgctxt "tformtomdroid.buttonjoin.caption" msgid "Join" msgstr "" #: tformtomdroid.buttonsaveprofile.caption msgid "Save Profile" msgstr "" #: tformtomdroid.buttonsync.caption msgctxt "tformtomdroid.buttonsync.caption" msgid "Sync" msgstr "" #: tformtomdroid.caption msgctxt "tformtomdroid.caption" msgid "Tomdroid" msgstr "" #: tformtomdroid.checkboxdebugmode.caption msgid "Debug Mode" msgstr "" #: tformtomdroid.checkboxdebugmode.hint msgid "writes debug messages to terminal" msgstr "" #: tformtomdroid.checkboxtestrun.caption msgctxt "tformtomdroid.checkboxtestrun.caption" msgid "Test Run" msgstr "" #: tformtomdroid.checksavepassword.caption msgctxt "tformtomdroid.checksavepassword.caption" msgid "Save" msgstr "" #: tformtomdroid.editprofilename.hint msgid "eg MySamsungNote7" msgstr "" #: tformtomdroid.label1.caption msgid "Tomdroid SSH Sync - deprecated, will be dropped soon." msgstr "" #: tformtomdroid.label2.caption msgid "Select an existing profile (or enter data) " msgstr "" #: tformtomdroid.label3.caption msgid "Profile Name" msgstr "" #: tformtomdroid.label4.caption msgid "IP address of device" msgstr "" #: tformtomdroid.label5.caption msgid "SSH Password for device" msgstr "" #: tformtomdroid.label6.caption msgctxt "tformtomdroid.label6.caption" msgid "Upload means from tomboy-ng to Android Device" msgstr "" #: tformtomdroidfile.buttonclose.caption msgctxt "tformtomdroidfile.buttonclose.caption" msgid "Close" msgstr "" #: tformtomdroidfile.buttonhelp.caption msgctxt "tformtomdroidfile.buttonhelp.caption" msgid "Help" msgstr "" #: tformtomdroidfile.buttonjoin.caption msgctxt "tformtomdroidfile.buttonjoin.caption" msgid "Join" msgstr "" #: tformtomdroidfile.buttonoldssh.caption msgid "Use old SSH model" msgstr "" #: tformtomdroidfile.buttonsync.caption msgctxt "tformtomdroidfile.buttonsync.caption" msgid "Sync" msgstr "" #: tformtomdroidfile.caption msgctxt "tformtomdroidfile.caption" msgid "Tomdroid" msgstr "" #: tformtomdroidfile.checkboxtestrun.caption msgctxt "tformtomdroidfile.checkboxtestrun.caption" msgid "Test Run" msgstr "" #: tformtomdroidfile.label1.caption msgid "Tomdroid Sync - be aware of limitations !" msgstr "" #: tformtomdroidfile.label6.caption msgctxt "tformtomdroidfile.label6.caption" msgid "Upload means from tomboy-ng to Android Device" msgstr "" #: tmainform.bitbtnhide.caption msgid "Hide" msgstr "" #: tmainform.bitbtnquit.caption msgctxt "tmainform.bitbtnquit.caption" msgid "Quit" msgstr "" #: tmainform.buttmenu.caption msgctxt "tmainform.buttmenu.caption" msgid "Menu" msgstr "" #: tmainform.buttsystrayhelp.caption msgid "SysTray Help" msgstr "" #: tmainform.caption msgid "tomboy-ng" msgstr "" #: tmainform.checkboxdontshow.caption msgid "Don't Show for normal startup" msgstr "" #: tmainform.checkboxdontshow.hint msgid "You can reverse this from Settings" msgstr "" #: tmainform.hint msgid "If the yellow tomboy-ng icon is visible in your System Tray, you can dismiss this window." msgstr "" #: tmainform.label3.caption msgid "Dictionary Config (optional)" msgstr "" #: tmainform.label4.caption msgid "Sync Config (optional)" msgstr "" #: tmainform.label5.caption msgid "Welcome to tomboy-ng !" msgstr "" #: tmainform.labelerror.hint msgid "Launch from commandline to see errors or see Config->SnapShot->Recover ..." msgstr "" #: tnotebookpick.button1.caption msgctxt "tnotebookpick.button1.caption" msgid "Cancel" msgstr "" #: tnotebookpick.buttonok.caption msgctxt "tnotebookpick.buttonok.caption" msgid "OK" msgstr "" #: tnotebookpick.label4.caption msgid "Name of the New Notebook" msgstr "" #: tnotebookpick.label5.caption msgid "Press OK and we will make the Note Book AND add this note to it." msgstr "" #: tnotebookpick.label6.caption msgid "Existing Name" msgstr "" #: tnotebookpick.label8.caption msgid "New Name" msgstr "" #: tnotebookpick.label9.caption msgid "If you sync and are not absolutely sure its up to date, Cancel now !" msgstr "" #: tnotebookpick.tabchangename.caption msgid "Change Notebook Name" msgstr "" #: tnotebookpick.tabexisting.caption msgid "Existing Note Books" msgstr "" #: tnotebookpick.tabnewnotebook.caption msgid "New Note Book" msgstr "" #: tnotebookpick.tabsetnotes.caption msgid "Set Notes" msgstr "" #: tomdroid.rscheckingforexistingsync msgctxt "tomdroid.rscheckingforexistingsync" msgid "Checking for an existing sync ...." msgstr "" #: tomdroid.rsconnectiongood msgctxt "tomdroid.rsconnectiongood" msgid "Connection is looking Good." msgstr "" #: tomdroid.rsfailedtoconnect msgctxt "tomdroid.rsfailedtoconnect" msgid "Failed to connect." msgstr "" #: tomdroid.rsfailedtofindconnection_1 msgctxt "tomdroid.rsfailedtofindconnection_1" msgid "Failed to find an existing connection." msgstr "" #: tomdroid.rsfailedtofindconnection_2 msgctxt "tomdroid.rsfailedtofindconnection_2" msgid "If you are sure there should be an existing connection, check settings." msgstr "" #: tomdroid.rsfailedtofindconnection_3 msgctxt "tomdroid.rsfailedtofindconnection_3" msgid "Otherwise, try joining a new connection." msgstr "" #: tomdroid.rsfixconnection msgctxt "tomdroid.rsfixconnection" msgid "If you are sure its there, check settings." msgstr "" #: tomdroid.rshavevalidsync msgctxt "tomdroid.rshavevalidsync" msgid "Looking Good. Last sync date " msgstr "" #: tomdroid.rsinstalltomdroid msgctxt "tomdroid.rsinstalltomdroid" msgid "Install Tomdroid, config filesync, and run a sync" msgstr "" #: tomdroid.rsnoconnection msgctxt "tomdroid.rsnoconnection" msgid "Failed to establish a connection. " msgstr "" #: tomdroid.rsnotcorrectprofile msgctxt "tomdroid.rsnotcorrectprofile" msgid "This is not correct profile for that device" msgstr "" #: tomdroid.rsnotexistingrepo msgctxt "tomdroid.rsnotexistingrepo" msgid "That's not an existing Repo, maybe click \"Join\" ?" msgstr "" #: tomdroid.rsnotomdroid msgctxt "tomdroid.rsnotomdroid" msgid "Unable to find Tomdroid sync dir on that device." msgstr "" #: tomdroid.rsselectprofile msgid "Select a profile" msgstr "" #: tomdroid.rssetupnewsync msgctxt "tomdroid.rssetupnewsync" msgid "Setting up a new sync ...." msgstr "" #: tomdroid.rstalkingtodevice msgctxt "tomdroid.rstalkingtodevice" msgid "OK, talking to device. Wait for it ...." msgstr "" #: tomdroidfile.rsconnectiongood msgctxt "tomdroidfile.rsconnectiongood" msgid "Connection is looking Good." msgstr "" #: tomdroidfile.rsfailedtoconnect msgctxt "tomdroidfile.rsfailedtoconnect" msgid "Failed to connect." msgstr "" #: tomdroidfile.rsfailedtofindconnection_2 msgctxt "tomdroidfile.rsfailedtofindconnection_2" msgid "If you are sure there should be an existing connection, check settings." msgstr "" #: tomdroidfile.rsfixconnection msgctxt "tomdroidfile.rsfixconnection" msgid "If you are sure its there, check settings." msgstr "" #: tomdroidfile.rshavevalidsync msgctxt "tomdroidfile.rshavevalidsync" msgid "Looking Good. Last sync date " msgstr "" #: tomdroidfile.rsinstalltomdroid msgctxt "tomdroidfile.rsinstalltomdroid" msgid "Install Tomdroid, config filesync, and run a sync" msgstr "" #: tomdroidfile.rsjoinanyway msgid "Forcing a Join may \"recover\" some notes you thought you have deleted." msgstr "" #: tomdroidfile.rsnoconnection msgctxt "tomdroidfile.rsnoconnection" msgid "Failed to establish a connection. " msgstr "" #: tomdroidfile.rsnotcorrectprofile msgctxt "tomdroidfile.rsnotcorrectprofile" msgid "This is not correct profile for that device" msgstr "" #: tomdroidfile.rsnotexistingrepo msgctxt "tomdroidfile.rsnotexistingrepo" msgid "That's not an existing Repo, maybe click \"Join\" ?" msgstr "" #: tomdroidfile.rsnotomdroid msgctxt "tomdroidfile.rsnotomdroid" msgid "Unable to find Tomdroid sync dir on that device." msgstr "" #: tomdroidfile.rssetupnewsync msgctxt "tomdroidfile.rssetupnewsync" msgid "Setting up a new sync ...." msgstr "" #: tomdroidfile.rstalking msgctxt "tomdroidfile.rstalking" msgid "OK, talking to device. Wait for it ...." msgstr "" #: tsearchform.buttonclearfilters.caption msgid "Clear Filters" msgstr "" #: tsearchform.buttonmenu.caption msgctxt "tsearchform.buttonmenu.caption" msgid "Menu" msgstr "" #: tsearchform.buttonrefresh.caption msgid "Refresh" msgstr "" #: tsearchform.buttonrefresh.hint msgid "Update Search Results" msgstr "" #: tsearchform.caption msgid "tomboy-ng_Search" msgstr "" #: tsearchform.checkautorefresh.caption msgid "Auto Refresh" msgstr "" #: tsearchform.checkcasesensitive.caption msgid "Case Sensitive" msgstr "" #: tsearchform.listboxnotebooks.hint msgid "Right Click to manage Notebooks" msgstr "" #: tsearchform.menucreatenotebook.caption msgid "Create new Note Book" msgstr "" #: tsearchform.menudeletenotebook.caption msgid "Delete Notebook" msgstr "" #: tsearchform.menueditnotebooktemplate.caption msgid "Edit Notebook Template" msgstr "" #: tsearchform.menuitemmanagenbook.caption msgid "Manage Notes in Note Book" msgstr "" #: tsearchform.menunewnotefromtemplate.caption msgid "Create New Note from Template" msgstr "" #: tsearchform.menurenamenotebook.caption msgid "Rename NoteBook" msgstr "" #: tsearchform.panel2.caption msgctxt "tsearchform.panel2.caption" msgid "Notebooks" msgstr "" #: tsett.buttdefaultnotedir.caption msgid "Use Default Notes Location" msgstr "" #: tsett.buttdefaultnotedir.hint msgid "Will work for many new users" msgstr "" #: tsett.buttonfixedfont.caption msgid "Fixed Font" msgstr "" #: tsett.buttonfont.caption msgid "Usual Font" msgstr "" #: tsett.buttonmanualsnap.caption msgid "Take a Manual Snapshot" msgstr "" #: tsett.buttonmanualsnap.hint msgid "Take a time stamped snapshot of notes and config" msgstr "" #: tsett.buttonsetcolours.caption msgctxt "tsett.buttonsetcolours.caption" msgid "Set Colours" msgstr "" #: tsett.buttonsetdictionary.caption msgid "Set Dictionary" msgstr "" #: tsett.buttonsetnotepath.caption msgid "Set Path to Note Files" msgstr "" #: tsett.buttonsetnotepath.hint msgid "If you have notes somewhere else" msgstr "" #: tsett.buttonsetspelllibrary.caption msgid "Set Spell Library" msgstr "" #: tsett.buttonshowbackup.caption msgid "Show Me" msgstr "" #: tsett.buttonsnaprecover.caption msgid "Recover Lost Notes" msgstr "" #: tsett.buttonsnaprecover.hint msgid "If you have previously taken a snapshot ..." msgstr "" #: tsett.checkautosnapenabled.caption msgid "Use auto snapshots" msgstr "" #: tsett.checkautostart.caption msgid "Autostart at Logon" msgstr "" #: tsett.checkboxautosync.caption msgid "Auto Sync" msgstr "" #: tsett.checkboxautosync.hint msgid "Sync, if possible once an hour." msgstr "" #: tsett.checkmanynotebooks.caption msgid "Allow a Note to be in Multiple Notebooks." msgstr "" #: tsett.checkmanynotebooks.hint msgid "This may adversly affect traditional Tomboy, take care." msgstr "" #: tsett.checknotifications.caption msgid "Show Notifications" msgstr "" #: tsett.checkshowextlinks.caption msgid "Show External Links" msgstr "" #: tsett.checkshowintlinks.caption msgid "Show Internal Links" msgstr "" #: tsett.checkshowsearchatstart.caption msgid "Show Search at Start" msgstr "" #: tsett.checkshowsplash.caption msgid "Show Splash at Start" msgstr "" #: tsett.checkshowsplash.hint msgid "Always shown if error loading notes." msgstr "" #: tsett.checkshowtomdroid.caption msgid "Show Tomdroid Sync (experimental)" msgstr "" #: tsett.checkstampbold.caption msgctxt "tsett.checkstampbold.caption" msgid "Bold" msgstr "" #: tsett.checkstampitalics.caption msgid "Italics" msgstr "" #: tsett.checkstampsmall.caption msgctxt "tsett.checkstampsmall.caption" msgid "Small" msgstr "" #: tsett.checksyncenabled.caption msgid "Sync Enabled" msgstr "" #: tsett.checkuseundo.caption msgid "Use Undo Redo (may slow editing)" msgstr "" #: tsett.checkuseundo.hint msgid "Close and reopen a note to take effect. Use Ctrl-Z Ctrl-Y" msgstr "" #: tsett.combosynctype.text msgid "ComboSyncType" msgstr "" #: tsett.editusername.text msgid "EditUserName" msgstr "" #: tsett.groupbox4.caption msgid " Options " msgstr "" #: tsett.groupbox5.caption msgid "Font Size" msgstr "" #: tsett.groupboxsync.caption msgid " Sync " msgstr "" #: tsett.label1.caption msgid "Settings will be saved in :" msgstr "" #: tsett.label10.caption msgid "Help Notes Language" msgstr "" #: tsett.label11.caption msgid "Backup Files" msgstr "" #: tsett.label13.caption msgid "Spell Check requires the Hunspell Libraries and" msgstr "" #: tsett.label14.caption msgid "an appropriate Hunspell Dictionary set." msgstr "" #: tsett.label16.caption msgid "Maximum number of snapshots" msgstr "" #: tsett.label17.caption msgid "Date Stamp Format" msgstr "" #: tsett.label2.caption msgid "Notes will be looked for and saved in :" msgstr "" #: tsett.label3.caption msgid "When a conflict is detected between a local note and remote one :" msgstr "" #: tsett.label4.caption msgid "Repo : " msgstr "" #: tsett.label5.caption msgid "Days per snapshot" msgstr "" #: tsett.label6.caption msgid "Backup files are made when you delete a note or the sync system" msgstr "" #: tsett.label7.caption msgid "is about to overwrite one. " msgstr "" #: tsett.label8.caption msgid "They remain, forever, unless you do something about them." msgstr "" #: tsett.label9.caption msgid "A snaphot is a copy of your current note directory." msgstr "" #: tsett.labellabeltoken.caption msgctxt "tsett.labellabeltoken.caption" msgid "Token" msgstr "" #: tsett.labelsnapdir.caption msgid "Snap dir" msgstr "" #: tsett.labelsyncinfo1.caption msgid "LabelSyncInfo1" msgstr "" #: tsett.labelsyncinfo2.caption msgid "LabelSyncInfo2" msgstr "" #: tsett.labelsyncrepo.caption msgctxt "tsett.labelsyncrepo.caption" msgid "not configured" msgstr "" #: tsett.labelsynctype.caption msgid "Sync Type" msgstr "" #: tsett.labeltoken.caption msgid "LabelToke" msgstr "" #: tsett.labelusername.caption msgid "User" msgstr "" #: tsett.radioalwaysask.caption msgid "Always Ask me what to do." msgstr "" #: tsett.radiofontbig.caption msgid "Big" msgstr "" #: tsett.radiofonthuge.caption msgctxt "tsett.radiofonthuge.caption" msgid "Huge" msgstr "" #: tsett.radiofontmedium.caption msgid "Medium" msgstr "" #: tsett.radiofontsmall.caption msgctxt "tsett.radiofontsmall.caption" msgid "Small" msgstr "" #: tsett.radiouselocal.caption msgid "Use Local Note and Overwrite Server Note." msgstr "" #: tsett.radiouseserver.caption msgid "Use Server Note and Rename Local Note." msgstr "" #: tsett.speedbuthelp.caption msgctxt "tsett.speedbuthelp.caption" msgid "Help" msgstr "" #: tsett.speedbuthide.caption msgctxt "tsett.speedbuthide.caption" msgid "Close" msgstr "" #: tsett.speedbutttbmenu.caption msgctxt "tsett.speedbutttbmenu.caption" msgid "Menu" msgstr "" #: tsett.speedsetupsync.caption msgctxt "tsett.speedsetupsync.caption" msgid "Setup" msgstr "" #: tsett.speedtokencopy.hint msgid "Copy Token" msgstr "" #: tsett.speedtokenpaste.hint msgid "Paste Token" msgstr "" #: tsett.tabbackup.caption msgid "BackUp" msgstr "" #: tsett.tabbasic.caption msgid "Basic" msgstr "" #: tsett.tabdisplay.caption msgid "Notes" msgstr "" #: tsett.tabrecover.caption msgctxt "tsett.tabrecover.caption" msgid "Recover" msgstr "" #: tsett.tabspell.caption msgctxt "tsett.tabspell.caption" msgid "Spell" msgstr "" #: tsett.tabsync.caption msgctxt "tsett.tabsync.caption" msgid "Sync" msgstr "" tomboy-ng_0.34-1/po/tomboy-ng.nl.po0000644000175000017500000012453214145033507016725 0ustar dbannondbannon# Heimen Stoffels , 2019. msgid "" msgstr "" "Last-Translator: Heimen Stoffels \n" "PO-Revision-Date: 2019-09-19 23:28+0200\n" "Project-Id-Version: \n" "Language-Team: Dutch \n" "Language: nl\n" "Content-Type: text/plain; charset=UTF-8\n" "Content-Transfer-Encoding: 8bit\n" "MIME-Version: 1.0\n" "Plural-Forms: nplurals=2; plural=(n != 1);\n" "X-Generator: Lokalize 19.11.70\n" #: editbox.rsunabletoevaluate msgid "Unable to find an expression to evaluate" msgstr "Geen te evalueren expressie aangetroffen" #: mainunit.rsabout1 msgid "This is tomboy-ng, a rewrite of Tomboy Notes using Lazarus" msgstr "Dit is tomboy-ng, een vernieuwde versie van Tomboy Notities, geschreven in Lazarus" #: mainunit.rsabout2 #, fuzzy #| msgid "and FPC. While its getting close to being ready for production" msgid "and FPC. While its ready for production" msgstr "en FPC. Hoewel tomboy-ng bijka klaar is voor gebruik," #: mainunit.rsabout3 msgid "use, you still need to be careful and have good backups." msgstr "moet je nog steeds voorzichtig zijn en beschikken over back-ups." #: mainunit.rsaboutbdate msgid "Build date" msgstr "Gebouwd op" #: mainunit.rsaboutcpu msgid "TargetCPU" msgstr "DoelCPU" #: mainunit.rsaboutoperatingsystem msgid "OS" msgstr "Best.syst." #: mainunit.rsaboutver msgid "Version" msgstr "Versie" #: mainunit.rsfailedtoindex msgid "Failed to index one or more notes." msgstr "Kan één of meerdere notities niet indexeren." #: resourcestr.rsaddnotestonotebook msgid "Add notes to this Notebook" msgstr "" #: resourcestr.rsalldone #, fuzzy msgctxt "resourcestr.rsalldone" msgid "All Done" msgstr "Voltooid" #: resourcestr.rsallrestored #, fuzzy msgctxt "resourcestr.rsallrestored" msgid "Notes and config files Restored, restart suggested." msgstr "Notities en configuratiebestanden hersteld; herstart tomboy-ng." #: resourcestr.rsautosnapshotrun msgid "Completed autosnapshot run." msgstr "" #: resourcestr.rsautosyncnotpossible msgid "Auto sync not possible right now" msgstr "" #: resourcestr.rsbadnotes #, object-pascal-format msgctxt "resourcestr.rsbadnotes" msgid "You have %d bad notes in Notes Directory" msgstr "" #: resourcestr.rsbadnotesfound1 #, fuzzy #| msgid "Bad notes found, goto Settings -> Snapshots -> Existing Notes." msgctxt "resourcestr.rsbadnotesfound1" msgid "Please go to Settings -> Recover -> Recover Notes" msgstr "Onjuiste notities aangetroffen. Ga naar Instellingen --> Momentopnamen --> Bestaande notities." #: resourcestr.rsbadnotesfound2 #, fuzzy msgctxt "resourcestr.rsbadnotesfound2" msgid "You should do so to ensure your notes are safe." msgstr "Zorg ervoor dat je notities beveiligd zijn." #: resourcestr.rscannotdelete #, fuzzy msgctxt "resourcestr.rscannotdelete" msgid "Cannot delete " msgstr "Kan niet verwijderen" #: resourcestr.rscannotfindnote msgctxt "resourcestr.rscannotfindnote" msgid "ERROR, cannot find " msgstr "" #: resourcestr.rschangenameofnotebook msgid "Change the name of this Notebook" msgstr "" #: resourcestr.rschangesync msgid "Change Sync Repo" msgstr "" #: resourcestr.rsclickbadnote #, fuzzy msgctxt "resourcestr.rsclickbadnote" msgid "Double click on any Bad Notes" msgstr "Dubbelklik op de onjuiste notities" #: resourcestr.rsclicksnapshot msgctxt "resourcestr.rsclicksnapshot" msgid "Click an Available Snapshot" msgstr "" #: resourcestr.rscontentdated msgid "Content Dated" msgstr "" #: resourcestr.rscopyfailed #, fuzzy msgctxt "resourcestr.rscopyfailed" msgid "Copying orig to Backup directory failed" msgstr "Kan origineel niet kopiëren naar back-upmap" #: resourcestr.rscreatenewrepo #, fuzzy msgctxt "resourcestr.rscreatenewrepo" msgid "Create a new Repo ?" msgstr "Wil je een nieuwe repo maken?" #: resourcestr.rsdeleteandreplace_1 #, fuzzy msgctxt "resourcestr.rsdeleteandreplace_1" msgid "Notes at risk !" msgstr "Beveiligingsprobleem!" #: resourcestr.rsdeleteandreplace_2 #, object-pascal-format msgctxt "resourcestr.rsdeleteandreplace_2" msgid "Delete all notes in %s and replace with snapshot dated %s ?" msgstr "" #: resourcestr.rsdeleteddamaged #, object-pascal-format msgid "OK, deleted %d damaged notes" msgstr "" #: resourcestr.rsdownloaded msgid "Downloaded" msgstr "" #: resourcestr.rsdownloadnotes msgid "Downloading notes" msgstr "" #: resourcestr.rsenternewnotebook #, fuzzy msgctxt "resourcestr.rsenternewnotebook" msgid "Enter a new notebook name please" msgstr "Voer een nieuwe naam in voor het notitieboek" #: resourcestr.rserrorcopyfile #, fuzzy msgctxt "resourcestr.rserrorcopyfile" msgid "Failed to copy file, does destination dir exist ?" msgstr "Kan bestand niet kopiëren. Bestaat de bestemmingsmap wel?" #: resourcestr.rsfilesyncinfo1 msgid "tomboy-ng uses File Sync to sync to eg DropBox, Google Drive, a USB drive" msgstr "" #: resourcestr.rsfilesyncinfo2 msgid "or uses a remote server over the internet with sshfs" msgstr "" #: resourcestr.rsfindnavlefthint msgid "Backward Find : Shift-F3 or Shift-Ctrl-G" msgstr "" #: resourcestr.rsfindnavlefthintmac msgid "Backward Find : Shift-Command-G" msgstr "" #: resourcestr.rsfindnavrighthint msgid "Find : F3 or Ctrl-G" msgstr "" #: resourcestr.rsfindnavrighthintmac msgid "Find : Command-G" msgstr "" #: resourcestr.rsfound msgctxt "resourcestr.rsfound" msgid "Found" msgstr "" #: resourcestr.rsgithubsyncinfo1 msgid "tomboy-ng can use Github to both sync and display or edit notes" msgstr "" #: resourcestr.rsgithubsyncinfo2 msgid "you should read the tomboy-ng wiki page for instructions." msgstr "" #: resourcestr.rsgithubtokenexpired msgid "Github Token may have expired" msgstr "" #: resourcestr.rshelpconfig #, fuzzy msgctxt "resourcestr.rshelpconfig" msgid "Create or use an alternative config" msgstr "Alternatieve configuratie creëren of gebruiken" #: resourcestr.rshelpdebug #, fuzzy msgctxt "resourcestr.rshelpdebug" msgid "Direct debug output to SOME.LOG." msgstr "Foutopsporingsuitvoer vastleggen in SOME.LOG." #: resourcestr.rshelpdebugindex msgctxt "resourcestr.rshelpdebugindex" msgid "Show debug msgs while indexing notes" msgstr "" #: resourcestr.rshelpdebugspell #, fuzzy msgctxt "resourcestr.rshelpdebugspell" msgid "Show debug messages while spell setup" msgstr "Foutopsporingsberichten tonen tijdens instellen van spellingcontrole" #: resourcestr.rshelpdebugsync #, fuzzy msgctxt "resourcestr.rshelpdebugsync" msgid "Show debug messages during Sync" msgstr "Foutopsporingsberichten tonen tijdens synchronisatie" #: resourcestr.rshelpdelay msgctxt "resourcestr.rshelpdelay" msgid "Delay startup 2 sec to allow OS to settle" msgstr "" #: resourcestr.rshelphelp #, fuzzy msgctxt "resourcestr.rshelphelp" msgid "Show this help message and exit." msgstr "Toon dit hulpbericht en sluit af." #: resourcestr.rshelplang msgctxt "resourcestr.rshelplang" msgid "Force Language, supported en, es, fr, nl" msgstr "" #: resourcestr.rshelpnosplash #, fuzzy #| msgid "Dont show small status/splash window" msgctxt "resourcestr.rshelpnosplash" msgid "Do not show small status/splash window" msgstr "Geen klein status-/opstartscherm tonen" #: resourcestr.rshelpsaveexit msgctxt "resourcestr.rshelpsaveexit" msgid "After import single note, save & exit" msgstr "" #: resourcestr.rshelpsinglenote #, fuzzy msgctxt "resourcestr.rshelpsinglenote" msgid "Open indicated note, switch is optional" msgstr "Aangegeven notitie openen; overschakelen optioneel" #: resourcestr.rshelpversion #, fuzzy msgctxt "resourcestr.rshelpversion" msgid "Print version and exit" msgstr "Print de versie en sluit af" #: resourcestr.rslastchange msgctxt "resourcestr.rslastchange" msgid "Last Change" msgstr "" #: resourcestr.rslastsync msgid "Last Sync" msgstr "" #: resourcestr.rslookingatnotes #, fuzzy msgctxt "resourcestr.rslookingatnotes" msgid "Looking at notes ...." msgstr "Bezig met inspecteren van notities..." #: resourcestr.rslookingserverid msgid "Looking for ServerID" msgstr "" #: resourcestr.rsmenuabout msgctxt "resourcestr.rsmenuabout" msgid "About" msgstr "" #: resourcestr.rsmenuhelp #, fuzzy msgctxt "resourcestr.rsmenuhelp" msgid "Help" msgstr "Hulp" #: resourcestr.rsmenunewnote msgctxt "resourcestr.rsmenunewnote" msgid "New Note" msgstr "" #: resourcestr.rsmenuquit msgctxt "resourcestr.rsmenuquit" msgid "Quit" msgstr "" #: resourcestr.rsmenusearch msgctxt "resourcestr.rsmenusearch" msgid "Search" msgstr "" #: resourcestr.rsmenusettings #, fuzzy msgctxt "resourcestr.rsmenusettings" msgid "Settings" msgstr "Instellingen" #: resourcestr.rsmenusync msgctxt "resourcestr.rsmenusync" msgid "Synchronise" msgstr "" #: resourcestr.rsmetadirwarning msgid "Please remember that to ensure a reliable sync, you must not change files in the Meta directory." msgstr "" #: resourcestr.rsmultiplenotebooks #, fuzzy msgctxt "resourcestr.rsmultiplenotebooks" msgid "Settings allow multiple Notebooks" msgstr "Er is ondersteuning voor meerdere notitieboeken" #: resourcestr.rsname msgctxt "resourcestr.rsname" msgid "Name" msgstr "" #: resourcestr.rsnewerversionexits #, fuzzy msgctxt "resourcestr.rsnewerversionexits" msgid "A newer version exists in main repo" msgstr "Er is een nieuwere versie aanwezig in de hoofdrepo" #: resourcestr.rsnotavailable msgid "Not Available" msgstr "" #: resourcestr.rsnotealreadyinrepo #, fuzzy msgctxt "resourcestr.rsnotealreadyinrepo" msgid "Note already in Repo" msgstr "Deze notitie bestaat al" #: resourcestr.rsnotebookoptionctrl msgid "Ctrl click for Notebook Options" msgstr "" #: resourcestr.rsnotebookoptionright msgid "Right click for Notebook Options" msgstr "" #: resourcestr.rsnotebooks msgctxt "resourcestr.rsnotebooks" msgid "Notebooks" msgstr "" #: resourcestr.rsnoteopen #, fuzzy msgctxt "resourcestr.rsnoteopen" msgid "You have that note open, please close and try again" msgstr "Deze notitie is geopend. Sluit hem en probeer het opnieuw." #: resourcestr.rsnotes msgctxt "resourcestr.rsnotes" msgid "notes" msgstr "" #: resourcestr.rsnotesdeleted msgid "Note or notes deleted" msgstr "" #: resourcestr.rsnotesinsnap #, fuzzy msgctxt "resourcestr.rsnotesinsnap" msgid "Notes in Snapshot" msgstr "Notities in momentopname" #: resourcestr.rsnotpresent #, fuzzy msgctxt "resourcestr.rsnotpresent" msgid "Not present in main repo" msgstr "Niet aanwezig" #: resourcestr.rsnumbnotesaffected #, object-pascal-format msgid "This will affect %d notes" msgstr "" #: resourcestr.rsonenotebook #, fuzzy msgctxt "resourcestr.rsonenotebook" msgid "Settings allow only one Notebook" msgstr "Er is ondersteuning voor één notitieboek" #: resourcestr.rsoverwritenote #, fuzzy msgctxt "resourcestr.rsoverwritenote" msgid "Overwrite newer version of that note" msgstr "Nieuwere versie overschrijven" #: resourcestr.rspressclose #, fuzzy msgctxt "resourcestr.rspressclose" msgid "Press Close" msgstr "Klik op 'Sluiten'" #: resourcestr.rsrecoverok #, fuzzy #| msgid "OK, File recovered. You may need to do a Refresh (or restart)" msgctxt "resourcestr.rsrecoverok" msgid "OK, File recovered." msgstr "Het bestand is hersteld. Je moet mogelijk verversen (of de app sluiten en weer openen)." #: resourcestr.rsrenamefailed #, fuzzy msgctxt "resourcestr.rsrenamefailed" msgid "ERROR, could not rename Backup File " msgstr "FOUT: kan naam van back-upbestand niet wijzigen" #: resourcestr.rsrollbackintro msgid "You can roll back to previous version of this note" msgstr "" #: resourcestr.rsrunningsync #, fuzzy msgctxt "resourcestr.rsrunningsync" msgid "Running Sync" msgstr "Bezig met synchroniseren..." #: resourcestr.rssaveandsync #, fuzzy msgctxt "resourcestr.rssaveandsync" msgid "Press Save and Sync if this looks OK" msgstr "Als dit in orde is, klik dan op 'Opslaan en synchroniseren'" #: resourcestr.rsscanremote msgid "Scanning remote files" msgstr "" #: resourcestr.rssearchhint msgctxt "resourcestr.rssearchhint" msgid "Exact matches for terms between \" \"" msgstr "" #: resourcestr.rssetthenotebooks #, fuzzy msgctxt "resourcestr.rssetthenotebooks" msgid "Set the notebooks this note is a member of" msgstr "Stel in in welke notitieboeken deze notitie moet worden geplaatst" #: resourcestr.rssetup msgctxt "resourcestr.rssetup" msgid "Setup" msgstr "" #: resourcestr.rssetupnotesdirfirst msgctxt "resourcestr.rssetupnotesdirfirst" msgid "Please setup a notes directory first" msgstr "" #: resourcestr.rssetupsyncfirst msgctxt "resourcestr.rssetupsyncfirst" msgid "Please config sync system first" msgstr "" #: resourcestr.rssnapshotcreated #, fuzzy msgctxt "resourcestr.rssnapshotcreated" msgid "created, do you want to copy it elsewhere ?" msgstr "Aangemaakt. Wil je ergens een kopie opslaan?" #: resourcestr.rssyncerror #, fuzzy #| msgid "A Sync Error occurred" msgctxt "resourcestr.rssyncerror" msgid "A Sync Error occurred" msgstr "Synchronisatiefout" #: resourcestr.rssyncnotconfig #, fuzzy msgctxt "resourcestr.rssyncnotconfig" msgid "not configured" msgstr "niet ingesteld" #: resourcestr.rstestingcredentials msgid "Testing Credentials" msgstr "" #: resourcestr.rstestingrepo #, fuzzy msgctxt "resourcestr.rstestingrepo" msgid "Testing Repo ...." msgstr "Bezig met testen van repo..." #: resourcestr.rstestingsync #, fuzzy msgctxt "resourcestr.rstestingsync" msgid "Testing Sync" msgstr "Bezig met testen van synchronisatie..." #: resourcestr.rstryrecover_1 msgid "Try to recover a bad note by double clicking below," msgstr "" #: resourcestr.rstryrecover_2 msgctxt "resourcestr.rstryrecover_2" msgid "if that fails, you may be able to recover it from a Snapshot." msgstr "" #: resourcestr.rsunabletoproceed #, fuzzy msgctxt "resourcestr.rsunabletoproceed" msgid "Unable to proceed because" msgstr "Kan niet doorgan vanwege" #: resourcestr.rsunabletosync #, fuzzy msgctxt "resourcestr.rsunabletosync" msgid "Unable to sync because " msgstr "Kan niet synchroniseren vanwege" #: resourcestr.rsuploaded msgid "Uploaded" msgstr "" #: resourcestr.rsuploading msgid "Uploading" msgstr "" #: resourcestr.rswarnnossystray msgid "WARNING, your Desktop might not display SysTray" msgstr "" #: resourcestr.rswehavesnapshots #, object-pascal-format msgid "We have %d snapshots" msgstr "" #: settings.rsdictionaryfailed msgid "Library Not Loaded" msgstr "Geen bibliotheek geladen" #: settings.rsdictionaryloaded msgid "Dictionary Loaded OK" msgstr "Woordenboek is geladen" #: settings.rsdictionarynotfound msgid "No Dictionary Found" msgstr "Geen woordenboek aangetroffen" #: settings.rsdirhasnonotes #, fuzzy #| msgid "That directory does not contain any notes. Thats OK, if I can make my own there." msgid "That directory does not contain any notes. That is OK, if I can make my own there." msgstr "Deze map bevat geen notities. Dat is niet erg, want nu kan deze worden gebruikt voor nieuwe notities." #: settings.rserrorcannotwrite msgid "Cannot write into" msgstr "Kan niet wegschrijven naar" #: settings.rserrorcreatedir msgid "Unable to Create Directory" msgstr "Kan map niet aanmaken" #: settings.rsselectdictionary msgid "Select the dictionary you want to use" msgstr "Kies de te gebruiken map" #: settings.rsselectlibrary msgid "Select your hunspell library" msgstr "Kies een hunspell-bibliotheek" #: spelling.rscheckingfull msgid "Checking full document" msgstr "Bezig met controleren van document..." #: spelling.rscheckingselection msgid "Checking selection" msgstr "Bezig met controleren van selectie..." #: spelling.rsreplace_with_1 msgid "replace" msgstr "vervangen" #: spelling.rsreplace_with_2 msgid "with" msgstr "door" #: spelling.rsspellcomplete msgid "Spell check complete" msgstr "Spellingcontrole voltooid" #: spelling.rsspellnotconfig msgid "Spelling not configured" msgstr "Spellingcontrole is niet ingesteld" #: syncutils.rschangeexistingsync msgid "Change existing sync connection ?" msgstr "Wil je de bestaande synchronisatieverbinding aanpassen?" #: syncutils.rsclashes msgid "Clashes " msgstr "Conflicten " #: syncutils.rsdonothing msgid "Do Nothing " msgstr "Niets doen " #: syncutils.rsdownloads msgid "Downloads " msgstr "Downloads " #: syncutils.rsedituploads msgid "Edit Uploads " msgstr "Uploads aanpassen " #: syncutils.rslocaldeletes msgid "Local Deletes " msgstr "Lokale prullenbak " #: syncutils.rsnewuploads msgid "New Uploads " msgstr "Nieuwe uploads " #: syncutils.rsnextbitslow msgid "Next bit can be a bit slow, please wait" msgstr "Het volgende onderdeel kan even duren..." #: syncutils.rsnonotesneededsync msgid "No notes needed syncing. You need to write more." msgstr "Geen synchronisatie benodigd. Maak meer notities :-)" #: syncutils.rsnotesweredealt msgid " notes were dealt with." msgstr " notities behandeld." #: syncutils.rsnotrecommend msgid "Generally not recommended." msgstr "Meestal niet aanbevolen." #: syncutils.rsremotedeletes msgid "Remote Deletes " msgstr "Externe prullenbak" #: syncutils.rssyncerrors #, fuzzy #| msgid "ERRORS (see consol log) " msgid "ERRORS (see console log) " msgstr "FOUTEN (zie terminaluitvoer)." #: teditboxform.buttmaintbmenu.caption msgctxt "teditboxform.buttmaintbmenu.caption" msgid "Menu" msgstr "" #: teditboxform.editfind.text msgid "EditFind" msgstr "" #: teditboxform.label2.caption msgid "Read Only" msgstr "" #: teditboxform.label3.caption msgid "This note has been changed by the Sync Process" msgstr "" #: teditboxform.label4.caption msgid "Please close it (and re-open if it was a download)" msgstr "" #: teditboxform.labelfindinfo.caption msgid "LabelFindInfo" msgstr "" #: teditboxform.menubold.caption msgctxt "teditboxform.menubold.caption" msgid "Bold" msgstr "" #: teditboxform.menufindnext.caption msgid "Find Next" msgstr "" #: teditboxform.menufindprev.caption msgctxt "teditboxform.menufindprev.caption" msgid "Find Prev" msgstr "" #: teditboxform.menufixedwidth.caption msgid "Fixed Width" msgstr "" #: teditboxform.menuhighlight.caption msgctxt "teditboxform.menuhighlight.caption" msgid "Highlight" msgstr "" #: teditboxform.menuhuge.caption msgctxt "teditboxform.menuhuge.caption" msgid "Huge" msgstr "" #: teditboxform.menuitalic.caption msgid "Italic" msgstr "" #: teditboxform.menuitembulletleft.caption msgid "Bullet <<" msgstr "" #: teditboxform.menuitembulletright.caption msgid "Bullet >>" msgstr "" #: teditboxform.menuitemcopy.caption msgid "Copy" msgstr "" #: teditboxform.menuitemcut.caption msgid "Cut" msgstr "" #: teditboxform.menuitemdelete.caption msgctxt "teditboxform.menuitemdelete.caption" msgid "Delete" msgstr "" #: teditboxform.menuitemevaluate.caption msgid "Evaluate" msgstr "" #: teditboxform.menuitemexport.caption msgid "Export" msgstr "" #: teditboxform.menuitemexportmarkdown.caption msgid "Export Markdown" msgstr "" #: teditboxform.menuitemexportplaintext.caption msgid "Export Plain Text" msgstr "" #: teditboxform.menuitemexportrtf.caption msgid "Export RTF" msgstr "" #: teditboxform.menuitemfind.caption msgid "Find in this Note" msgstr "" #: teditboxform.menuitemindex.caption msgid "Index" msgstr "" #: teditboxform.menuitempaste.caption msgid "Paste" msgstr "" #: teditboxform.menuitemprint.caption msgid "Print" msgstr "" #: teditboxform.menuitemselectall.caption msgid "Select All" msgstr "" #: teditboxform.menuitemsettings.caption msgctxt "teditboxform.menuitemsettings.caption" msgid "Settings" msgstr "" #: teditboxform.menuitemspell.caption msgid "Spell Check" msgstr "" #: teditboxform.menuitemsync.caption msgid "Synchronize" msgstr "" #: teditboxform.menularge.caption msgid "Large Font" msgstr "" #: teditboxform.menunormal.caption msgid "Normal Font" msgstr "" #: teditboxform.menusmall.caption msgid "Small Font" msgstr "" #: teditboxform.menustayontop.caption msgid "Stay On Top" msgstr "" #: teditboxform.menustrikeout.caption msgid "Strikeout" msgstr "" #: teditboxform.menuunderline.caption msgid "Underline" msgstr "" #: teditboxform.speedbuttondelete.hint msgid "Delete this note" msgstr "" #: teditboxform.speedbuttonlink.hint msgid "Link highlighted text to a new note" msgstr "" #: teditboxform.speedbuttonnotebook.hint msgid "Manage Notebooks" msgstr "" #: teditboxform.speedbuttonsearch.hint msgid "Search All Notes Ctrl-Shift-F" msgstr "" #: teditboxform.speedbuttontext.hint msgid "Font size, bold, italics etc" msgstr "" #: teditboxform.speedbuttontools.hint msgid "Tools - Sync, Export, Spell" msgstr "" #: teditboxform.speedrollback.hint msgid "Roll Back" msgstr "" #: tformbackupview.buttondelete.caption msgctxt "tformbackupview.buttondelete.caption" msgid "Delete" msgstr "" #: tformbackupview.buttondelete.hint msgid "Really, totally delete this note." msgstr "" #: tformbackupview.buttonok.caption msgctxt "tformbackupview.buttonok.caption" msgid "Close" msgstr "" #: tformbackupview.buttonok.hint msgid "My work here is done." msgstr "" #: tformbackupview.buttonopen.caption msgid "View" msgstr "" #: tformbackupview.buttonopen.hint msgid "Open and view the whole note" msgstr "" #: tformbackupview.buttonrecover.caption msgctxt "tformbackupview.buttonrecover.caption" msgid "Recover" msgstr "" #: tformbackupview.buttonrecover.hint msgid "Restore this note to main repo" msgstr "" #: tformbackupview.caption msgid "View, recover or delete Backup Files" msgstr "" #: tformbackupview.listbox1.hint msgid "Use Ctrl or Shift to select multiple entries" msgstr "" #: tformcolours.label1.caption msgid "Sample" msgstr "" #: tformcolours.label2.caption msgctxt "tformcolours.label2.caption" msgid "Set Colours" msgstr "" #: tformcolours.speedbackground.caption msgid "Background" msgstr "" #: tformcolours.speedcancel.caption msgctxt "tformcolours.speedcancel.caption" msgid "Cancel" msgstr "" #: tformcolours.speeddefault.caption msgid "Default" msgstr "" #: tformcolours.speedhighlight.caption msgctxt "tformcolours.speedhighlight.caption" msgid "Highlight" msgstr "" #: tformcolours.speedok.caption msgctxt "tformcolours.speedok.caption" msgid "OK" msgstr "" #: tformcolours.speedtext.caption msgid "Text" msgstr "" #: tformcolours.speedtitle.caption msgctxt "tformcolours.speedtitle.caption" msgid "Title" msgstr "" #: tformindex.caption msgid "Heading in this Note" msgstr "" #: tformindex.panel1.caption msgid "Single lines, all Huge, Large Bold or Large" msgstr "" #: tformrecover.buttondeletebadnotes.caption msgid "Delete Bad Notes" msgstr "" #: tformrecover.buttonmakesafetysnap.caption msgid "Take a manual Snapshot" msgstr "" #: tformrecover.buttonmakesafetysnap.hint msgid "Take a initial snapshot of your notes and config. Overwritten each time." msgstr "" #: tformrecover.buttonrecoversnap.caption msgctxt "tformrecover.buttonrecoversnap.caption" msgid "Recover" msgstr "" #: tformrecover.buttonsnaphelp.caption msgid "Snapshot Help" msgstr "" #: tformrecover.label10.caption msgid "Please close any notes you may have open." msgstr "" #: tformrecover.label12.caption msgid "Don't even consider this unless you have a backup Snapshot, Intro Tab." msgstr "" #: tformrecover.label14.caption msgid "Click an available snapshot to see its contents." msgstr "" #: tformrecover.label15.caption msgid "Click an available snapshot, click Recover" msgstr "" #: tformrecover.label16.caption msgid "You may chose to view, copy and paste into a new note." msgstr "" #: tformrecover.label2.caption msgid "Please be careful, this is a dangerous place!" msgstr "" #: tformrecover.label3.caption msgid "Restore any notes in the snapshot that are not in the existing notes directory." msgstr "" #: tformrecover.label4.caption msgid "Remove all existing notes and use the ones in the Snapshot." msgstr "" #: tformrecover.label5.caption msgid "Looking for notes with damaged XML" msgstr "" #: tformrecover.label6.caption msgid "This tool might help you recover lost or damaged notes." msgstr "" #: tformrecover.label7.caption msgid "Before you start, take a Snapshot of your notes directory." msgstr "" #: tformrecover.label9.caption msgid "From here you can view snapshot notes, one by one." msgstr "" #: tformrecover.listboxsnapshots.hint msgid "These are the currently known snapshots. " msgstr "" #: tformrecover.panelsnapshots.caption msgid "Available Snapshots" msgstr "" #: tformrecover.tabsheetbadnotes.caption msgid "Bad Notes" msgstr "" #: tformrecover.tabsheetintro.caption msgid "Introduction" msgstr "" #: tformrecover.tabsheetmergesnapshot.caption msgid "Merge Snapshot" msgstr "" #: tformrecover.tabsheetrecovernotes.caption msgid "Recover Notes" msgstr "" #: tformrecover.tabsheetrecoversnapshot.caption msgid "Recover Snapshot" msgstr "" #: tformrollback.speedcancel.caption msgctxt "tformrollback.speedcancel.caption" msgid "Cancel" msgstr "" #: tformrollback.speedrolltoopen.caption msgid "Opening Backup" msgstr "" #: tformrollback.speedrolltotitle.caption msgid "Title Change Backup" msgstr "" #: tformsdiff.bitbtnuselocal.caption msgid "Use Local" msgstr "" #: tformsdiff.bitbtnuseremote.caption msgid "Use Remote" msgstr "" #: tformsdiff.buttalllocal.caption msgid "Local" msgstr "" #: tformsdiff.buttallnewest.caption msgid "Newest" msgstr "" #: tformsdiff.buttalloldest.caption msgid "Oldest" msgstr "" #: tformsdiff.buttallremote.caption msgid "Remote" msgstr "" #: tformsdiff.caption msgid "A Note Sync Clash has been Detected" msgstr "" #: tformsdiff.label1.caption msgid "Or make a choice for remainder of this run" msgstr "" #: tformsdiff.label3.caption msgid "Remote Changed" msgstr "" #: tformsdiff.label4.caption msgid "Local Changed" msgstr "" #: tformsdiff.radiolong.caption msgid "Long Lines" msgstr "" #: tformsdiff.radiolong.hint msgid "Maybe necessary to show difference" msgstr "" #: tformsdiff.radioshort.caption msgid "Short Lines" msgstr "" #: tformsdiff.radioshort.hint msgid "Easier to read" msgstr "" #: tformspell.buttonignore.caption msgid "Ignore" msgstr "" #: tformspell.buttonignore.hint msgid "Ignore all instances for the run" msgstr "" #: tformspell.buttonskip.caption msgid "Skip" msgstr "" #: tformspell.buttonskip.hint msgid "Skip just this instance" msgstr "" #: tformspell.buttonuseandnextword.caption msgid "Use and Next Word" msgstr "" #: tformspell.caption msgctxt "tformspell.caption" msgid "Spell" msgstr "" #: tformspell.label4.caption msgid "Suspect word -" msgstr "" #: tformspell.labelprompt.caption msgid "Click a word to use it." msgstr "" #: tformsync.buttoncancel.caption msgctxt "tformsync.buttoncancel.caption" msgid "Cancel" msgstr "" #: tformsync.buttonclose.caption msgctxt "tformsync.buttonclose.caption" msgid "Close" msgstr "" #: tformsync.buttonsave.caption msgid "Save and Sync" msgstr "" #: tformsync.caption msgctxt "tformsync.caption" msgid "Sync" msgstr "" #: tformsync.labelprogress.caption msgid "LabelProgress" msgstr "" #: tformsync.listviewreport.columns[0].caption msgid "Action" msgstr "" #: tformsync.listviewreport.columns[1].caption msgctxt "tformsync.listviewreport.columns[1].caption" msgid "Title" msgstr "" #: tformsync.listviewreport.columns[2].caption msgid "Note ID" msgstr "" #: tformtomdroid.buttonclose.caption msgctxt "tformtomdroid.buttonclose.caption" msgid "Close" msgstr "" #: tformtomdroid.buttondelete.caption msgid "Delete Profile" msgstr "" #: tformtomdroid.buttonhelp.caption msgctxt "tformtomdroid.buttonhelp.caption" msgid "Help" msgstr "" #: tformtomdroid.buttonjoin.caption msgctxt "tformtomdroid.buttonjoin.caption" msgid "Join" msgstr "" #: tformtomdroid.buttonsaveprofile.caption msgid "Save Profile" msgstr "" #: tformtomdroid.buttonsync.caption msgctxt "tformtomdroid.buttonsync.caption" msgid "Sync" msgstr "" #: tformtomdroid.caption msgctxt "tformtomdroid.caption" msgid "Tomdroid" msgstr "" #: tformtomdroid.checkboxdebugmode.caption msgid "Debug Mode" msgstr "" #: tformtomdroid.checkboxdebugmode.hint msgid "writes debug messages to terminal" msgstr "" #: tformtomdroid.checkboxtestrun.caption msgctxt "tformtomdroid.checkboxtestrun.caption" msgid "Test Run" msgstr "" #: tformtomdroid.checksavepassword.caption msgctxt "tformtomdroid.checksavepassword.caption" msgid "Save" msgstr "" #: tformtomdroid.editprofilename.hint msgid "eg MySamsungNote7" msgstr "" #: tformtomdroid.label1.caption msgid "Tomdroid SSH Sync - deprecated, will be dropped soon." msgstr "" #: tformtomdroid.label2.caption msgid "Select an existing profile (or enter data) " msgstr "" #: tformtomdroid.label3.caption msgid "Profile Name" msgstr "" #: tformtomdroid.label4.caption msgid "IP address of device" msgstr "" #: tformtomdroid.label5.caption msgid "SSH Password for device" msgstr "" #: tformtomdroid.label6.caption msgctxt "tformtomdroid.label6.caption" msgid "Upload means from tomboy-ng to Android Device" msgstr "" #: tformtomdroidfile.buttonclose.caption msgctxt "tformtomdroidfile.buttonclose.caption" msgid "Close" msgstr "" #: tformtomdroidfile.buttonhelp.caption msgctxt "tformtomdroidfile.buttonhelp.caption" msgid "Help" msgstr "" #: tformtomdroidfile.buttonjoin.caption msgctxt "tformtomdroidfile.buttonjoin.caption" msgid "Join" msgstr "" #: tformtomdroidfile.buttonoldssh.caption msgid "Use old SSH model" msgstr "" #: tformtomdroidfile.buttonsync.caption msgctxt "tformtomdroidfile.buttonsync.caption" msgid "Sync" msgstr "" #: tformtomdroidfile.caption msgctxt "tformtomdroidfile.caption" msgid "Tomdroid" msgstr "" #: tformtomdroidfile.checkboxtestrun.caption msgctxt "tformtomdroidfile.checkboxtestrun.caption" msgid "Test Run" msgstr "" #: tformtomdroidfile.label1.caption msgid "Tomdroid Sync - be aware of limitations !" msgstr "" #: tformtomdroidfile.label6.caption msgctxt "tformtomdroidfile.label6.caption" msgid "Upload means from tomboy-ng to Android Device" msgstr "" #: tmainform.bitbtnhide.caption msgid "Hide" msgstr "" #: tmainform.bitbtnquit.caption msgctxt "tmainform.bitbtnquit.caption" msgid "Quit" msgstr "" #: tmainform.buttmenu.caption msgctxt "tmainform.buttmenu.caption" msgid "Menu" msgstr "" #: tmainform.buttsystrayhelp.caption msgid "SysTray Help" msgstr "" #: tmainform.caption msgid "tomboy-ng" msgstr "" #: tmainform.checkboxdontshow.caption msgid "Don't Show for normal startup" msgstr "" #: tmainform.checkboxdontshow.hint msgid "You can reverse this from Settings" msgstr "" #: tmainform.hint msgid "If the yellow tomboy-ng icon is visible in your System Tray, you can dismiss this window." msgstr "" #: tmainform.label3.caption msgid "Dictionary Config (optional)" msgstr "" #: tmainform.label4.caption msgid "Sync Config (optional)" msgstr "" #: tmainform.label5.caption msgid "Welcome to tomboy-ng !" msgstr "" #: tmainform.labelerror.hint msgid "Launch from commandline to see errors or see Config->SnapShot->Recover ..." msgstr "" #: tnotebookpick.button1.caption msgctxt "tnotebookpick.button1.caption" msgid "Cancel" msgstr "" #: tnotebookpick.buttonok.caption msgctxt "tnotebookpick.buttonok.caption" msgid "OK" msgstr "" #: tnotebookpick.label4.caption msgid "Name of the New Notebook" msgstr "" #: tnotebookpick.label5.caption msgid "Press OK and we will make the Note Book AND add this note to it." msgstr "" #: tnotebookpick.label6.caption msgid "Existing Name" msgstr "" #: tnotebookpick.label8.caption msgid "New Name" msgstr "" #: tnotebookpick.label9.caption msgid "If you sync and are not absolutely sure its up to date, Cancel now !" msgstr "" #: tnotebookpick.tabchangename.caption msgid "Change Notebook Name" msgstr "" #: tnotebookpick.tabexisting.caption msgid "Existing Note Books" msgstr "" #: tnotebookpick.tabnewnotebook.caption msgid "New Note Book" msgstr "" #: tnotebookpick.tabsetnotes.caption msgid "Set Notes" msgstr "" #: tomdroid.rscheckingforexistingsync msgctxt "tomdroid.rscheckingforexistingsync" msgid "Checking for an existing sync ...." msgstr "" #: tomdroid.rsconnectiongood msgctxt "tomdroid.rsconnectiongood" msgid "Connection is looking Good." msgstr "" #: tomdroid.rsfailedtoconnect msgctxt "tomdroid.rsfailedtoconnect" msgid "Failed to connect." msgstr "" #: tomdroid.rsfailedtofindconnection_1 msgctxt "tomdroid.rsfailedtofindconnection_1" msgid "Failed to find an existing connection." msgstr "" #: tomdroid.rsfailedtofindconnection_2 msgctxt "tomdroid.rsfailedtofindconnection_2" msgid "If you are sure there should be an existing connection, check settings." msgstr "" #: tomdroid.rsfailedtofindconnection_3 msgctxt "tomdroid.rsfailedtofindconnection_3" msgid "Otherwise, try joining a new connection." msgstr "" #: tomdroid.rsfixconnection msgctxt "tomdroid.rsfixconnection" msgid "If you are sure its there, check settings." msgstr "" #: tomdroid.rshavevalidsync msgctxt "tomdroid.rshavevalidsync" msgid "Looking Good. Last sync date " msgstr "" #: tomdroid.rsinstalltomdroid msgctxt "tomdroid.rsinstalltomdroid" msgid "Install Tomdroid, config filesync, and run a sync" msgstr "" #: tomdroid.rsnoconnection msgctxt "tomdroid.rsnoconnection" msgid "Failed to establish a connection. " msgstr "" #: tomdroid.rsnotcorrectprofile msgctxt "tomdroid.rsnotcorrectprofile" msgid "This is not correct profile for that device" msgstr "" #: tomdroid.rsnotexistingrepo msgctxt "tomdroid.rsnotexistingrepo" msgid "That's not an existing Repo, maybe click \"Join\" ?" msgstr "" #: tomdroid.rsnotomdroid msgctxt "tomdroid.rsnotomdroid" msgid "Unable to find Tomdroid sync dir on that device." msgstr "" #: tomdroid.rsselectprofile msgid "Select a profile" msgstr "" #: tomdroid.rssetupnewsync msgctxt "tomdroid.rssetupnewsync" msgid "Setting up a new sync ...." msgstr "" #: tomdroid.rstalkingtodevice msgctxt "tomdroid.rstalkingtodevice" msgid "OK, talking to device. Wait for it ...." msgstr "" #: tomdroidfile.rsconnectiongood #, fuzzy msgctxt "tomdroidfile.rsconnectiongood" msgid "Connection is looking Good." msgstr "De verbinding is goed." #: tomdroidfile.rsfailedtoconnect #, fuzzy msgctxt "tomdroidfile.rsfailedtoconnect" msgid "Failed to connect." msgstr "Kan niet vebinden." #: tomdroidfile.rsfailedtofindconnection_2 #, fuzzy msgctxt "tomdroidfile.rsfailedtofindconnection_2" msgid "If you are sure there should be an existing connection, check settings." msgstr "Als je er zeker van bent dat er een verbinding moet zijn, controleer dan de instellingen." #: tomdroidfile.rsfixconnection #, fuzzy msgctxt "tomdroidfile.rsfixconnection" msgid "If you are sure its there, check settings." msgstr "Als je er zeker van bent dat deze er is, controleer dan de instellingen." #: tomdroidfile.rshavevalidsync #, fuzzy msgctxt "tomdroidfile.rshavevalidsync" msgid "Looking Good. Last sync date " msgstr "In orde. Laatste synchronisatiedatum " #: tomdroidfile.rsinstalltomdroid #, fuzzy msgctxt "tomdroidfile.rsinstalltomdroid" msgid "Install Tomdroid, config filesync, and run a sync" msgstr "Installeer Tomdroid, stel bestandssynchronisatie in en voer deze uit" #: tomdroidfile.rsjoinanyway msgid "Forcing a Join may \"recover\" some notes you thought you have deleted." msgstr "" #: tomdroidfile.rsnoconnection #, fuzzy msgctxt "tomdroidfile.rsnoconnection" msgid "Failed to establish a connection. " msgstr "Kan geen verbinding maken." #: tomdroidfile.rsnotcorrectprofile #, fuzzy msgctxt "tomdroidfile.rsnotcorrectprofile" msgid "This is not correct profile for that device" msgstr "Dit profiel hoort niet bij dat apparaat" #: tomdroidfile.rsnotexistingrepo #, fuzzy msgctxt "tomdroidfile.rsnotexistingrepo" msgid "That's not an existing Repo, maybe click \"Join\" ?" msgstr "Die repo bestaat niet; klik op 'Deelnemen'." #: tomdroidfile.rsnotomdroid #, fuzzy msgctxt "tomdroidfile.rsnotomdroid" msgid "Unable to find Tomdroid sync dir on that device." msgstr "De Tomdroid-synchronisatiemap is niet aanwezig op dat apparaat." #: tomdroidfile.rssetupnewsync #, fuzzy msgctxt "tomdroidfile.rssetupnewsync" msgid "Setting up a new sync ...." msgstr "Bezig met instellen van synchronisatie..." #: tomdroidfile.rstalking #, fuzzy msgctxt "tomdroidfile.rstalking" msgid "OK, talking to device. Wait for it ...." msgstr "Bezig met verbinding maken met apparaat..." #: tsearchform.buttonclearfilters.caption msgid "Clear Filters" msgstr "" #: tsearchform.buttonmenu.caption msgctxt "tsearchform.buttonmenu.caption" msgid "Menu" msgstr "" #: tsearchform.buttonrefresh.caption msgid "Refresh" msgstr "" #: tsearchform.buttonrefresh.hint msgid "Update Search Results" msgstr "" #: tsearchform.caption msgid "tomboy-ng_Search" msgstr "" #: tsearchform.checkautorefresh.caption msgid "Auto Refresh" msgstr "" #: tsearchform.checkcasesensitive.caption msgid "Case Sensitive" msgstr "" #: tsearchform.listboxnotebooks.hint msgid "Right Click to manage Notebooks" msgstr "" #: tsearchform.menucreatenotebook.caption msgid "Create new Note Book" msgstr "" #: tsearchform.menudeletenotebook.caption msgid "Delete Notebook" msgstr "" #: tsearchform.menueditnotebooktemplate.caption msgid "Edit Notebook Template" msgstr "" #: tsearchform.menuitemmanagenbook.caption msgid "Manage Notes in Note Book" msgstr "" #: tsearchform.menunewnotefromtemplate.caption msgid "Create New Note from Template" msgstr "" #: tsearchform.menurenamenotebook.caption msgid "Rename NoteBook" msgstr "" #: tsearchform.panel2.caption msgctxt "tsearchform.panel2.caption" msgid "Notebooks" msgstr "" #: tsett.buttdefaultnotedir.caption msgid "Use Default Notes Location" msgstr "" #: tsett.buttdefaultnotedir.hint msgid "Will work for many new users" msgstr "" #: tsett.buttonfixedfont.caption msgid "Fixed Font" msgstr "" #: tsett.buttonfont.caption msgid "Usual Font" msgstr "" #: tsett.buttonmanualsnap.caption msgid "Take a Manual Snapshot" msgstr "" #: tsett.buttonmanualsnap.hint msgid "Take a time stamped snapshot of notes and config" msgstr "" #: tsett.buttonsetcolours.caption msgctxt "tsett.buttonsetcolours.caption" msgid "Set Colours" msgstr "" #: tsett.buttonsetdictionary.caption msgid "Set Dictionary" msgstr "" #: tsett.buttonsetnotepath.caption msgid "Set Path to Note Files" msgstr "" #: tsett.buttonsetnotepath.hint msgid "If you have notes somewhere else" msgstr "" #: tsett.buttonsetspelllibrary.caption msgid "Set Spell Library" msgstr "" #: tsett.buttonshowbackup.caption msgid "Show Me" msgstr "" #: tsett.buttonsnaprecover.caption msgid "Recover Lost Notes" msgstr "" #: tsett.buttonsnaprecover.hint msgid "If you have previously taken a snapshot ..." msgstr "" #: tsett.checkautosnapenabled.caption msgid "Use auto snapshots" msgstr "" #: tsett.checkautostart.caption msgid "Autostart at Logon" msgstr "" #: tsett.checkboxautosync.caption msgid "Auto Sync" msgstr "" #: tsett.checkboxautosync.hint msgid "Sync, if possible once an hour." msgstr "" #: tsett.checkmanynotebooks.caption msgid "Allow a Note to be in Multiple Notebooks." msgstr "" #: tsett.checkmanynotebooks.hint msgid "This may adversly affect traditional Tomboy, take care." msgstr "" #: tsett.checknotifications.caption msgid "Show Notifications" msgstr "" #: tsett.checkshowextlinks.caption msgid "Show External Links" msgstr "" #: tsett.checkshowintlinks.caption msgid "Show Internal Links" msgstr "" #: tsett.checkshowsearchatstart.caption msgid "Show Search at Start" msgstr "" #: tsett.checkshowsplash.caption msgid "Show Splash at Start" msgstr "" #: tsett.checkshowsplash.hint msgid "Always shown if error loading notes." msgstr "" #: tsett.checkshowtomdroid.caption msgid "Show Tomdroid Sync (experimental)" msgstr "" #: tsett.checkstampbold.caption msgctxt "tsett.checkstampbold.caption" msgid "Bold" msgstr "" #: tsett.checkstampitalics.caption msgid "Italics" msgstr "" #: tsett.checkstampsmall.caption msgctxt "tsett.checkstampsmall.caption" msgid "Small" msgstr "" #: tsett.checksyncenabled.caption msgid "Sync Enabled" msgstr "" #: tsett.checkuseundo.caption msgid "Use Undo Redo (may slow editing)" msgstr "" #: tsett.checkuseundo.hint msgid "Close and reopen a note to take effect. Use Ctrl-Z Ctrl-Y" msgstr "" #: tsett.combosynctype.text msgid "ComboSyncType" msgstr "" #: tsett.editusername.text msgid "EditUserName" msgstr "" #: tsett.groupbox4.caption msgid " Options " msgstr "" #: tsett.groupbox5.caption msgid "Font Size" msgstr "" #: tsett.groupboxsync.caption msgid " Sync " msgstr "" #: tsett.label1.caption msgid "Settings will be saved in :" msgstr "" #: tsett.label10.caption msgid "Help Notes Language" msgstr "" #: tsett.label11.caption msgid "Backup Files" msgstr "" #: tsett.label13.caption msgid "Spell Check requires the Hunspell Libraries and" msgstr "" #: tsett.label14.caption msgid "an appropriate Hunspell Dictionary set." msgstr "" #: tsett.label16.caption msgid "Maximum number of snapshots" msgstr "" #: tsett.label17.caption msgid "Date Stamp Format" msgstr "" #: tsett.label2.caption msgid "Notes will be looked for and saved in :" msgstr "" #: tsett.label3.caption msgid "When a conflict is detected between a local note and remote one :" msgstr "" #: tsett.label4.caption msgid "Repo : " msgstr "" #: tsett.label5.caption msgid "Days per snapshot" msgstr "" #: tsett.label6.caption msgid "Backup files are made when you delete a note or the sync system" msgstr "" #: tsett.label7.caption msgid "is about to overwrite one. " msgstr "" #: tsett.label8.caption msgid "They remain, forever, unless you do something about them." msgstr "" #: tsett.label9.caption msgid "A snaphot is a copy of your current note directory." msgstr "" #: tsett.labellabeltoken.caption msgctxt "tsett.labellabeltoken.caption" msgid "Token" msgstr "" #: tsett.labelsnapdir.caption msgid "Snap dir" msgstr "" #: tsett.labelsyncinfo1.caption msgid "LabelSyncInfo1" msgstr "" #: tsett.labelsyncinfo2.caption msgid "LabelSyncInfo2" msgstr "" #: tsett.labelsyncrepo.caption msgctxt "tsett.labelsyncrepo.caption" msgid "not configured" msgstr "" #: tsett.labelsynctype.caption msgid "Sync Type" msgstr "" #: tsett.labeltoken.caption msgid "LabelToke" msgstr "" #: tsett.labelusername.caption msgid "User" msgstr "" #: tsett.radioalwaysask.caption msgid "Always Ask me what to do." msgstr "" #: tsett.radiofontbig.caption msgid "Big" msgstr "" #: tsett.radiofonthuge.caption msgctxt "tsett.radiofonthuge.caption" msgid "Huge" msgstr "" #: tsett.radiofontmedium.caption msgid "Medium" msgstr "" #: tsett.radiofontsmall.caption msgctxt "tsett.radiofontsmall.caption" msgid "Small" msgstr "" #: tsett.radiouselocal.caption msgid "Use Local Note and Overwrite Server Note." msgstr "" #: tsett.radiouseserver.caption msgid "Use Server Note and Rename Local Note." msgstr "" #: tsett.speedbuthelp.caption msgctxt "tsett.speedbuthelp.caption" msgid "Help" msgstr "" #: tsett.speedbuthide.caption msgctxt "tsett.speedbuthide.caption" msgid "Close" msgstr "" #: tsett.speedbutttbmenu.caption msgctxt "tsett.speedbutttbmenu.caption" msgid "Menu" msgstr "" #: tsett.speedsetupsync.caption msgctxt "tsett.speedsetupsync.caption" msgid "Setup" msgstr "" #: tsett.speedtokencopy.hint msgid "Copy Token" msgstr "" #: tsett.speedtokenpaste.hint msgid "Paste Token" msgstr "" #: tsett.tabbackup.caption msgid "BackUp" msgstr "" #: tsett.tabbasic.caption msgid "Basic" msgstr "" #: tsett.tabdisplay.caption msgid "Notes" msgstr "" #: tsett.tabrecover.caption msgctxt "tsett.tabrecover.caption" msgid "Recover" msgstr "" #: tsett.tabspell.caption msgctxt "tsett.tabspell.caption" msgid "Spell" msgstr "" #: tsett.tabsync.caption msgctxt "tsett.tabsync.caption" msgid "Sync" msgstr "" tomboy-ng_0.34-1/COPYING0000644000175000017500000000134614145033507014454 0ustar dbannondbannonUnless noted, all tomboy-ng code in this repository is - Copyright David Bannon 2018 - 2020 Please see the file debian/copyright for license details. Note that the following addition license terms apply to the hunspell DLL supplied with Windows (but is not shipped with the other platform's specific distributions) : Licence file for associated libhunspell.dll This 64bit libhunspell.dll was compiled from the original source from https://github.com/hunspell/hunspell with Microsoft Visual Studio Community 2015. As such its covered by the hunspell licence and is free to use or distribute with your programme but this license file should remain with it. Many thanks to rvk from the Lazarus Forum for assistance with this. tomboy-ng_0.34-1/whatsnew0000644000175000017500000000013714145033507015201 0ustar dbannondbannonMultilevel bullets Github Sync Better Notebook tools configurable date stamp (Closes: #997942) tomboy-ng_0.34-1/.gitignore0000644000175000017500000000106214145033507015404 0ustar dbannondbannon# Lazarus compiler-generated binaries (safe to delete) *.exe *.dll *.so *.dylib *.lrs *.res *.compiled *.dbg *.ppu *.o *.or *.a # Lazarus autogenerated files (duplicated info) *.rst *.rsj *.lrt # Lazarus local files (user-specific info) *.lps # Lazarus backups and unit output folders. # These can be changed by user in Lazarus/project options. backup/ *.bak lib/ # Added by DRB published/ # *.lrj apparently needed by the translation system /source/tomboy-ng /source/tomboy-ng-qt tomboy-ng-qt.po releasepage NoGit/ # Application bundle for Mac OS *.app/ tomboy-ng_0.34-1/Deb_SRC.readme0000644000175000017500000001143514145033507016001 0ustar dbannondbannonSteps to build Debian Source Package for tomboy-ng. --------------------------------------------------- You need two files to start. The tomboy-ng-master.zip file and the script, prepare.bash. WHAT does prepare.bash do ? --------------------------- Firstly, prepare is NOT required when rebuilding either binary or src packages. Prepare takes a zip file (github sends us a zip file), unzips it, removes some unnecessary files, downloads KControls source, again removes some unnecessary files, makes some changes according to desired widget set and then creates the corresponding .orig.tar.gz file. Dependancies ---------------- You should already have FPC and Lazarus installed. And the tomboy-ng build dependencies, gtk2-dev, libnotify-dev etc. If you just want to make a binary thats all you need. If you are making a deb or a deb src package, you will need the devscripts package installed and some config, such as - * In ~/.devscripts.conf a line defining the GPG key you will sign with. eg DEBSIGN_KEYID=your-key-fingerprint Note : while it says 'keyid' its happier with the full fingerprint. * Edit the prepare script so that DEBEMAIL and DEBFULLNAME match the key. $DEBFULLNAME <$DEBEMAIL> must look exactly like the key's version. The process ----------------- Download the tomboy-ng zip file from github - wget https://github.com/tomboy-notes/tomboy-ng/archive/master.zip mv master.zip tomboy-ng-master.zip Note : clicking the Github tomboy-ng page's Code -> Download Zip from github will get you the file called tomboy-ng-master.zip however, wget gets a master.zip and that must be renamed. You can now extract the prepare.bash script from the zip file or, perhaps easier download it from the github tomboy-ng page, browse to prepare.bash, click the "raw" button, right click, save_as. The prepare script will unzip the zip file, download kcontrols and insert its source into the working directory, leave some semophores for the buildit.bash script about where your FPC and Lazarus is (if you have them in user space, not needed if installed in root space). It then creates a .orig.tar.gz file that becomes the reference for the deb source package. Note that the .orig.tar.gz file's content must be identical to the working directory at this stage, the build process will fail if you change anything in working dir after the .orig.tar.gz file is created. If you need to change things, perhaps you are going to sign with your key (you cannot use mine!) or you wish to change build target or dependencies for example, give the prepare script a -p option, it will pause before making the .orig.tar.gz file. cd into the working dir, its called tomboy-ng_{$VER-1}. And do one of - * If you just want the binary, run bash ./buildit.bash no signing needed and you will find the binary down in the source directory. * If you want a binary deb, you must have devscripts installed, and some config things, you should have changed the prepare script wrt your own gpg key. In the working directory, run debbuild -us uc The binary dep will appear (along with src files) in directory above. * If you are going to build a full deb src package, to eg submit to a PPA then first check its building OK with above step then run debuild -S you will be asked sign it and it will leave the necessary files in the directory above. cd up and make sure you see a tomboy-ng_{$VER-1}_source.changes file. Run - dput ppa:d-bannon/ppa-tomboy-ng tomboy-ng_0.29e-1_source.changes [enter] Note : pretty obviously, you won't be submitting to my PPA so change it. Options to prepare.bash ------------------------ WIDGET SET The default widget set is GTK2, pass -Q to prepare.bash and you will get Qt5 BUILD TIME CHANGES Pass -p to prepare.bash and it will pause just before creating the .orig. file then, in another terminal you can alter the tree. Useful to add extra info in the changelog, the target system, dependancies etc. CLEAN or UPDATE There are two options that were used during development, likely of no use to most other people. USING LOCALLY BUILT LAZARUS / FPC In fact, you need only lazbuild and lcl (make lazbuild; make lcl). Many Lazarus users (sensibly) build their own from source, but that leaves them with Lazarus not findable using the core system path that debuild uses. Similarly, fpc can be installed direct from SourceForge tarballs. The prepare script will find your tarball FPC (as long as it is on your full path) but not Lazarus. So, put a full path to lazbuild with the option -l and prepare.bash will leave 'semophores' for the build process to find fpc and Lazarus. debuild will object as it does not find Lazarus in the apt database, pass it -d and all will be well. Please report any issues at https://github.com/tomboy-notes/tomboy-ng David Bannon, August 2020 tomboy-ng_0.34-1/prepare.md0000644000175000017500000001437214145033507015404 0ustar dbannondbannonBuilding Debian or PPA source packages. =========== This document is about building the source packages that are uploaded to either Debian Mentors or Launchpad PPA. With tomboy-ng, we use scripts (in the scripts dir) to do the initial setup prior to building and then instructions here to complete the processes. In all cases, we upload a source package, it must build on their remote system. These notes are primarly for my, David's, use and assume that we are using the already configured VM's for this job. There is, however, a section on configuring VMs for this purpose, setting up ID and certificates. **debhelper version** Debian Bullseye requires 13, building the PPA on U20.04 requires 12 but because we target U18.04 for GTK2, must be 11. The PPA for the Qt5 version is 12 because we target Focal as a starting point (U18.04 will not run Qt5 apps easily). Thus we have four control files, sigh .... **Debian Source** ======== Understand that there are two distinct build processes for making a Deb Src. The first, used initially or when releasing a new version of tomboy-ng, involves downloading the tomboy-ng tree from github, making some changes and generating a new .orig file. Then making a .changes and .dsc file. In this model, the resulting package always has a -1 debian suffix. The other building model is when a build problem is noted, the tomboy-ng source has not changed, just something cleaned up in the build. Here we take the previous .orig file, extract its contents, make whatever change is necessary and rebuild. The .orig file is not re-uploaded and the resulting package will have -2 or -3, -4 on a really bad day. The process is download (or extract) tomboy-ng source, remove unnecessary content, build the SRC package, copy files to a clean directory, do a test build (that makes the .deb file) and run an pedantic lintian. If thats all satisfactory, we upload to Mentors. The script, test-deb.bash automates the build test process if you don't want or need to see each step. Just download that scripts/test-deb.bash, run it from your home dir assuming you have a root installed FPC and Lazarus. **Debian SRC Build steps** -------- (all assuming you are David and using a pre configured VM, Debian-T, rev the release number as required) export DebVer="Debv33" mkdir "Build""$DebVer"; cd "Build""$DebVer" wget https://raw.githubusercontent.com/tomboy-notes/tomboy-ng/master/prepare.debian bash ./prepare.debian -D unstable -n cd tomboy-ng [tab] debuild -S cd .. mkdir ../Test"$DebVer" cp *.xz *.gz *.dsc ../Test"$DebVer"; cd ../Test"$DebVer" dpkg-source -x *.dsc cd tomboy-ng [tab] dpkg-buildpackage -us -uc; cd .. lintian -IiE --pedantic *.changes OK, if everything is OK, go back and and upload it cd ../"Build""$DebVer" dput -f mentors *.changes REMEMBER to feed changlog back to github tree ! **Launchpad PPA** ======== Is built on a different VM, U2004mQt. A little more complicated because we also build the Qt5 version, changelog needs to be 'adjusted'. There is a script that automates the whole build SRC packages, unpack and build binaries called test-ppa-bash in the scripts directory. Again, only suited to building the release (ie, not a rebuild in the case of packaging errors). If you need build by hand, look through the script. **PPA build Steps (dated, better to use test-ppa.bash)** -------- export PPAVer="PPAv33" mkdir "Build""$PPAVer"; cd "Build""$PPAVer" wget https://raw.githubusercontent.com/tomboy-notes/tomboy-ng/master/prepare.ppa bash ./prepare.ppa -D bionic cd tomboy-ng [tab] debuild -S; cd ... OK, if all looks OK, go back and upload with dput ppa:d-bannon/ppa-tomboy-ng *.changes Now, the QT5 version **Important, target focal not bionic** cd .. export PPAVer="PPAv33QT" mkdir "Build""$PPAVer"; cd "Build""$PPAVer" wget https://raw.githubusercontent.com/tomboy-notes/tomboy-ng/master/prepare.ppa bash ./prepare.ppa -D focal -Q // the -Q says make a Qt5 version [-Q] cd tomboy-ng [tab] debuild -S; cd .. OK, if all looks OK, go back and upload dput ppa:d-bannon/ppa-tomboy-ng *.changes Did you follow that about versions ? To target u18.04 we must specify (in control) debhelper 11, in Focal 12, in Bullseye 13. **Building just a tomboy-ng Binary** ======== If all you want is the binary, not building src packages at all, not cross compiling, then don't worry about signing etc, just - * install FPC (>=3.2.0), Lazarus (>=2.0.10), libnotifier-dev * install libqt5pas-dev if building a QT5 version * `wget https://raw.githubusercontent.com/tomboy-notes/tomboy-ng/master/prepare.ppa` * `bash ./prepare.ppa [-Q]` // the -Q says make a Qt5 version please. * `cd tomboy-ng[tab] [enter]` * `bash ./buildit.bash` The binary will be in the source/. directory below where you are now standing. **VM Setup** ======== A PGP key is required to upload to Mentors or Launchpad. It lives in ~/.gnupg. pgp ~/.gpg/public-keys/tomboy-ng-GPU-KEY [enter] pub rsa3072 2020-03-10 `79445......` uid tomboy-ng (The 79445.... is the fingerprint) On the Launchpad PPA machine, In users home dir, a file called .devscripts.conf that contains DEBSIGN_KEYID=7944 5...... ie, the full key fingerprint. I am unsure how, on the Debian VM, the script knows which PGP Key to use. Both prepare scripts have hardwired my personal full name and tomboy-ng email address. These will only be used if relevent env vars are empty. Note that they must match whats available in a gpg key. AND if that does not match the Maintainer: entry from control, we get a non maintainer upload warning. Debian Bullseye likes debhelper = 13, Ubuntu is still on 12 in control file **Install** devscripts Lazarus >= 2.0.10, FPC >= 3.2.0 Debian need a config file, .dput.cf in $HOME that points to mentors, see mentors website. https://mentors.debian.net The Launchpad PPA VM does not seem to have that, we put destination address in the dput command line. The Debian file looks like - [mentors] fqdn = mentors.debian.net incoming = /upload method = https allow_unsigned_uploads = 0 progress_indicator = 2 # Allow uploads for UNRELEASED packages allowed_distributions = .* tomboy-ng_0.34-1/debian/0000755000175000017500000000000014145033543014637 5ustar dbannondbannontomboy-ng_0.34-1/debian/copyright0000644000175000017500000001216414145033543016576 0ustar dbannondbannonFormat: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ Upstream-Name: tomboy-ng Upstream-Contact: David Bannon Source: https://github.com/tomboy-notes/tomboy-ng Files: * Copyright: 2017-2020 David Bannon License: The-Clear-BSD-License Files: source/libnotify.pas Copyright: (C) 2011 Ido Kanner idokan at@at gmail dot.dot com License: GPL-2.0-or-later Files: kcontrols/* Copyright: 2020 Tomas Krysl License: The-Clear-BSD-License Files: source/hunspell.inc Copyright: 2002 Kevin Hendricks License: MPL1.1/GPL2.0/LGPL2.1 Files: source/jsontools.pas Copyright: 2019 Anthony Walter License: LGPL-3 License: The-Clear-BSD-License Redistribution and use in source and binary forms, with or without modification, are permitted (subject to the limitations in the disclaimer below) provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. NO EXPRESS OR IMPLIED LICENSES TO ANY PARTY'S PATENT RIGHTS ARE GRANTED BY THIS LICENSE. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. License: GPL-2.0-or-later This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. . This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. . You should have received a copy of the GNU General Public License along with this package; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA . On Debian systems, the full text of the GNU General Public License version 2 can be found in the file `/usr/share/common-licenses/GPL-2'. License: MPL1.1/GPL2.0/LGPL2.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 Hunspell, based on MySpell. The Initial Developers of the Original Code are Kevin Hendricks (MySpell) and Németh László (Hunspell). Portions created by the Initial Developers are Copyright (C) 2002-2005 the Initial Developers. All Rights Reserved. Contributor(s): David Einstein, Davide Prina, Giuseppe Modugno, Gianluca Turconi, Simon Brouwer, Noll János, Bíró Árpád, Goldman Eleonóra, Sarlós Tamás, Bencsáth Boldizsár, Halácsy Péter, Dvornik László, Gefferth András, Nagy Viktor, Varga Dániel, Chris Halls, Rene Engelhard, Bram Moolenaar, Dafydd Jones, Harri Pitkänen Alternatively, the contents of this file may be used under the terms of either the GNU General Public License Version 2 or later (the "GPL"), or the GNU Lesser General Public License Version 2.1 or later (the "LGPL"), in which case the provisions of the GPL or the LGPL are applicable instead of those above. If you wish to allow use of your version of this file only under the terms of either the GPL or the LGPL, and not to allow others to use your version of this file under the terms of the MPL, indicate your decision by deleting the provisions above and replace them with the notice and other provisions required by the GPL or the LGPL. If you do not delete the provisions above, a recipient may use your version of this file under the terms of any one of the MPL, the GPL or the LGPL. License: LGPL-3 On Debian systems, the complete text of the GNU Lesser General Public License can be found in /usr/share/common-licenses/LGPL-3.