unit TL.Components;

interface

uses
  System.Classes, System.SysUtils, System.Variants, System.UITypes, Vcl.DBGrids, Vcl.Forms, Vcl.Graphics, Vcl.GraphUtil,
  Vcl.Grids, Vcl.Themes, Win.Registry, Data.DB, Winapi.ShlObj, Winapi.ActiveX, Winapi.Windows, Winapi.KnownFolders,
  FinAdmColors, FlatDesignColorsFull; // MaterialColorsFull,

const
  DesignPPI = 240;

type
  TLFolder = class(TObject)
  protected
    function GetKnownFolderPath(const folderID: TGUID): string;
    function GetDocuments: string;
    function GetDesktop: string;
    function GetProgramData: string;
    function GetLocalAppData: string;
    function GetPictures: string;
    function GetMusic: string;
    function GetVideos: string;
    function GetDownLoads: string;
    function GetVersion: string;
  public
    property Documents: string read GetDocuments;
    property Desktop: string read GetDesktop;
    property ProgramData: string read GetProgramData;
    property LocalAppData: string read GetLocalAppData;
    property Pictures: string read GetPictures;
    property Music: string read GetMusic;
    property Videos: string read GetVideos;
    property DownLoads: string read GetDownLoads;
    property AppVersion: string read GetVersion;
  end;

var
  Folder: TLFolder;

type
  TLDBGrid = class(TCustomDBGrid)
  private
    { Private declarations }
    FTotalRow: boolean;
    FSubTotalRow: boolean;
  protected
    { Protected declarations }
    procedure DrawColumnCell(
      const Rect: TRect;
      DataCol: Integer;
      Column: TColumn;
      State: TGridDrawState); override;
    procedure KeyDown(
      var Key: Word;
      Shift: TShiftState); override;
    procedure ColEnter; override;
    procedure ColExit; override;
    procedure CellClick(Column: TColumn); override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    procedure SetColumnAttr;
    procedure SetStyle(
      DataCol: Integer;
      Grid: TLDBGrid;
      Column: TColumn;
      State: TGridDrawState;
      SoortID: Integer;
      ID: Integer);
    property TotalRow: boolean read FTotalRow write FTotalRow default False;
    property SubTotalRow: boolean read FSubTotalRow write FSubTotalRow default False;
    property Canvas;
    property SelectedRows;
    // property DefaultRowHeight;
  published
    { Published declarations }
    property Align;
    property Anchors;
    property BiDiMode;
    property BorderStyle;
    property Color;
    [stored(False)]
    property Columns stored False; // StoreColumns;
    property Constraints;
    property Ctl3D;
    property DataSource;
    property DefaultDrawing;
    property DragCursor;
    property DragKind;
    property DragMode;
    property DrawingStyle;
    property Enabled;
    property FixedColor;
    property FixedCols;
    property GradientEndColor default clSilver_400;
    property GradientStartColor default clSilver_50;
    property Font;
    property ImeMode;
    property ImeName;
    property Options;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property readonly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property TitleFont;
    property Touch;
    property Visible;
    property StyleElements;
    property StyleName;
    property ScrollBars;
    property OnCellClick;
    property OnColEnter;
    property OnColExit;
    property OnColumnMoved;
    property OnDrawColumnCell;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEditButtonClick;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGesture;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseActivate;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnStartDock;
    property OnStartDrag;
    property OnTitleClick;
  end;

type
  TLForm = class(TForm)
    FRegVars: TStringList;
    procedure SaveConfig;
    procedure LoadConfig;
  protected
    procedure DoCreate; override;
    procedure DoDestroy; override;
  private

  public
    property RegVars: TStringList read FRegVars write FRegVars;
  end;

procedure Register;

implementation

{ TLFolders }

procedure TLDBGrid.SetStyle(
  DataCol: Integer;
  Grid: TLDBGrid;
  Column: TColumn;
  State: TGridDrawState;
  SoortID: Integer;
  ID: Integer);
// ID bevat het categorie of subcategorienummer
// bij totalen of subtotalen bevat ID -1
begin
  // Style for descriptive column
  Grid.Canvas.Font.Style:= []; // Start met normale fontstyle

  if ID = -1 then // Totalen en Subtotalen rijen
    case SoortID of
      0: // Totalen en Subtotalen
        begin
          Grid.Canvas.Brush.Color:= FinAdmColors.clFooter;
          Grid.Canvas.Font.Color:= clWhite;
          Grid.Canvas.Font.Style:= [fsBold];
        end;
      1: // Inkomsten
        begin
          Grid.Canvas.Brush.Color:= FinAdmColors.clIncomeTotal;
          Grid.Canvas.Font.Color:= clWhite;
          Grid.Canvas.Font.Style:= [fsBold];
        end;
      2: // Vaste kosten
        begin
          Grid.Canvas.Brush.Color:= FinAdmColors.clFixedCostsTotal;
          Grid.Canvas.Font.Color:= clWhite;
          Grid.Canvas.Font.Style:= [fsBold];
        end;
      3: // Variabele kosten
        begin
          Grid.Canvas.Brush.Color:= FinAdmColors.clVariableCostsTotal;
          Grid.Canvas.Font.Color:= clWhite;
          Grid.Canvas.Font.Style:= [fsBold];
        end;
      4: // Aftrekbare kosten voor IB
        begin
          Grid.Canvas.Brush.Color:= FinAdmColors.clBelastingdienst;
          Grid.Canvas.Font.Color:= FinAdmColors.clBelastingdienstText;
          Grid.Canvas.Font.Style:= [fsBold];
        end;
    end // if ID = -1

  else // alle overige rijen
    begin

      if DataCol = 0 then // 1e kolom met omschrijvingen
        begin
          if not(gdSelected in State) then
            case SoortID of
              1:
                Grid.Canvas.Brush.Color:= FinAdmColors.clIncome;
              2:
                Grid.Canvas.Brush.Color:= FinAdmColors.clFixedCosts;
              3:
                Grid.Canvas.Brush.Color:= FinAdmColors.clVariableCosts;
            end // case SoortID
          else // if (gdSelected in State)
            case SoortID of
              0:
                begin
                  Grid.Canvas.Brush.Color:= FinAdmColors.clFooter;
                  Grid.Canvas.Font.Color:= clWhite;
                  Grid.Canvas.Font.Style:= [fsBold];
                end;
              1:
                begin
                  Grid.Canvas.Brush.Color:= FinAdmColors.clIncomeTotal;
                  Grid.Canvas.Font.Color:= clWhite;
                  Grid.Canvas.Font.Style:= [fsBold];
                end;
              2:
                begin
                  Grid.Canvas.Brush.Color:= FinAdmColors.clFixedCostsTotal;
                  Grid.Canvas.Font.Color:= clWhite;
                  Grid.Canvas.Font.Style:= [fsBold];
                end;
              3:
                begin
                  Grid.Canvas.Brush.Color:= FinAdmColors.clVariableCostsTotal;
                  Grid.Canvas.Font.Color:= clWhite;
                  Grid.Canvas.Font.Style:= [fsBold];
                end;
            end; // case SoortID
        end // if DataCol = 0

      else // if DataCol <> 0 alle overige kolommen met bedragen

        begin // default style actual values
          if not(gdSelected in State) then
            begin
              Grid.Canvas.Brush.Color:= FinAdmColors.clEmpty;
              Grid.Canvas.Font.Color:= FinAdmColors.clEmptyText;
            end // if not(gdSelected in State)
          else // if (gdSelected in State)
            begin
              Grid.Canvas.Brush.Color:= FinAdmColors.clSelected;
              Grid.Canvas.Font.Color:= clBlack;
            end; // if (gdSelected in State)
        end; // if DataCol <> 0
    end; // alle overige rijen
end;

function TLFolder.GetKnownFolderPath(const folderID: TGUID): string;
var
  pch: PChar;
begin
  if Succeeded(SHGetKnownFolderPath(folderID, 0, 0, pch)) then
    begin
      Result:= pch;
      CoTaskMemFree(pch);
    end
  else
    Result:= 'Error retrieving folder path';
end;

function TLFolder.GetDocuments: string;
begin
  Result:= GetKnownFolderPath(FOLDERID_Documents);
end;

function TLFolder.GetDesktop: string;
begin
  Result:= GetKnownFolderPath(FOLDERID_Desktop);
end;

function TLFolder.GetProgramData: string;
begin
  Result:= GetKnownFolderPath(FOLDERID_ProgramData);
end;

function TLFolder.GetLocalAppData: string;
begin
  Result:= GetKnownFolderPath(FOLDERID_LocalAppData);
end;

function TLFolder.GetPictures: string;
begin
  Result:= GetKnownFolderPath(FOLDERID_Pictures);
end;

function TLFolder.GetMusic: string;
begin
  Result:= GetKnownFolderPath(FOLDERID_Music);
end;

function TLFolder.GetVideos: string;
begin
  Result:= GetKnownFolderPath(FOLDERID_Videos);
end;

function TLFolder.GetDownLoads: string;
begin
  Result:= GetKnownFolderPath(FOLDERID_Downloads);
end;

function TLFolder.GetVersion: string;
var
  VerInfoSize: Cardinal;
  VerValueSize: Cardinal;
  Dummy: Cardinal;
  PVerInfo: Pointer;
  PVerValue: PVSFixedFileInfo;
begin
  Result:= ''; // Initialize the result

  // Get the size of the version information
  VerInfoSize:= GetFileVersionInfoSize(
    PChar(Application.ExeName),
    Dummy);
  if VerInfoSize > 0 then
    begin
      // Allocate memory for the version information
      GetMem(
        PVerInfo,
        VerInfoSize);
      try
        // Retrieve the version information
        if GetFileVersionInfo(PChar(Application.ExeName), 0, VerInfoSize, PVerInfo) then
          begin
            // Get the fixed file info
            if VerQueryValue(PVerInfo, '\', Pointer(PVerValue), VerValueSize) then
              begin
                Result:= IntToStr(DWORD(PVerValue.dwFileVersionMS) div $10000);
                Result:= Result + '.' + IntToStr(DWORD(PVerValue.dwFileVersionMS) mod $10000);
                Result:= Result + '.' + IntToStr(DWORD(PVerValue.dwFileVersionLS) div $10000);
                Result:= Result + '.' + IntToStr(DWORD(PVerValue.dwFileVersionLS) mod $10000);
              end;
          end;
      finally
        FreeMem(PVerInfo);
      end;
    end;
end;

{ TLDBGrid }

constructor TLDBGrid.Create(AOwner: TComponent);
begin
  inherited;
  Options:= [dgTitles, dgColLines, dgRowLines, dgRowSelect, dgAlwaysShowSelection];
end;

procedure TLDBGrid.CellClick(Column: TColumn);
begin
  if (Column.Field.DataType = ftSmallInt) then
    begin
      DataSource.DataSet.Edit;
      case Column.Field.Value of
        0:
          Column.Field.Value:= 1;
        1:
          Column.Field.Value:= 0;
      end;
      // DataSource.DataSet.Post;
      // Refresh;
    end;
  inherited;
end;

procedure TLDBGrid.ColEnter;
begin
  inherited;
  if SelectedField.DataType = ftSmallInt then
    Options:= Options - [dgEditing]
  else
    Options:= Options + [dgEditing]
end;

procedure TLDBGrid.ColExit;
begin
  inherited;
end;

procedure TLDBGrid.KeyDown(
  var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if Assigned(DataSource) and (SelectedField.DataType = ftSmallInt) and (Key = VK_SPACE) then
    begin
      DataSource.DataSet.Edit;
      case SelectedField.Value of
        0:
          SelectedField.AsInteger:= 1;
        1:
          SelectedField.AsInteger:= 0;
      end;
      // DataSource.DataSet.Post;
    end;
end;

procedure TLDBGrid.SetColumnAttr;
(* TFieldType = (ftUnknown, ftString, ftSmallint, ftInteger, ftWord, // 0..4
  ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime, // 5..11
  ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo, // 12..18
  ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar, ftWideString, // 19..24
  ftLargeint, ftADT, ftArray, ftReference, ftDataSet, ftOraBlob, ftOraClob, // 25..31
  ftVariant, ftInterface, ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd, // 32..37
  ftFixedWideChar, ftWideMemo, ftOraTimeStamp, ftOraInterval, // 38..41
  ftLongWord, ftShortint, ftByte, ftExtended, ftConnection, ftParams, ftStream, //42..48
  ftTimeStampOffset, ftObject, ftSingle); //49..51 *)
const
  MaxColumnWidth = 450;
var
  ColumnWidth, FieldNameWidth, FieldSizeWidth: Integer;
  FieldName: string;
  FieldSize: Integer;
begin
  if Assigned(DataSource) then
    begin
      for var i:= 0 to Columns.Count - 1 do
        begin
          Columns[i].Title.Font.Style:= [fsBold];
          Columns[i].Title.Alignment:= taCenter;

          FieldName:= DataSource.DataSet.FieldByName(Columns[i].FieldName).FieldName;
          FieldNameWidth:= Canvas.TextWidth(FieldName);
          FieldSize:= DataSource.DataSet.FieldByName(Columns[i].FieldName).Size;
          FieldSizeWidth:= FieldSize * Canvas.TextWidth('9');

          if FieldNameWidth > FieldSizeWidth then
            ColumnWidth:= FieldNameWidth
          else
            ColumnWidth:= FieldSizeWidth;
          if ColumnWidth > MaxColumnWidth then
            ColumnWidth:= MaxColumnWidth;

          case Columns[i].Field.DataType of
            ftFMTBcd, ftCurrency, ftBCD:
              begin
                TFloatField(DataSource.DataSet.FieldByName(Columns[i].FieldName)).DisplayFormat:=
                  '#,###,##0.00;-#,###,##0.00;-';
                Columns[i].Width:= MulDiv(
                  200,
                  PixelsPerInch,
                  DesignPPI);
              end;
            ftDate, ftTime:
              begin
                Columns[i].Alignment:= taRightJustify;
                Columns[i].Width:= MulDiv(
                  200,
                  PixelsPerInch,
                  DesignPPI);
              end;
            ftDateTime, ftTimeStamp:
              begin
                Columns[i].Alignment:= taRightJustify;
                Columns[i].Width:= MulDiv(
                  300,
                  PixelsPerInch,
                  DesignPPI);
              end;
            ftInteger, ftWord:
              begin
                TIntegerField(DataSource.DataSet.FieldByName(Columns[i].FieldName)).DisplayFormat:= '####0';
                if ColumnWidth < MulDiv(150, PixelsPerInch, DesignPPI) then
                  ColumnWidth:= MulDiv(
                    150,
                    PixelsPerInch,
                    DesignPPI);
                Columns[i].Width:= ColumnWidth;
              end;
            ftAutoInc:
              begin
                TIntegerField(DataSource.DataSet.FieldByName(Columns[i].FieldName)).DisplayFormat:= '####0';
                Columns[i].Width:= MulDiv(
                  150,
                  PixelsPerInch,
                  DesignPPI);
              end
            else
              Columns[i].Width:= ColumnWidth;
          end;
        end;
    end;
end;

procedure TLDBGrid.DrawColumnCell(
  const Rect: TRect;
  DataCol: Integer;
  Column: TColumn;
  State: TGridDrawState);
const
  CtrlState: array [boolean] of Integer = (DFCS_BUTTONCHECK, DFCS_BUTTONCHECK or DFCS_CHECKED);
  CtrlStateXP: array [boolean] of TThemedButton = (tbCheckBoxUncheckedNormal, tbCheckBoxCheckedNormal);
var
  R: TRect;
  Details: TThemedElementDetails;
begin
  if Assigned(OnDrawColumnCell) then
    OnDrawColumnCell(
      Self,
      Rect,

      DataCol,
      Column,
      State);

  // Cell padding
  R:= Rect;
  InflateRect(
    R,
    MulDiv(-10, PixelsPerInch, DesignPPI),
    0);

  Canvas.FillRect(Rect);

  case Column.Field.DataType of
    ftSmallInt:
      begin
        R:= Rect;
        InflateRect(
          R,
          MulDiv(-10, PixelsPerInch, DesignPPI),
          MulDiv(-5, PixelsPerInch, DesignPPI));

        if (VarIsNull(Column.Field.Value)) then
          Column.Field.AsInteger:= 0;

        if StyleServices.Enabled then
          begin
            case Column.Field.AsInteger of
              0:
                begin
                  if Column.Field.FieldName = 'IB Aftrekbaar' then
                    begin
                      if (gdSelected in State) then
                        Canvas.Brush.Color:= clPeter_river_200
                      else
                        Canvas.Brush.Color:= clPeter_river_50
                    end
                  else
                    begin
                      if (gdSelected in State) then
                        Canvas.Brush.Color:= clOrange_200
                      else
                        Canvas.Brush.Color:= clOrange_50;
                    end;
                  Canvas.FillRect(Rect);
                  Details:= StyleServices.GetElementDetails(CtrlStateXP[False]);
                  StyleServices.DrawElement(
                    Canvas.Handle,
                    Details,
                    R,
                    nil,
                    FCurrentPPI);
                end;
              1:
                begin
                  if Column.Field.FieldName = 'IB Aftrekbaar' then
                    begin
                      if (gdSelected in State) then
                        Canvas.Brush.Color:= clPeter_river_200
                      else
                        Canvas.Brush.Color:= clPeter_river_100
                    end
                  else
                    begin
                      if (gdSelected in State) then
                        Canvas.Brush.Color:= clOrange_200
                      else
                        Canvas.Brush.Color:= clOrange_100;
                    end;
                  Canvas.FillRect(Rect);
                  Details:= StyleServices.GetElementDetails(CtrlStateXP[TRUE]);
                  StyleServices.DrawElement(
                    Canvas.Handle,
                    Details,
                    R,
                    nil,
                    FCurrentPPI);
                end;
            end;
          end

        else

          begin
            case Column.Field.AsInteger of
              0:
                begin
                  Canvas.Brush.Color:= clBtnFace;
                  Canvas.FillRect(R);
                  DrawFrameControl(
                    Canvas.Handle,
                    Rect,
                    DFC_BUTTON,
                    CtrlState[False]);
                end;
              1:
                begin
                  if Column.Field.FieldName = 'IB Aftrekbaar' then
                    Canvas.Brush.Color:= clGradientInactiveCaption
                  else
                    Canvas.Brush.Color:= $CCCCFF;
                  Canvas.FillRect(R);
                  DrawFrameControl(
                    Canvas.Handle,
                    Rect,
                    DFC_BUTTON,
                    CtrlState[TRUE]);
                end;
            end;

          end;
      end;

    ftFMTBcd, ftFloat:
      begin
        if (Column.Field.Value > 0) then
          if gdSelected in State then
            begin
              Canvas.Font.Color:= clSelectedPositiveText;
              Canvas.Brush.Color:= clSelectedPositive;
              Canvas.Font.Style:= [fsBold];
            end
          else
            begin
              Canvas.Font.Color:= FinAdmColors.clPositiveText;
              Canvas.Brush.Color:= FinAdmColors.clPositive;
            end;
        Canvas.FillRect(Rect);
        DefaultDrawColumnCell(
          R,
          DataCol,
          Column,
          State);
      end;

    else
      DefaultDrawColumnCell(R, DataCol, Column, State);
  end;

  begin

    // Draw the custom gridline
    Canvas.Pen.Color:= clWhite;
    Canvas.MoveTo(
      Rect.Left,
      Rect.Bottom - 1);
    Canvas.LineTo(
      Rect.Right,
      Rect.Bottom - 1);
    Canvas.MoveTo(
      Rect.Right - 1,
      Rect.Top);
    Canvas.LineTo(
      Rect.Right - 1,
      Rect.Bottom);
  end;
end;

{ TLForm }

procedure TLForm.DoCreate;
begin
  Self.FRegVars:= TStringList.Create;
  inherited;
  Self.LoadConfig;
end;

procedure TLForm.DoDestroy;
begin
  inherited;
  Self.SaveConfig;
  Self.FRegVars.Free;
end;

procedure TLForm.SaveConfig;
var
  reg: TRegistry;
  Key, Value: string;
  i: Integer;
begin
  reg:= TRegistry.Create(KEY_WRITE);
  try
    reg.RootKey:= HKEY_CURRENT_USER;
    if reg.OpenKey('Software\Langstraat\' + Application.Title + '\' + Self.Name, TRUE) then
      begin
        // Write standard values of TLForm to registry
        if WindowState <> wsMaximized then
          begin
            reg.WriteInteger(
              'Top',
              Round(Self.Top / (PixelsPerInch / 96)));
            reg.WriteInteger(
              'Left',
              Round(Self.Left / (PixelsPerInch / 96)));
            reg.WriteInteger(
              'Height',
              Round(Self.Height / (PixelsPerInch / 96)));
            reg.WriteInteger(
              'Width',
              Round(Self.Width / (PixelsPerInch / 96)));
          end;
        reg.WriteBool(
          'WindowState',
          Self.WindowState = wsMaximized);
        // Write custom values to registry
        for i:= 0 to FRegVars.Count - 1 do
          begin
            Key:= FRegVars.Names[i];
            Value:= FRegVars.Values[Key];
            reg.WriteString(
              Key,
              Value);
          end;
        reg.CloseKey;
      end;
  finally
    reg.Free;
  end;
end;

procedure TLForm.LoadConfig;
var
  reg: TRegistry;
  Key, Value: string;
  i: Integer;
begin
  reg:= TRegistry.Create(KEY_READ);
  try
    reg.RootKey:= HKEY_CURRENT_USER;
    if reg.OpenKeyReadOnly('Software\Langstraat\' + Application.Title + '\' + Self.Name) then
      begin
        // Read standard values of TLForm from registry
        if reg.ValueExists('Top') then
          Self.Top:= MulDiv(
            reg.ReadInteger('Top'),
            PixelsPerInch,
            96);
        if reg.ValueExists('Left') then
          Self.Left:= MulDiv(
            reg.ReadInteger('Left'),
            PixelsPerInch,
            96);
        if reg.ValueExists('Height') then
          Self.Height:= MulDiv(
            reg.ReadInteger('Height'),
            PixelsPerInch,
            96);
        if reg.ValueExists('Width') then
          Self.Width:= MulDiv(
            reg.ReadInteger('Width'),
            PixelsPerInch,
            96);
        if reg.ValueExists('WindowState') then
          case reg.ReadBool('WindowState') of
            TRUE:
              Self.WindowState:= wsMaximized;
            False:
              Self.WindowState:= wsNormal;
          end;
        // Read custom values from registry
        for i:= 0 to FRegVars.Count - 1 do
          begin
            Key:= FRegVars.Names[i];
            Value:= FRegVars.Values[Key];
            if reg.ValueExists(Key) then
              begin
                Value:= reg.ReadString(Key);
                FRegVars.Values[Key]:= Value;
              end;
          end;
        reg.CloseKey;
      end;
  finally
    reg.Free;
  end;
end;

procedure Register;
begin
  RegisterComponents(
    'TL',
    [TLDBGrid]);
end;

initialization

Folder:= TLFolder.Create;

finalization

FreeAndNil(Folder);

end.