<commit_before>(*
This Source Code Form is subject to the terms of the Mozilla Public
License, v. 2.0. If a copy of the MPL was not distributed with this
file, You can obtain one at http://mozilla.org/MPL/2.0/.

Copyright (c) <NAME>
*)
unit form_menu_list;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  LclType, LclProc, StrUtils,
  ExtCtrls,
  ATStringProc,
  ATSynEdit,
  ATListbox,
  proc_globdata,
  proc_colors,
  proc_scrollbars;

type
  TAppListSelectEvent = procedure(AIndex: integer; const AStr: string) of object;

type
  { TfmMenuList }

  TfmMenuList = class(TForm)
    List: TATListbox;
    plCaption: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormShow(Sender: TObject);
    procedure ListDrawItem(Sender: TObject; C: TCanvas; AIndex: integer;
      const ARect: TRect);
    procedure ListClick(Sender: TObject);
  private
    FColorBg: TColor;
    FColorBgSel: TColor;
    FColorFont: TColor;
    FColorFontSel: TColor;
    FColorFontAlt: TColor;
    FOnListSelect: TAppListSelectEvent;
    procedure SetListCaption(const AValue: string);
    procedure DoListChangedSel(Sender: TObject);
    procedure UpdateColors;
    { private declarations }
  public
    { public declarations }
    InitialItemIndex: integer;
    ResultIndex: integer;
    Items: TStringlist;
    CloseOnCtrlRelease: boolean;
    property OnListSelect: TAppListSelectEvent read FOnListSelect write FOnListSelect;
  end;

var
  fmMenuList: TfmMenuList;

implementation

{$R *.lfm}

{ TfmMenuList }

procedure TfmMenuList.FormShow(Sender: TObject);
begin
  SetListCaption(Caption);
  UpdateFormOnTop(Self);
  List.VirtualItemCount:= Items.Count;
  List.ItemIndex:= InitialItemIndex;
end;

procedure TfmMenuList.ListDrawItem(Sender: TObject; C: TCanvas; AIndex: integer;
  const ARect: TRect);
var
  pnt: TPoint;
  str0, str1, str2: string;
  NColorFont, NColorBack: TColor;
begin
  str0:= Items[AIndex];
  str1:= SGetItem(str0, #9);
  str2:= str0;<commit_msg>optimize paint MenuList<commit_after>(*
This Source Code Form is subject to the terms of the Mozilla Public
License, v. 2.0. If a copy of the MPL was not distributed with this
file, You can obtain one at http://mozilla.org/MPL/2.0/.

Copyright (c) <NAME>
*)
unit form_menu_list;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  LclType, LclProc, StrUtils,
  ExtCtrls,
  ATStringProc,
  ATSynEdit,
  ATListbox,
  proc_globdata,
  proc_colors,
  proc_scrollbars;

type
  TAppListSelectEvent = procedure(AIndex: integer; const AStr: string) of object;

type
  { TfmMenuList }

  TfmMenuList = class(TForm)
    List: TATListbox;
    plCaption: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormShow(Sender: TObject);
    procedure ListDrawItem(Sender: TObject; C: TCanvas; AIndex: integer;
      const ARect: TRect);
    procedure ListClick(Sender: TObject);
  private
    FColorBg: TColor;
    FColorBgSel: TColor;
    FColorFont: TColor;
    FColorFontSel: TColor;
    FColorFontAlt: TColor;
    FOnListSelect: TAppListSelectEvent;
    procedure SetListCaption(const AValue: string);
    procedure DoListChangedSel(Sender: TObject);
    procedure UpdateColors;
    { private declarations }
  public
    { public declarations }
    InitialItemIndex: integer;
    ResultIndex: integer;
    Items: TStringlist;
    CloseOnCtrlRelease: boolean;
    property OnListSelect: TAppListSelectEvent read FOnListSelect write FOnListSelect;
  end;

var
  fmMenuList: TfmMenuList;

implementation

{$R *.lfm}

{ TfmMenuList }

procedure TfmMenuList.FormShow(Sender: TObject);
begin
  SetListCaption(Caption);
  UpdateFormOnTop(Self);
  List.VirtualItemCount:= Items.Count;
  List.ItemIndex:= InitialItemIndex;
end;

procedure TfmMenuList.ListDrawItem(Sender: TObject; C: TCanvas; AIndex: integer;
  const ARect: TRect);
var
  pnt: TPoint;
  str1, str2: string;
  NColorFont, NColorBack: TColor;
begin
  SSplitByChar(Items[AIndex], #9, str1, str2);
{'fraction_non_alphanumeric': 0.0927137378750282, 'fraction_numerical': 0.004962779156327543, 'mean_word_length': 4.508074534161491, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 5, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5965329', 'n_tokens_mistral': 1534, 'n_tokens_neox': 1468, 'n_words': 407}