From f22ad2a5da8d4a39a460219f0ac2dbbe0414d2c5 Mon Sep 17 00:00:00 2001 From: r57zone Date: Sun, 31 Mar 2024 14:32:00 +0400 Subject: [PATCH] UI improvement: ListBox to ListView --- Source/Unit1.dfm | 83 +++++++++++++----------------------- Source/Unit1.pas | 108 +++++++++++++++++++++++++---------------------- 2 files changed, 88 insertions(+), 103 deletions(-) diff --git a/Source/Unit1.dfm b/Source/Unit1.dfm index 14b8f57..32e9daa 100644 --- a/Source/Unit1.dfm +++ b/Source/Unit1.dfm @@ -21,39 +21,13 @@ object Main: TMain OnShow = FormShow PixelsPerInch = 96 TextHeight = 13 - object NameAppLbl: TLabel - Left = 9 - Top = 8 - Width = 50 - Height = 13 - Caption = #1053#1072#1079#1074#1072#1085#1080#1077 - Font.Charset = RUSSIAN_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - ParentFont = False - end - object AppPathLbl: TLabel - Left = 160 - Top = 8 - Width = 75 - Height = 13 - Caption = #1056#1072#1089#1087#1086#1083#1086#1078#1077#1085#1080#1077 - Font.Charset = RUSSIAN_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - ParentFont = False - end object AddBtn: TButton Left = 7 Top = 271 Width = 75 Height = 25 Caption = #1044#1086#1073#1072#1074#1080#1090#1100 - TabOrder = 2 + TabOrder = 1 OnClick = AddBtnClick end object RemBtn: TButton @@ -62,7 +36,7 @@ object Main: TMain Width = 75 Height = 25 Caption = #1059#1076#1072#1083#1080#1090#1100 - TabOrder = 3 + TabOrder = 2 OnClick = RemBtnClick end object CheckBtn: TButton @@ -71,37 +45,16 @@ object Main: TMain Width = 75 Height = 25 Caption = #1055#1088#1086#1074#1077#1088#1080#1090#1100' ' - TabOrder = 4 + TabOrder = 3 OnClick = CheckBtnClick end - object ListBox: TListBox - Left = 8 - Top = 24 - Width = 393 - Height = 217 - Font.Charset = RUSSIAN_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - ItemHeight = 13 - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 0 - TabWidth = 100 - OnDblClick = ListBoxDblClick - OnKeyDown = ListBoxKeyDown - OnKeyUp = ListBoxKeyUp - OnMouseDown = ListBoxMouseDown - end object FirewallBtn: TButton Left = 247 Top = 271 Width = 75 Height = 25 Caption = #1041#1088#1072#1085#1076#1084#1072#1091#1101#1088 - TabOrder = 5 + TabOrder = 4 OnClick = FirewallBtnClick end object CloseBtn: TButton @@ -110,7 +63,7 @@ object Main: TMain Width = 75 Height = 25 Caption = #1042#1099#1093#1086#1076 - TabOrder = 6 + TabOrder = 5 OnClick = CloseBtnClick end object SearchEdt: TEdit @@ -124,7 +77,7 @@ object Main: TMain Font.Name = 'MS Sans Serif' Font.Style = [] ParentFont = False - TabOrder = 1 + TabOrder = 0 Text = #1055#1086#1080#1089#1082'...' OnChange = SearchEdtChange OnKeyDown = SearchEdtKeyDown @@ -139,6 +92,30 @@ object Main: TMain Panels = <> SimplePanel = True end + object ListView: TListView + Left = 8 + Top = 8 + Width = 393 + Height = 233 + Columns = < + item + Caption = #1053#1072#1079#1074#1072#1085#1080#1077 + Width = 176 + end + item + Caption = #1056#1072#1089#1087#1086#1083#1086#1078#1077#1085#1080#1077 + Width = 194 + end> + HideSelection = False + ReadOnly = True + RowSelect = True + TabOrder = 7 + ViewStyle = vsReport + OnDblClick = ListViewDblClick + OnKeyDown = ListViewKeyDown + OnKeyUp = ListViewKeyUp + OnMouseDown = ListViewMouseDown + end object OpenDialog: TOpenDialog Filter = '|*.exe' Left = 48 diff --git a/Source/Unit1.pas b/Source/Unit1.pas index 758e68c..372bafc 100644 --- a/Source/Unit1.pas +++ b/Source/Unit1.pas @@ -11,12 +11,9 @@ TMain = class(TForm) AddBtn: TButton; RemBtn: TButton; CheckBtn: TButton; - ListBox: TListBox; FirewallBtn: TButton; CloseBtn: TButton; OpenDialog: TOpenDialog; - NameAppLbl: TLabel; - AppPathLbl: TLabel; SearchEdt: TEdit; StatusBar: TStatusBar; ImportDialog: TOpenDialog; @@ -27,6 +24,7 @@ TMain = class(TForm) ExportBtn: TMenuItem; HelpItem: TMenuItem; AboutBtn: TMenuItem; + ListView: TListView; procedure AddBtnClick(Sender: TObject); procedure RemBtnClick(Sender: TObject); procedure FirewallBtnClick(Sender: TObject); @@ -38,22 +36,22 @@ TMain = class(TForm) Shift: TShiftState; X, Y: Integer); procedure SearchEdtChange(Sender: TObject); procedure FormShow(Sender: TObject); - procedure ListBoxKeyUp(Sender: TObject; var Key: Word; - Shift: TShiftState); procedure SearchEdtKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); - procedure ListBoxKeyDown(Sender: TObject; var Key: Word; - Shift: TShiftState); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); - procedure ListBoxDblClick(Sender: TObject); - procedure ListBoxMouseDown(Sender: TObject; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); procedure SearchEdtKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure ImportBtnClick(Sender: TObject); procedure ExportBtnClick(Sender: TObject); procedure AboutBtnClick(Sender: TObject); + procedure ListViewMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure ListViewKeyUp(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure ListViewDblClick(Sender: TObject); + procedure ListViewKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); protected procedure WMDropFiles (var Msg: TMessage); message WM_DropFiles; private @@ -187,9 +185,9 @@ procedure TMain.AddBtnClick(Sender: TObject); procedure TMain.RemBtnClick(Sender: TObject); begin - if ListBox.ItemIndex <> - 1 then begin - StatusBar.SimpleText:=' ' + Format(ID_RULE_SUCCESSFULLY_REMOVED, [CutStr(ExtractFileName(RulePaths.Strings[ListBox.ItemIndex]), 22)]); //После удаления названия уже не будет, поэтому перед удалением - RemoveAppRules(RuleNames.Strings[ListBox.ItemIndex]); + if ListView.ItemIndex <> - 1 then begin + StatusBar.SimpleText:=' ' + Format(ID_RULE_SUCCESSFULLY_REMOVED, [CutStr(ExtractFileName(RulePaths.Strings[ListView.ItemIndex]), 22)]); //После удаления названия уже не будет, поэтому перед удалением + RemoveAppRules(RuleNames.Strings[ListView.ItemIndex]); end else StatusBar.SimpleText:=' ' + ID_CHOOSE_RULE; end; @@ -239,10 +237,11 @@ procedure TMain.LoadRegRules; Reg : TRegistry; SubKeyNames: TStringList; RegName: string; + Item: TListItem; begin RuleNames.Clear; RulePaths.Clear; - ListBox.Clear; + ListView.Clear; Rules:=TStringList.Create; Reg:=TRegistry.Create; @@ -259,7 +258,9 @@ procedure TMain.LoadRegRules; RegName:=Copy(RegName, 1, Pos('|', RegName) - 1); RegName:=Copy(RegName, 1, Pos('_UDP_', RegName) - 1); RuleNames.Add(RegName); - ListBox.Items.Add(CutStr(ExtractFileName(RulePaths.Strings[RulePaths.Count - 1]), 23) + ^I + CutStr(RulePaths.Strings[RulePaths.Count - 1], 38)); + Item:=Main.ListView.Items.Add; + Item.Caption:=ExtractFileName(RulePaths.Strings[RulePaths.Count - 1]); + Item.SubItems.Add(RulePaths.Strings[RulePaths.Count - 1]); end; end; Reg.CloseKey; @@ -303,9 +304,8 @@ procedure TMain.FormCreate(Sender: TObject); ID_ABOUT:=Ini.ReadString('Main', 'ID_ABOUT', ''); AboutBtn.Caption:=ID_ABOUT; - - NameAppLbl.Caption:=Ini.ReadString('Main', 'ID_APP_NAME', ''); - AppPathLbl.Caption:=Ini.ReadString('Main', 'ID_APP_PATH', ''); + ListView.Columns[0].Caption:=Ini.ReadString('Main', 'ID_APP_NAME', ''); + ListView.Columns[1].Caption:=Ini.ReadString('Main', 'ID_APP_PATH', ''); ID_SEARCH:=Ini.ReadString('Main', 'ID_SEARCH', ''); SearchEdt.Text:=ID_SEARCH; @@ -390,19 +390,19 @@ procedure TMain.CheckBtnClick(Sender: TObject); procedure TMain.FormShow(Sender: TObject); begin - ListBox.SetFocus; + ListView.SetFocus; if CloseDuplicate then Close; end; -procedure TMain.ListBoxKeyUp(Sender: TObject; var Key: Word; +procedure TMain.ListViewKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin - if ListBox.ItemIndex = -1 then Exit; - StatusBar.SimpleText:=' ' + CutStr(RulePaths.Strings[ListBox.ItemIndex], 62); + if ListView.ItemIndex = -1 then Exit; + StatusBar.SimpleText:=' ' + CutStr(RulePaths.Strings[ListView.ItemIndex], 62); if Key = VK_DELETE then RemBtn.Click - else if (Key = VK_RETURN) and (FileExists(RulePaths.Strings[ListBox.ItemIndex])) then - ShellExecute(0, 'open', 'explorer', PChar('/select, "' + RulePaths.Strings[ListBox.ItemIndex] + '"'), nil, SW_SHOW); + else if (Key = VK_RETURN) and (FileExists(RulePaths.Strings[ListView.ItemIndex])) then + ShellExecute(0, 'open', 'explorer', PChar('/select, "' + RulePaths.Strings[ListView.ItemIndex] + '"'), nil, SW_SHOW); end; procedure TMain.WMCopyData(var Msg: TWMCopyData); @@ -415,7 +415,7 @@ procedure TMain.WMCopyData(var Msg: TWMCopyData); Msg.Result:=Integer(True); end; -procedure TMain.ListBoxKeyDown(Sender: TObject; var Key: Word; +procedure TMain.ListViewKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin // Убираем баг скрытия контролов @@ -431,43 +431,37 @@ procedure TMain.FormKeyDown(Sender: TObject; var Key: Word; Key:=0; end; -procedure TMain.ListBoxDblClick(Sender: TObject); +procedure TMain.ListViewDblClick(Sender: TObject); begin - if ListBox.ItemIndex = -1 then Exit; - if FileExists(RulePaths.Strings[ListBox.ItemIndex]) then - ShellExecute(0, 'open', 'explorer', PChar('/select, "' + RulePaths.Strings[ListBox.ItemIndex] + '"'), nil, SW_SHOW); + if ListView.ItemIndex = -1 then Exit; + if FileExists(RulePaths.Strings[ListView.ItemIndex]) then + ShellExecute(0, 'open', 'explorer', PChar('/select, "' + RulePaths.Strings[ListView.ItemIndex] + '"'), nil, SW_SHOW); end; -procedure TMain.ListBoxMouseDown(Sender: TObject; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); +procedure ScrollToListViewItem(LV: TListview; ItemIndex: Integer); +var + R: TRect; begin - // Сбрасываем индекс, если попадаем в пустую область - ListBox.ItemIndex:=ListBox.ItemAtPos(Point(X, Y), true); - - if ListBox.ItemIndex <> -1 then - StatusBar.SimpleText:=' ' + CutStr(RulePaths.Strings[ListBox.ItemIndex], 62) - else - StatusBar.SimpleText:=' '; - - if SearchEdt.Text = '' then begin - SearchEdt.Font.Color:=clGray; - SearchEdt.Text:=ID_SEARCH; - end; + R:=LV.Items[ItemIndex].DisplayRect(drBounds); + LV.Scroll(0, R.Top - LV.ClientHeight div 2); end; procedure TMain.SearchEdtChange(Sender: TObject); var i: integer; begin - if ListBox.Count = 0 then Exit; - ListBox.ItemIndex:=-1; + if ListView.Items.Count = 0 then Exit; + ListView.ItemIndex:=-1; for i:=0 to RuleNames.Count - 1 do if Pos(AnsiLowerCase(SearchEdt.Text), AnsiLowerCase(RuleNames.Strings[i])) > 0 then begin - ListBox.ItemIndex:=i; + + ScrollToListViewItem(ListView, i); + //ListView.ItemIndex:=i; + ListView.Items.Item[i].Selected:=true; Break; end; - if ListBox.ItemIndex <> -1 then - StatusBar.SimpleText:=' ' + CutStr(RulePaths.Strings[ListBox.ItemIndex], 63) + if ListView.ItemIndex <> -1 then + StatusBar.SimpleText:=' ' + CutStr(RulePaths.Strings[ListView.ItemIndex], 63) else StatusBar.SimpleText:=' '; end; @@ -533,10 +527,24 @@ procedure TMain.ExportBtnClick(Sender: TObject); procedure TMain.AboutBtnClick(Sender: TObject); begin - Application.MessageBox(PChar(Caption + ' 0.7' + #13#10 + - ID_LAST_UPDATE + ' 20.05.2022' + #13#10 + + Application.MessageBox(PChar(Caption + ' 0.7.1' + #13#10 + + ID_LAST_UPDATE + ' 31.03.2024' + #13#10 + 'https://r57zone.github.io' + #13#10 + 'r57zone@gmail.com'), PChar(ID_ABOUT), MB_ICONINFORMATION); end; +procedure TMain.ListViewMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + if ListView.ItemIndex <> -1 then + StatusBar.SimpleText:=' ' + CutStr(RulePaths.Strings[ListView.ItemIndex], 62) + else + StatusBar.SimpleText:=' '; + + if SearchEdt.Text = '' then begin + SearchEdt.Font.Color:=clGray; + SearchEdt.Text:=ID_SEARCH; + end; +end; + end.