unit uBafTypes;

// this code is under the BAF fair use license (BFUL) - https://bafbal.de/index.php?title=Bful
// types, consts and basic functions

interface

uses System.Math, System.SysUtils, Winapi.Windows, System.UiTypes, System.DateUtils,
    System.Classes, System.StrUtils, Data.DB;

const
  BAF_VERSION = '1.04';

  BAFYESCHARS = ['Y', 'y', 'J', 'j', '1'];
  BAFNOCHARS = ['N', 'n', '0'];
  BAFYESCHAR = 'Y';
  BAFNOCHAR = 'N';
  BAFTRENN = '|^|';
  BAFDATETIMEFMT = 'dd.mm.yyyy hh:mm:ss';
  BAFDATEFMT = 'dd.mm.yyyy';

  CMD_WIZ = 'cmdwiz';
  CMD_WIZ2 = 'cmdwiz2';

  BAF_STEPS: array[-6..24] of currency = (0.01, 0.02, 0.05, 0.1, 0.2, 0.5, 1,
    2, 5, 10, 20, 50, 100, 200, 500, 1000, 2000, 5000, 10000, 20000, 50000, 100000,
    200000, 500000, 1000000, 2000000, 5000000, 10000000, 20000000, 50000000, 100000000);

  SEC_DB = 'DB';
  SEC_DATA = 'Data';
  SEC_ADD = 'Additional';
  SEC_XCOL = 'XCol';

  ITEM_GUID = 'GUID';

  BAF_DUMMYNODE_CAPTION = '[ - ]';
  BAF_OTHER = '{FE6802CC-CE08-4399-91B0-F3F64EAACF89}';
  BAF_INI_OC = '{E50F2D61-DDF4-4202-A08C-18057315B80D}';

  BAF_VK_PLUS = 187;
  BAF_VK_MINUS = 189;

  SEG_CODE = '@@code@@';


type
  TBafGeneration = (bg301, bg302, bg303, bg303TT);

  TBafPageLeaveCellMode = (lcNoLeave, lcEnter, lcEascape);

  TBafPageMousePosition = (mpNone, mpTitle, mpTitlePlus, mpSizer, mpVertScroll,
      mpVertScrollButton, mpScrollV, mpScrollVBut, mpScrollH, mpScrollHBut,
      mpHeader, mpHeaderButton, mpMemo, mpGridDataCell, mpGridFooterCell,
      mpGridHeaderCell, mpGridHeaderColSizer, mpGridButton, mpGridCheck,
      mpGridSortUp, mpGridSortDown, mpButton, mpMap, mpMapCheck,
      // for Dash
      mpPrimarySizer, mpSecondarySizer);

  TBafPageSegmentType = (stNone, stText, stValueList, stMemo,
      stGrid, stButtons, stXGrid, stXXGrid, stDia, stMap, stPic, stSGrid
      {, stXyDiaX, stTextMemo});

  TBafPageCellType = (ctText, ctHeader, ctLookup, ctCurr, ctCurr4, ctInt,
      ctBool, ctBool2, ctGuid, ctLink, ctLookupLive, ctLookupStatus, ctButton,
      ctIBAN, ctDate, ctDateMin, ctDateSek, ctMultiLine, ctColor, ctColorHex,
      ctTodo, ctMemo, ctRadio, ctTriPlus, ctTriEx, ctBoolInv, ctLookupText,
      ctCurrInt);

  TBafGridLineType = (ltSingle, ltSingleStretch, ltMulti, ltMultiStretch);

  TBafGridRowType = (rtNone, rtData, rtDisplayData, rtHeader, rtFooter, rtMap);

  TBafAlignment = (taLeftJustify, taRightJustify, taCenter, taDecimal2,
      taDecimal4, taExplicitLeft);

  TBafFont = (fnNormal, fnIcons, fnFixed);

  TBafListButtonStat = (bsNone, bsDisabled, bsHover, bsPressed);         // auch für Sort

  TBafClientEditComp = (ecNone, ecEdit, ecIbanEdit, ecMemo, ecCombo, ecColor);

  TBafRight = (brNone, brRead, brWrite);

  TBafSort = (soText, soNumber, soDate);

  TBafSortDirection = (sdNone, sdDown, sdUp);

  TBafLinks = (liData, liYear, liMonth, liWeek, liDay, liCYear, liCMonth, liCWeek, liCDay);

  TBafLinkFuncs = (lfNone, lfCount, lfSum, lfMin, lfMax);

  TBafGridDiaType = (dtNone, dtLine, dtBar, dtSbsBar, dtStack, dtCake);

  TBafDiaColumnType = (dtString, dtDate);

  TBafDiaLegendPos = (lpNone, lpLeft, lpBottom, lpRight, lpTop);

  TBafInterpreterFilterStatus = (fsNone, fsInFilter, fsOutFilter, fsFilterDone, fsNoRights);

  TBafDataQuelle = (dqTable, dqSQL, dqData, dqLink, dqY, dqJoin, dqHttp,
      dqFile, dqXML, dqThread, dqXMLThread, dqJSON, dqJSONThread, dqNone,
      dqSqlAdd, dqSqlMerge, dqText);

  TBafJoinType = (jtKomma, jtSum);

  TBafGridStatus = (gsBrowse, gsChanged, gsEditing, gsCheckFailed);

  TBafNullValueAction = (nvNone, nvValue, nvInsert, nvInsertChange, nvChange);

  TBafPlausiTyp = (ptInfo, ptWarning, ptError);

  TBafClientTabType = (ttStandard, ttSecond, ttToolbox);

  TBafDashType = (dtHoricontal, dtVertical);

  TBafHintType = (htNone, htSimple, htMultiRow);

  TBafOpenCloseType = (ocOnlyOpen, ocOnlyClose, ocOpenAndClose);

  TBafCheckType = (ctNone, ctWarning, ctError, ctAutomatic);

  TBafFrmObject = (foTree, foPage, foPlay, foPause, foStop);

  TBafMapType = (mtCheck, mtMonthCalendar);

  TBafConvertFunction = (cfNone, cfIsoDate, cfIsoDateTime, cfTrueFalse,
    cfPointFloat, cfUrlEncode, cfUrlDecode, cfUtf8);

  TBafPlausi = class
    Check: string;
    Condition: string;
    Caption: string;
    Typ: TBafPlausiTyp;
  end;

  TBafDebugFlags = record
    debug_upsert: boolean;
    debug_open: boolean;
    debug_exec: boolean;
  end;

  TBafInterType = (itClient, itSrvProc, itThread);

  TBafSuspended = (bsFinished, bsPlay, bsPause, bsStop);

function BafIsNumberedFunk(AText, AProc: string; var ANumber: integer): boolean;
function BafIsYesChar(AText: string): boolean;
function BafIsNoChar(AText: string): boolean;

function BafEncode1310(AText: string): string;
function BafDecode1310(AText: string): string;
function BafOhnePrefix(AText, APrefix, ADefault: string): string;

function BafGetGuid: string;

function BafName2Color(AName: string): TColor;
function BafIndex2Color(AIndex: integer): TAlphaColor;
function BafColor2NameEn(AColor: TColor): string;
function BafColor2AlphaColor(AColor: TColor): TAlphaColor;

function BafConvertUmlaute(AText: string): string;
function BafConvert(AFunction: TBafConvertFunction; AText: string): string;

function BafPosInRect(ARect: TRect; AX, AY: integer): boolean;

function BafGetCellType(AValue: string): TBafPageCellType;
function BafGetCellTypeName(AType: TBafPageCellType): string;
function BafGetAlign(AValue: string; ADefault: TBafAlignment): TBafAlignment;
function BafGetAlignName(AAlign: TBafAlignment): string;
function BafGetNvaName(ANva: TBafNullValueAction): string;
function BafGetGridLineType(AValue: string): TBafGridLineType;


procedure BafListSort(AList: TStrings);

function BafIsValidIban(AText: string): boolean;


function BafStringListCompareCurrency(List: TStringList; Index1, Index2: Integer): Integer;
function BafStringListCompareDateTime(List: TStringList; Index1, Index2: Integer): Integer;

function GetBafGeneration(AText: string): TBafGeneration;

function BafGetEncoding(AEnc: string): TEncoding;
function CellCheckFormat(AText, ACommand: string): string;

function BafGetFieldtypeName(AFieldType: TFieldType): string;

procedure BafPerformanceLog(AText: string);

function GetOpenClose(AText: string): TBafOpenCloseType;

function BafWeekOfTheMonth(ADate: TDate): integer;

function BafCurrInt2Int(AText: string): string;
function BafInt2CurrInt(AText: string): string;


var
  gv_debug: TBafDebugFlags;
  gv_root: string;
  gv_userroot: string;
  gv_plog: TStringList;
  gv_performancelog: boolean;

implementation


function BafHex2Color(AText: string): TColor;
var
  i: integer;
  LVal: integer;
begin
  AText := Trim(AText);
  result := 0;
  for i := Length(AText) downto Max(1, Length(AText) - 6) do begin
    case AText[i] of
      '0': LVal := 0;
      '1': LVal := 1;
      '2': LVal := 2;
      '3': LVal := 3;
      '4': LVal := 4;
      '5': LVal := 5;
      '6': LVal := 6;
      '7': LVal := 7;
      '8': LVal := 8;
      '9': LVal := 9;
      'A', 'a': LVal := 10;
      'B', 'b': LVal := 11;
      'C', 'c': LVal := 12;
      'D', 'd': LVal := 13;
      'E', 'e': LVal := 14;
      'F', 'f': LVal := 15;
    else
      LVal := 0;
    end;
    result := result + (LVal shl (4 * (Length(AText) - i)));
  end;
end;

function BafIsNumberedFunk(AText, AProc: string; var ANumber: integer): boolean;
// checks, if there is a numeric procedure   (text, text2, text3...)
// text equals text1
var
  s: string;
begin
  result := AnsiCompareText(copy(AText, 1, Length(AProc)), AProc) = 0;
  if result then begin
    s := Trim(copy(AText, Length(AProc) + 1, MaxInt));
    if s = '' then
      s := '1';
    ANumber := StrToIntDef(s, -1);
    result := (ANumber > 0);
  end;
end;

function BafIsYesChar(AText: string): boolean;
begin
  result := (Length(AText) > 0) and CharInSet(AText[1], BAFYESCHARS);
end;

function BafIsNoChar(AText: string): boolean;
begin
  result := (Length(AText) > 0) and CharInSet(AText[1], BAFNOCHARS);
end;

function BafEncode1310(AText: string): string;
var
  i: integer;
  LErsetzen: boolean;
begin
  LErsetzen := false;
  for i := 1 to Length(AText) do begin
    if AText[i] = #10 then begin
      LErsetzen := true;
      Break;
    end;
  end;

  if LErsetzen then begin
    result := StringReplace(AText, #10, BAFTRENN, [rfReplaceAll]);
    result := StringReplace(result, #13, '', [rfReplaceAll]);
  end
  else
    result := AText;
end;

function BafDecode1310(AText: string): string;
begin
  result := StringReplace(AText, BAFTRENN, #13#10, [rfReplaceAll]);
end;

function BafOhnePrefix(AText, APrefix, ADefault: string): string;
begin
  result := ADefault;
  if copy(AnsiUpperCase(AText), 1, Length(APrefix)) = AnsiUpperCase(APrefix) then
    result := copy(AText, Length(APrefix) + 1, MaxInt);
end;

function BafGetGuid: string;
// generates a GUID without brackets
begin
  result := AnsiUpperCase(GUIDToString(TGUID.NewGuid));
  result := copy(result, 2, Length(result) - 2);
end;

function BafName2Color(AName: string): TColor;
begin
  AName := AnsiLowerCase(AName);
  if AName = 'aliceblue' then result := TColorRec.Aliceblue
  else if AName = 'antiquewhite' then result := TColorRec.Antiquewhite
  else if AName = 'aqua' then result := TColorRec.Aqua
  else if AName = 'aquamarine' then result := TColorRec.Aquamarine
  else if AName = 'azure' then result := TColorRec.Azure
  else if AName = 'beige' then result := TColorRec.Beige
  else if AName = 'bisque' then result := TColorRec.Bisque
  else if AName = 'black' then result := TColorRec.Black
  else if AName = 'blanchedalmond' then result := TColorRec.Blanchedalmond
  else if AName = 'blue' then result := TColorRec.Blue
  else if AName = 'blueviolet' then result := TColorRec.Blueviolet
  else if AName = 'brown' then result := TColorRec.Brown
  else if AName = 'burlywood' then result := TColorRec.Burlywood
  else if AName = 'cadetblue' then result := TColorRec.Cadetblue
  else if AName = 'chartreuse' then result := TColorRec.Chartreuse
  else if AName = 'chocolate' then result := TColorRec.Chocolate
  else if AName = 'coral' then result := TColorRec.Coral
  else if AName = 'cornflowerblue' then result := TColorRec.Cornflowerblue
  else if AName = 'cornsilk' then result := TColorRec.Cornsilk
  else if AName = 'crimson' then result := TColorRec.Crimson
  else if AName = 'cyan' then result := TColorRec.Cyan
  else if AName = 'darkblue' then result := TColorRec.Darkblue
  else if AName = 'darkcyan' then result := TColorRec.Darkcyan
  else if AName = 'darkgoldenrod' then result := TColorRec.Darkgoldenrod
  else if AName = 'darkgray' then result := TColorRec.Darkgray
  else if AName = 'darkgreen' then result := TColorRec.Darkgreen
  else if AName = 'darkgrey' then result := TColorRec.Darkgrey
  else if AName = 'darkkhaki' then result := TColorRec.Darkkhaki
  else if AName = 'darkmagenta' then result := TColorRec.Darkmagenta
  else if AName = 'darkolivegreen' then result := TColorRec.Darkolivegreen
  else if AName = 'darkorange' then result := TColorRec.Darkorange
  else if AName = 'darkorchid' then result := TColorRec.Darkorchid
  else if AName = 'darkred' then result := TColorRec.Darkred
  else if AName = 'darksalmon' then result := TColorRec.Darksalmon
  else if AName = 'darkseagreen' then result := TColorRec.Darkseagreen
  else if AName = 'darkslateblue' then result := TColorRec.Darkslateblue
  else if AName = 'darkslategray' then result := TColorRec.Darkslategray
  else if AName = 'darkslategrey' then result := TColorRec.Darkslategrey
  else if AName = 'darkturquoise' then result := TColorRec.Darkturquoise
  else if AName = 'darkviolet' then result := TColorRec.Darkviolet
  else if AName = 'deeppink' then result := TColorRec.Deeppink
  else if AName = 'deepskyblue' then result := TColorRec.Deepskyblue
  else if AName = 'dimgray' then result := TColorRec.Dimgray
  else if AName = 'dimgrey' then result := TColorRec.Dimgrey
  else if AName = 'dodgerblue' then result := TColorRec.Dodgerblue
  else if AName = 'firebrick' then result := TColorRec.Firebrick
  else if AName = 'floralwhite' then result := TColorRec.Floralwhite
  else if AName = 'forestgreen' then result := TColorRec.Forestgreen
  else if AName = 'fuchsia' then result := TColorRec.Fuchsia
  else if AName = 'gainsboro' then result := TColorRec.Gainsboro
  else if AName = 'ghostwhite' then result := TColorRec.Ghostwhite
  else if AName = 'gold' then result := TColorRec.Gold
  else if AName = 'goldenrod' then result := TColorRec.Goldenrod
  else if AName = 'gray' then result := TColorRec.Gray
  else if AName = 'green' then result := TColorRec.Green
  else if AName = 'greenyellow' then result := TColorRec.Greenyellow
  else if AName = 'grey' then result := TColorRec.Grey
  else if AName = 'honeydew' then result := TColorRec.Honeydew
  else if AName = 'hotpink' then result := TColorRec.Hotpink
  else if AName = 'indianred' then result := TColorRec.Indianred
  else if AName = 'indigo' then result := TColorRec.Indigo
  else if AName = 'ivory' then result := TColorRec.Ivory
  else if AName = 'khaki' then result := TColorRec.Khaki
  else if AName = 'lavender' then result := TColorRec.Lavender
  else if AName = 'lavenderblush' then result := TColorRec.Lavenderblush
  else if AName = 'lawngreen' then result := TColorRec.Lawngreen
  else if AName = 'lemonchiffon' then result := TColorRec.Lemonchiffon
  else if AName = 'lightblue' then result := TColorRec.Lightblue
  else if AName = 'lightcoral' then result := TColorRec.Lightcoral
  else if AName = 'lightcyan' then result := TColorRec.Lightcyan
  else if AName = 'lightgoldenrodyellow' then result := TColorRec.Lightgoldenrodyellow
  else if AName = 'lightgray' then result := TColorRec.Lightgray
  else if AName = 'lightgreen' then result := TColorRec.Lightgreen
  else if AName = 'lightgrey' then result := TColorRec.Lightgrey
  else if AName = 'lightpink' then result := TColorRec.Lightpink
  else if AName = 'lightsalmon' then result := TColorRec.Lightsalmon
  else if AName = 'lightseagreen' then result := TColorRec.Lightseagreen
  else if AName = 'lightskyblue' then result := TColorRec.Lightskyblue
  else if AName = 'lightslategray' then result := TColorRec.Lightslategray
  else if AName = 'lightslategrey' then result := TColorRec.Lightslategrey
  else if AName = 'lightsteelblue' then result := TColorRec.Lightsteelblue
  else if AName = 'lightyellow' then result := TColorRec.Lightyellow
  else if AName = 'ltgray' then result := TColorRec.LtGray
  else if AName = 'medgray' then result := TColorRec.MedGray
  else if AName = 'dkgray' then result := TColorRec.DkGray
  else if AName = 'moneygreen' then result := TColorRec.MoneyGreen
  else if AName = 'legacyskyblue' then result := TColorRec.LegacySkyBlue
  else if AName = 'cream' then result := TColorRec.Cream
  else if AName = 'lime' then result := TColorRec.Lime
  else if AName = 'limegreen' then result := TColorRec.Limegreen
  else if AName = 'linen' then result := TColorRec.Linen
  else if AName = 'magenta' then result := TColorRec.Magenta
  else if AName = 'maroon' then result := TColorRec.Maroon
  else if AName = 'mediumaquamarine' then result := TColorRec.Mediumaquamarine
  else if AName = 'mediumblue' then result := TColorRec.Mediumblue
  else if AName = 'mediumorchid' then result := TColorRec.Mediumorchid
  else if AName = 'mediumpurple' then result := TColorRec.Mediumpurple
  else if AName = 'mediumseagreen' then result := TColorRec.Mediumseagreen
  else if AName = 'mediumslateblue' then result := TColorRec.Mediumslateblue
  else if AName = 'mediumspringgreen' then result := TColorRec.Mediumspringgreen
  else if AName = 'mediumturquoise' then result := TColorRec.Mediumturquoise
  else if AName = 'mediumvioletred' then result := TColorRec.Mediumvioletred
  else if AName = 'midnightblue' then result := TColorRec.Midnightblue
  else if AName = 'mintcream' then result := TColorRec.Mintcream
  else if AName = 'mistyrose' then result := TColorRec.Mistyrose
  else if AName = 'moccasin' then result := TColorRec.Moccasin
  else if AName = 'navajowhite' then result := TColorRec.Navajowhite
  else if AName = 'navy' then result := TColorRec.Navy
  else if AName = 'oldlace' then result := TColorRec.Oldlace
  else if AName = 'olive' then result := TColorRec.Olive
  else if AName = 'olivedrab' then result := TColorRec.Olivedrab
  else if AName = 'orange' then result := TColorRec.Orange
  else if AName = 'orangered' then result := TColorRec.Orangered
  else if AName = 'orchid' then result := TColorRec.Orchid
  else if AName = 'palegoldenrod' then result := TColorRec.Palegoldenrod
  else if AName = 'palegreen' then result := TColorRec.Palegreen
  else if AName = 'paleturquoise' then result := TColorRec.Paleturquoise
  else if AName = 'palevioletred' then result := TColorRec.Palevioletred
  else if AName = 'papayawhip' then result := TColorRec.Papayawhip
  else if AName = 'peachpuff' then result := TColorRec.Peachpuff
  else if AName = 'peru' then result := TColorRec.Peru
  else if AName = 'pink' then result := TColorRec.Pink
  else if AName = 'plum' then result := TColorRec.Plum
  else if AName = 'powderblue' then result := TColorRec.Powderblue
  else if AName = 'purple' then result := TColorRec.Purple
  else if AName = 'red' then result := TColorRec.Red
  else if AName = 'rosybrown' then result := TColorRec.Rosybrown
  else if AName = 'royalblue' then result := TColorRec.Royalblue
  else if AName = 'saddlebrown' then result := TColorRec.Saddlebrown
  else if AName = 'salmon' then result := TColorRec.Salmon
  else if AName = 'sandybrown' then result := TColorRec.Sandybrown
  else if AName = 'seagreen' then result := TColorRec.Seagreen
  else if AName = 'seashell' then result := TColorRec.Seashell
  else if AName = 'sienna' then result := TColorRec.Sienna
  else if AName = 'silver' then result := TColorRec.Silver
  else if AName = 'skyblue' then result := TColorRec.Skyblue
  else if AName = 'slateblue' then result := TColorRec.Slateblue
  else if AName = 'slategray' then result := TColorRec.Slategray
  else if AName = 'slategrey' then result := TColorRec.Slategrey
  else if AName = 'snow' then result := TColorRec.Snow
  else if AName = 'springgreen' then result := TColorRec.Springgreen
  else if AName = 'steelblue' then result := TColorRec.Steelblue
  else if AName = 'tan' then result := TColorRec.Tan
  else if AName = 'teal' then result := TColorRec.Teal
  else if AName = 'thistle' then result := TColorRec.Thistle
  else if AName = 'tomato' then result := TColorRec.Tomato
  else if AName = 'turquoise' then result := TColorRec.Turquoise
  else if AName = 'violet' then result := TColorRec.Violet
  else if AName = 'wheat' then result := TColorRec.Wheat
  else if AName = 'white' then result := TColorRec.White
  else if AName = 'whitesmoke' then result := TColorRec.Whitesmoke
  else if AName = 'yellow' then result := TColorRec.Yellow
  else if AName = 'yellowgreen' then result := TColorRec.Yellowgreen
  else
    result := BafHex2Color(AName);
end;

function BafIndex2Color(AIndex: integer): TAlphaColor;
begin
  case AIndex mod 20 of
    0: result := $FFDD0000;
    1: result := $FF00DD00;
    2: result := $FF0000FF;
    3: result := $FFEE00EE;
    4: result := $FF00EEEE;
    5: result := $FF990000;
    6: result := $FF008800;
    7: result := $FF000099;
    8: result := $FF990099;
    9: result := $FF009999;
    10: result := $FFFF0000;
    11: result := $FF006600;
    12: result := $FF8888FF;
    13: result := $FFFFBB00;
    14: result := $FFBBBBBB;
    15: result := $FF997700;
    16: result := $FF779900;
    17: result := $FFFFAAAA;
    18: result := $FFFFAAFF;
    19: result := $FFAAFFAA;
  else
    result := TAlphaColorRec.Black;
  end;
end;

function BafColor2NameEn(AColor: TColor): string;
begin
  case AColor of
    TColorRec.Aliceblue: result := 'Aliceblue';
    TColorRec.Antiquewhite: result := 'Antiquewhite';
//    TColorRec.Aqua: result := 'Aqua';
    TColorRec.Aquamarine: result := 'Aquamarine';
    TColorRec.Azure: result := 'Azure';
    TColorRec.Beige: result := 'Beige';
    TColorRec.Bisque: result := 'Bisque';
    TColorRec.Black: result := 'Black';
    TColorRec.Blanchedalmond: result := 'Blanchedalmond';
    TColorRec.Blue: result := 'Blue';
    TColorRec.Blueviolet: result := 'Blueviolet';
    TColorRec.Brown: result := 'Brown';
    TColorRec.Burlywood: result := 'Burlywood';
    TColorRec.Cadetblue: result := 'Cadetblue';
    TColorRec.Chartreuse: result := 'Chartreuse';
    TColorRec.Chocolate: result := 'Chocolate';
    TColorRec.Coral: result := 'Coral';
    TColorRec.Cornflowerblue: result := 'Cornflowerblue';
    TColorRec.Cornsilk: result := 'Cornsilk';
    TColorRec.Crimson: result := 'Crimson';
    TColorRec.Cyan: result := 'Cyan';
    TColorRec.Darkblue: result := 'Darkblue';
    TColorRec.Darkcyan: result := 'Darkcyan';
    TColorRec.Darkgoldenrod: result := 'Darkgoldenrod';
//    TColorRec.Darkgray: result := 'Darkgray';
    TColorRec.Darkgreen: result := 'Darkgreen';
    TColorRec.Darkgrey: result := 'Darkgrey';
    TColorRec.Darkkhaki: result := 'Darkkhaki';
    TColorRec.Darkmagenta: result := 'Darkmagenta';
    TColorRec.Darkolivegreen: result := 'Darkolivegreen';
    TColorRec.Darkorange: result := 'Darkorange';
    TColorRec.Darkorchid: result := 'Darkorchid';
    TColorRec.Darkred: result := 'Darkred';
    TColorRec.Darksalmon: result := 'Darksalmon';
    TColorRec.Darkseagreen: result := 'Darkseagreen';
    TColorRec.Darkslateblue: result := 'Darkslateblue';
//    TColorRec.Darkslategray: result := 'Darkslategray';
    TColorRec.Darkslategrey: result := 'Darkslategrey';
    TColorRec.Darkturquoise: result := 'Darkturquoise';
    TColorRec.Darkviolet: result := 'Darkviolet';
    TColorRec.Deeppink: result := 'Deeppink';
    TColorRec.Deepskyblue: result := 'Deepskyblue';
//    TColorRec.Dimgray: result := 'Dimgray';
    TColorRec.Dimgrey: result := 'Dimgrey';
    TColorRec.Dodgerblue: result := 'Dodgerblue';
    TColorRec.Firebrick: result := 'Firebrick';
    TColorRec.Floralwhite: result := 'Floralwhite';
    TColorRec.Forestgreen: result := 'Forestgreen';
//    TColorRec.Fuchsia: result := 'Fuchsia';
    TColorRec.Gainsboro: result := 'Gainsboro';
    TColorRec.Ghostwhite: result := 'Ghostwhite';
    TColorRec.Gold: result := 'Gold';
    TColorRec.Goldenrod: result := 'Goldenrod';
//    TColorRec.Gray: result := 'Gray';
    TColorRec.Green: result := 'Green';
    TColorRec.Greenyellow: result := 'Greenyellow';
    TColorRec.Grey: result := 'Grey';
    TColorRec.Honeydew: result := 'Honeydew';
    TColorRec.Hotpink: result := 'Hotpink';
    TColorRec.Indianred: result := 'Indianred';
    TColorRec.Indigo: result := 'Indigo';
    TColorRec.Ivory: result := 'Ivory';
    TColorRec.Khaki: result := 'Khaki';
    TColorRec.Lavender: result := 'Lavender';
    TColorRec.Lavenderblush: result := 'Lavenderblush';
    TColorRec.Lawngreen: result := 'Lawngreen';
    TColorRec.Lemonchiffon: result := 'Lemonchiffon';
    TColorRec.Lightblue: result := 'Lightblue';
    TColorRec.Lightcoral: result := 'Lightcoral';
    TColorRec.Lightcyan: result := 'Lightcyan';
    TColorRec.Lightgoldenrodyellow: result := 'Lightgoldenrodyellow';
//    TColorRec.Lightgray: result := 'Lightgray';
    TColorRec.Lightgreen: result := 'Lightgreen';
    TColorRec.Lightgrey: result := 'Lightgrey';
    TColorRec.Lightpink: result := 'Lightpink';
    TColorRec.Lightsalmon: result := 'Lightsalmon';
    TColorRec.Lightseagreen: result := 'Lightseagreen';
    TColorRec.Lightskyblue: result := 'Lightskyblue';
//    TColorRec.Lightslategray: result := 'Lightslategray';
    TColorRec.Lightslategrey: result := 'Lightslategrey';
    TColorRec.Lightsteelblue: result := 'Lightsteelblue';
    TColorRec.Lightyellow: result := 'Lightyellow';
//    TColorRec.LtGray: result := 'LtGray';
    TColorRec.MedGray: result := 'MedGray';
//    TColorRec.DkGray: result := 'DkGray';
    TColorRec.MoneyGreen: result := 'MoneyGreen';
    TColorRec.LegacySkyBlue: result := 'LegacySkyBlue';
    TColorRec.Cream: result := 'Cream';
    TColorRec.Lime: result := 'Lime';
    TColorRec.Limegreen: result := 'Limegreen';
    TColorRec.Linen: result := 'Linen';
    TColorRec.Magenta: result := 'Magenta';
    TColorRec.Maroon: result := 'Maroon';
    TColorRec.Mediumaquamarine: result := 'Mediumaquamarine';
    TColorRec.Mediumblue: result := 'Mediumblue';
    TColorRec.Mediumorchid: result := 'Mediumorchid';
    TColorRec.Mediumpurple: result := 'Mediumpurple';
    TColorRec.Mediumseagreen: result := 'Mediumseagreen';
    TColorRec.Mediumslateblue: result := 'Mediumslateblue';
    TColorRec.Mediumspringgreen: result := 'Mediumspringgreen';
    TColorRec.Mediumturquoise: result := 'Mediumturquoise';
    TColorRec.Mediumvioletred: result := 'Mediumvioletred';
    TColorRec.Midnightblue: result := 'Midnightblue';
    TColorRec.Mintcream: result := 'Mintcream';
    TColorRec.Mistyrose: result := 'Mistyrose';
    TColorRec.Moccasin: result := 'Moccasin';
    TColorRec.Navajowhite: result := 'Navajowhite';
    TColorRec.Navy: result := 'Navy';
    TColorRec.Oldlace: result := 'Oldlace';
    TColorRec.Olive: result := 'Olive';
    TColorRec.Olivedrab: result := 'Olivedrab';
    TColorRec.Orange: result := 'Orange';
    TColorRec.Orangered: result := 'Orangered';
    TColorRec.Orchid: result := 'Orchid';
    TColorRec.Palegoldenrod: result := 'Palegoldenrod';
    TColorRec.Palegreen: result := 'Palegreen';
    TColorRec.Paleturquoise: result := 'Paleturquoise';
    TColorRec.Palevioletred: result := 'Palevioletred';
    TColorRec.Papayawhip: result := 'Papayawhip';
    TColorRec.Peachpuff: result := 'Peachpuff';
    TColorRec.Peru: result := 'Peru';
    TColorRec.Pink: result := 'Pink';
    TColorRec.Plum: result := 'Plum';
    TColorRec.Powderblue: result := 'Powderblue';
    TColorRec.Purple: result := 'Purple';
    TColorRec.Red: result := 'Red';
    TColorRec.Rosybrown: result := 'Rosybrown';
    TColorRec.Royalblue: result := 'Royalblue';
    TColorRec.Saddlebrown: result := 'Saddlebrown';
    TColorRec.Salmon: result := 'Salmon';
    TColorRec.Sandybrown: result := 'Sandybrown';
    TColorRec.Seagreen: result := 'Seagreen';
    TColorRec.Seashell: result := 'Seashell';
    TColorRec.Sienna: result := 'Sienna';
    TColorRec.Silver: result := 'Silver';
    TColorRec.Skyblue: result := 'Skyblue';
    TColorRec.Slateblue: result := 'Slateblue';
//    TColorRec.Slategray: result := 'Slategray';
    TColorRec.Slategrey: result := 'Slategrey';
    TColorRec.Snow: result := 'Snow';
    TColorRec.Springgreen: result := 'Springgreen';
    TColorRec.Steelblue: result := 'Steelblue';
    TColorRec.Tan: result := 'Tan';
    TColorRec.Teal: result := 'Teal';
    TColorRec.Thistle: result := 'Thistle';
    TColorRec.Tomato: result := 'Tomato';
    TColorRec.Turquoise: result := 'Turquoise';
    TColorRec.Violet: result := 'Violet';
    TColorRec.Wheat: result := 'Wheat';
    TColorRec.White: result := 'White';
    TColorRec.Whitesmoke: result := 'Whitesmoke';
    TColorRec.Yellow: result := 'Yellow';
    TColorRec.Yellowgreen: result := 'Yellowgreen';
  else
    result := AnsiLowerCase(IntToHex(AColor and $FFFFFF, 8));
  end;
end;

function BafColor2AlphaColor(AColor: TColor): TAlphaColor;
begin
  result := TAlphaColorRec.Alpha or (AColor and $FF) shl 16
    or  (AColor and $FF00) or  (AColor and $FF0000) shr 16;
end;


function BafConvertUmlaute(AText: string): string;
// corrects Umlaute
var
  i: integer;
begin
  for i := 1 to Length(AText) do begin
    case AText[i] of
      'ä': result := result + 'Ã¤';
      'ö': result := result + 'Ã¶';
      'ü': result := result + 'Ã¼';
      'Ä': result := result + 'Ã„';
      'Ö': result := result + 'Ã–';
      'Ü': result := result + 'Ãœ';
      'ß': result := result + 'ÃŸ';
      '€': result := result + 'â‚¬';
      'ô': result := result + 'Ã´';
      'á': result := result + 'Ã¡';
      'à': result := result + 'Ã ';
      'é': result := result + 'Ã©';
      'è': result := result + 'Ã¨';
      'ó': result := result + 'Ã³';
      'ò': result := result + 'Ã²';
      'ú': result := result + 'Ãº';
      'ù': result := result + 'Ã¹';
    else
      result := result + AText[i];
    end;
  end;
end;

function BafConvert(AFunction: TBafConvertFunction; AText: string): string;

  function lokIso(AWithTime: boolean): string;
  begin
    AText := Trim(AText);
    if AText = '' then
      result := ''
    else begin
      result := copy(AText, 9, 2) + '.'
        + copy(AText, 6, 2) + '.'
        + copy(AText, 1, 4);
      if AWithTime then
        result := result + ' ' + copy(AText, 12, 8);
    end;
  end; // lokIso

  function lokTrueFalse: string;
  begin
    AText := AnsiLowerCase(Trim(AText));
    result := IfThen(AText = 'true', 'Y', 'N');
  end; // lokTrueFalse

  function lokPointFloat: string;
  var
    i: integer;
  begin
    result := '';
    for i := 1 to Length(AText) do begin
      case AText[i] of
        '.': result := result + ',';
        '-': result := result + '-';
        '0'..'9': result := result + AText[i];
      end;
    end;
  end; // lokTrueFalse

  function lokUrlCode: string;
  var
    i: integer;
  begin
    result := '';
    for i := 1 to Length(AText) do begin
      case AText[i] of
        'ä': result := result + '%C3%A4';
        'ö': result := result + '%C3%B6';
        'ü': result := result + '%C3%BC';
        'Ä': result := result + '%C3%84';
        'Ö': result := result + '%C3%96';
        'Ü': result := result + '%C3%9C';
        'ß': result := result + '%C3%9F';
        ' ': result := result + '%20';
//        '': result := result + '';
//        '': result := result + '';
//        '': result := result + '';
//        '': result := result + '';
        else
          result := result + AText[i];
      end;
    end;

  end; // lokUrlCode

begin
  case AFunction of
    cfIsoDate: result := lokIso(false);
    cfIsoDateTime: result := lokIso(true);
    cfTrueFalse: result := lokTrueFalse;
    cfPointFloat: result := lokPointFloat;
    cfUrlEncode: result := lokUrlCode;
    cfUtf8: result := System.AnsiToUtf8(AText)

    else
      result := AText;
  end;
// function BafConvert
end;

function BafPosInRect(ARect: TRect; AX, AY: integer): boolean;
// Is the Position in the rect (or on the border)
begin
  result := (AX >= ARect.Left) and (AX <= ARect.Right) and
   (AY >= ARect.Top) and (AY <= ARect.Bottom);
end;

function BafGetCellType(AValue: string): TBafPageCellType;
begin
  result := uBafTypes.ctText;
  if AValue = 'header' then
    result := ctHeader
  else if AValue = 'lookup' then
    result := ctLookup
  else if (AValue = 'curr') or (AValue = 'curr2') then
    result := ctCurr
  else if AValue = 'curr4' then
    result := ctCurr4
  else if AValue = 'int' then
    result := ctInt
  else if AValue = 'bool' then
    result := ctBool
  else if AValue = 'boolinv' then
    result := ctBoolInv
  else if AValue = 'bool2' then
    result := ctBool2     // show only checked CheckBoxes
  else if AValue = 'guid' then
    result := ctGuid
  else if AValue = 'link' then
    result := ctLink
  else if AValue = 'lookuplive' then
    result := ctLookupLive
  else if AValue = 'lookupstatus' then
    result := ctLookupStatus
  else if AValue = 'button' then
    result := ctButton
  else if AValue = 'iban' then
    result := ctIBAN
  else if AValue = 'date' then
    result := ctDate
  else if AValue = 'datemin' then
    result := ctDateMin
  else if (AValue = 'datesek') or (AValue = 'datesec') then
    result := ctDateSek
  else if AValue = 'color' then
    result := ctColor
  else if AValue = 'colorhex' then
    result := ctColorHex
  else if AValue = 'todo' then
    result := ctTodo
  else if AValue = 'memo' then
    result := ctMemo
  else if AValue = 'radio' then
    result := ctRadio
  else if AValue = 'triplus' then
    result := ctTriPlus
  else if AValue = 'triex' then
    result := ctTriEx
  else if AValue = 'lookuptext' then
    result := ctLookupText
  else if AValue = 'currint' then
    result := ctCurrInt
  ;
end;

function BafGetCellTypeName(AType: TBafPageCellType): string;
begin
  case AType of
    ctText: result := '';
    ctHeader: result := 'header';
    ctLookup: result := 'lookup';
    ctCurr: result := 'curr';
    ctCurr4: result := 'curr4';
    ctInt: result := 'int';
    ctBool: result := 'bool';
    ctBool2: result := 'bool2';
    ctGuid: result := 'guid';
    ctLink: result := 'link';
    ctLookupLive: result := 'lookuplive';
    ctLookupStatus: result := 'lookupstatus';
    ctButton: result := 'button';
    ctIBAN: result := 'iban';
    ctDate: result := 'date';
    ctDateMin: result := 'datemin';
    ctDateSek: result := 'datesec';
    ctMultiLine: result := 'multiline';
    ctColor: result := 'color';
    ctColorHex: result := 'colorhex';
    ctTodo: result := 'todo';
    ctMemo: result := 'memo';
    ctRadio: result := 'radio';
    ctTriPlus: result := 'triplus';
    ctTriEx: result := 'triex';
    ctBoolInv: result := 'boolinv';
    ctLookupText: result := 'lookuptext';
    ctCurrInt: result := 'currint';
  end;
end;

function BafGetAlign(AValue: string; ADefault: TBafAlignment): TBafAlignment;
var
  s: string;
begin
  s := AnsiLowerCase(AValue);
  if s = 'l' then
    result := taExplicitLeft
  else if s = 'r' then
    result := taRightJustify
  else if s = 'c' then
    result := taCenter
  else if s = 'd2' then
    result := taDecimal2
  else if s = 'd4' then
    result := taDecimal4
  else if s = 'el' then
    result := taExplicitLeft
  else
    result := ADefault;
end;

function BafGetAlignName(AAlign: TBafAlignment): string;
begin
  case AAlign of
    taLeftJustify: result := 'l';
    taRightJustify: result := 'r';
    taCenter: result := 'c';
    taDecimal2: result := 'd2';
    taDecimal4: result := 'd4';
    taExplicitLeft: result := 'el';
  end;
end;

function BafGetNvaName(ANva: TBafNullValueAction): string;
begin
  case ANva of
    nvNone: result := '';
    nvValue: result := 'nv';
    nvInsert: result := 'nvi';
    nvInsertChange: result := 'nvic';
    nvChange: result := 'nvc';
  end;
end;

function BafGetGridLineType(AValue: string): TBafGridLineType;
var
  s: string;
begin
  result := ltSingle;
  s := LowerCase(AValue);
  if s = 'sf' then
    result := ltSingle
  else if s = 'ss' then
    result := ltSingleStretch
  else if s = 'mf' then
    result := ltMulti
  else if s = 'ms' then
    result := ltMultiStretch;
end;

procedure BafListSort(AList: TStrings);
var
  sl: TStringList;
begin
  sl := TStringList.Create;
  try
    sl.Text := AList.Text;
    sl.Sort;
    AList.Text := sl.Text;
  finally
    sl.Free;
  end;
end;

function BafIsValidIban(AText: string): boolean;
// validates an iban
var
  n, len: integer;
  cs, ci: UInt64;

  procedure lokGetMod;
  begin
     cs := (cs + ci) mod 97;
     ci := 0;
     n := 0;
  end; // lokGetMod

  function lokGetCheckSum(first,last: integer):boolean;
  var
    i, c: UInt64;
  begin
    for i := first to last do begin
      if n >= 15 then
        lokGetMod;
      c := Ord(AText[i]) - 48;
      case c of
        0..9: begin
          cs := cs * 10;
          ci := ci * 10 + c;
          inc(n);
        end;
        17..42: begin
          cs := cs * 100;
          ci := ci * 100 + c - 7;
          inc(n, 2);
        end;
      else
        exit(false);
      end;
    end; // for i
    result:=true;
  end; // function lokGetCheckSum

begin
   len := length(AText);
   if (len < 5) or (len > 34) then
     exit(false);
   if (AnsiUpperCase(copy(AText, 1, 2)) = 'DE')  and (len <> 22) then
     exit(false);
   cs := 0;
   ci := 0;
   n := 0;
   if not lokGetCheckSum(5,len) then
     exit(false);
   if not lokGetCheckSum(1,4) then
     exit(false);
   if n > 0 then
     lokGetMod;
   result := cs = 1;
end; // function BafIsValidIban

function BafStringListCompareCurrency(List: TStringList; Index1, Index2: Integer): Integer;
var
  LValue1, LValue2, LResult: currency;
begin
  LValue1 := StrToCurrDef(List[Index1], 0);
  LValue2 := StrToCurrDef(List[Index2], 0);
  LResult := round(LValue1 - LValue2);
  if LResult = 0 then
    LResult := LResult * 10000;
  result := round(LResult);
end;

function BafStringListCompareDateTime(List: TStringList; Index1, Index2: Integer): Integer;
var
  LValue1, LValue2, LResult: double;
begin
  LValue1 := StrToDateTimeDef(List[Index1], 0) * 24 * 3600;
  LValue2 := StrToDateTimeDef(List[Index2], 0) * 24 * 3600;
  LResult := round(LValue1 - LValue2);
  result := round(LResult);
end;

function GetBafGeneration(AText: string): TBafGeneration;
begin
  result := bg301;
  AText := AnsiLowerCase(AText);
  if AText = '301' then
    result := bg301
  else if AText = '302' then
    result := bg302
  else if AText = '303' then
    result := bg303
  else if AText = '303tt' then
    result := bg303TT
  ;
end;

function BafGetEncoding(AEnc: string): TEncoding;
begin
  AEnc := AnsiLowerCase(AEnc);
  result := TEncoding.Default;
  if AEnc = 'ansi' then
    result := TEncoding.ANSI
  else if AEnc = 'ascii' then
    result := TEncoding.ASCII
  else if AEnc = 'utf8' then
    result := TEncoding.UTF8
  else if AEnc = 'utf7' then
    result := TEncoding.UTF7
  else if AEnc = 'unicode' then
    result := TEncoding.Unicode
  else if AEnc = 'bigendianunicode' then
    result := TEncoding.BigEndianUnicode
  else if AEnc = '' then
    result := TEncoding.Default
end;

function CellCheckFormat(AText, ACommand: string): string;
var
  i: integer;
begin
  if ACommand <> '' then begin
    if AnsiCompareStr(ACommand, 'conv_yyyy') = 0 then begin
      case Length(AText) of
        14: result := copy(AText, 7, 2) + '.' + copy(AText, 5, 2) + '.' + copy(AText, 1, 4)
            + ' ' + copy(AText, 9, 2) + ':' + copy(AText, 11, 2) + ':' + copy(AText, 13, 2);
        8: result := copy(AText, 7, 2) + '.' + copy(AText, 5, 2) + '.' + copy(AText, 1, 4);
        else
          result := AText;
      end;
    end
    else if AnsiCompareStr(ACommand, 'no_crlf') = 0 then begin
      result := AText;
      if (Pos(#13, result) > 0) or (Pos(#10, result) > 0) then begin
        result := StringReplace(result, #13, ' ', [rfReplaceAll]);
        result := StringReplace(result, #10, ' ', [rfReplaceAll]);
      end;
    end
    else if AnsiCompareStr(ACommand, 'int') = 0 then begin
      result := '';
      for i := 1 to Length(AText) do begin
        if (AText[i] in ['0'..'9'])
            or ((AText[i] = '-') and (result = '')) then
          result := result + AText[i];
      end;
    end
    else if AnsiCompareStr(ACommand, 'curr') = 0 then begin
      result := '';
      for i := 1 to Length(AText) do begin
        if (AText[i] in ['0'..'9', ','])
            or ((AText[i] = '-') and (result = '')) then
          result := result + AText[i];
      end;
    end
    else
      result := AText;
  end
  else
    result := AText;
end;

function BafGetFieldtypeName(AFieldType: TFieldType): string;
begin
  case AFieldType of
    ftUnknown: result := 'Unknown';
    ftString: result := 'String';
    ftSmallint: result := 'Smallint';
    ftInteger: result := 'Integer';
    ftWord: result := 'Word';
    ftBoolean: result := 'Boolean';
    ftFloat: result := 'Float';
    ftCurrency: result := 'Currency';
    ftBCD: result := 'BCD';
    ftDate: result := 'Date';
    ftTime: result := 'Time';
    ftDateTime: result := 'DateTime';
    ftBytes: result := 'Bytes';
    ftVarBytes: result := 'VarBytes';
    ftAutoInc: result := 'AutoInc';
    ftBlob: result := 'Blob';
    ftMemo: result := 'Memo';
    ftGraphic: result := 'Graphic';
    ftFmtMemo: result := 'FmtMemo';
    ftParadoxOle: result := 'ParadoxOle';
    ftDBaseOle: result := 'DBaseOle';
    ftTypedBinary: result := 'TypedBinary';
    ftCursor: result := 'Cursor';
    ftFixedChar: result := 'FixedChar';
    ftWideString: result := 'WideString';
    ftLargeint: result := 'Largeint';
    ftADT: result := 'ADT';
    ftArray: result := 'Array';
    ftReference: result := 'Reference';
    ftDataSet: result := 'DataSet';
    ftOraBlob: result := 'OraBlob';
    ftOraClob: result := 'OraClob';
    ftVariant: result := 'Variant';
    ftInterface: result := 'Interface';
    ftIDispatch: result := 'IDispatch';
    ftGuid: result := 'Guid';
    ftTimeStamp: result := 'TimeStamp';
    ftFMTBcd: result := 'FMTBcd';
    ftFixedWideChar: result := 'FixedWideChar';
    ftWideMemo: result := 'WideMemo';
    ftOraTimeStamp: result := 'OraTimeStamp';
    ftOraInterval: result := 'OraInterval';
    ftLongWord: result := 'LongWord';
    ftShortint: result := 'Shortint';
    ftByte: result := 'Byte';
    ftExtended: result := 'Extended';
    ftConnection: result := 'Connection';
    ftParams: result := 'Params';
    ftStream: result := 'Stream';
    ftTimeStampOffset: result := 'TimeStampOffset';
    ftObject: result := 'Object';
    ftSingle: result := 'Single';
  end;
end;


procedure BafPerformanceLog(AText: string);
begin
  if gv_performancelog then
    gv_plog.Add(FormatDateTime('hh:mm:ss:zzz', now) + ' - ' + AText);
end;

function GetOpenClose(AText: string): TBafOpenCloseType;
begin
  if AText = 'c' then
    result := ocOnlyClose
  else if AText = 'oc' then
    result := ocOpenAndClose
  else
    result := ocOnlyOpen;
end;

function BafWeekOfTheMonth(ADate: TDate): integer;
const
  CDayMap: array [1..7] of Word = (7, 1, 2, 3, 4, 5, 6);
var
  LYear, LMonth, LDay, LDaysInMonth, LDayOfWeek: Word;
  LStart: TDateTime;
  LStartDayOfWeek: Word;
begin
  DecodeDateFully(ADate, LYear, LMonth, LDay, LDayOfWeek);
  LDayOfWeek := CDayMap[LDayOfWeek];
  LStart := EncodeDate(LYear, LMonth, 1);
  LStartDayOfWeek := DayOfTheWeek(LStart);
  LStartDayOfWeek := CDayMap[LStartDayOfWeek];
  result := 1 + (LDay + LStartDayOfWeek - 1) div 7;
end;

function BafCurrInt2Int(AText: string): string;
begin
  if AText = '' then
    result := ''
  else
    result := IntToStr(round(100 * (StrToCurrDef(AText, 0))));
end;


function BafInt2CurrInt(AText: string): string;
begin
  if AText = '' then
    result := ''
  else
    result := FormatFloat('0.00', StrToIntDef(AText, 0) / 100);
end;

initialization
  gv_plog := TStringList.Create;

finalization
  FreeAndNil(gv_plog);


end.

