-
Notifications
You must be signed in to change notification settings - Fork 0
/
unit_listbox.pas
178 lines (146 loc) · 6.01 KB
/
unit_listbox.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
unit unit_listbox;
{ On-screen keyboard with find object data function}
{ interface via global variables.}
{ Key functionality:
ESC --> close form with object_found=false
Enter --> find object, if not found show list of designations containing the input string
e.g. ngc2024 leave form with ngc2024 data. Object_found=true
ngc list all NGC objects
ngc 2024 list ngc2024 in the list
ngc10 leave form with ngc10 data. Object_found=true
ngc 10 list all objects containing ngc10 as ngc100, ngc1000, ngc1001...
ngc10* list all objects containing ngc10 as ngc100, ngc1000, ngc1001...
close form --> 2024 leave form with ngc2024 data if ngc was selected. Object_found=true
ngc2024 leave form with ngc2024 data. Object_found=true
abcdef leave form with abcdef designation. Object_found=false
}
{Copyright (C) 2017, 2024 by Han Kleijn, www.hnsky.org
email: han.k.. at...hnsky.org
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 https://mozilla.org/MPL/2.0/. }
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons,
unit_annotation {for deepsky database search};
type
{Tform_listbox1 }
Tform_listbox1 = class(TForm)
cancel1: TBitBtn;
ok1: TButton;
keyboard_question1: TLabel;
ListBox1: TListBox;
Edit1: TEdit;
procedure cancel1Click(Sender: TObject);
procedure ok1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormKeyPress(Sender: TObject; var Key: char);
procedure FormShow(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure ListBox1DblClick(Sender: TObject);
private
public
end;
var
form_listbox1: Tform_listbox1;
{global variables as interface}
keyboard_text : string;
object_found : boolean;
ra_data,dec_data, length_data, width_data, pa_data : double;
implementation
{$R *.lfm}
{ Tform_listbox1 }
uses
astap_main;
procedure Tform_listbox1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
var
dummy : double;
error2: integer;
begin
if object_found=false then {form was closed by user. Initiate find action}
begin
keyboard_text:=edit1.text;
object_found:=find_object(keyboard_text ,ra_data,dec_data,length_data,width_data,pa_data);{keyboard_text with length less then 2 will be ignored}
end;
end;
procedure Tform_listbox1.FormKeyPress(Sender: TObject; var Key: char);
begin
if key=#27 {esc } then form_listbox1.close; {leave form}
if key=#13 {enter} then ok1click(Sender); {enter}
end;
procedure Tform_listbox1.FormShow(Sender: TObject);
begin
object_found:=false;
edit1.text:=keyboard_text;
end;
procedure Tform_listbox1.ListBox1Click(Sender: TObject);
begin
if (listbox1.itemindex)>=0 then {prevent error if nothing is selected}
edit1.text:=listbox1.Items[listbox1.itemindex];{copy selection to edit }
end;
procedure Tform_listbox1.ListBox1DblClick(Sender: TObject);
begin
if (listbox1.itemindex)>=0 then {prevent error if nothing is selected}
begin
keyboard_text:=listbox1.Items[listbox1.itemindex];{copy selection to edit }
if find_object(keyboard_text ,ra_data,dec_data,length_data,width_data,pa_data) {find object in unit u_annotation} then
begin
object_found:=true;
form_listbox1.close;
end
end;
end;
procedure fill_listbox(filterstr: string); {fill listbox with destinations containing the filterstr}
var
ra0,dec0,length0,width0,pa : double; {dummies, not used}
begin
load_deep;{Load the deepsky database once. If already loaded, no action}
linepos:=2;{Set pointer to the beginning}
with form_listbox1 do
begin
if length(filterstr)>1 then
begin
listbox1.Clear; { empty the list of any old values }
while read_deepsky('T' {full database search} ,0 {ra},0 {dec},1 {cos(telescope_dec)},2*pi{fov},{var} ra0,dec0,length0,width0,pa) {Deepsky database search} do
begin
if ((length(filterstr)=0) or (pos(filterstr,uppercase(naam2))>0)) then
listbox1.Items.Add(naam2);
if ((length(naam3)>0) and (((length(filterstr)=0) or (pos(filterstr,uppercase(naam3))>0)))) then
listbox1.Items.Add(naam3);
if ((length(naam4)>0) and (((length(filterstr)=0) or (pos(filterstr,uppercase(naam4))>0)))) then
listbox1.Items.Add(naam4);
end;{while loop}
edit1.text:='';{clear filtering}
ActiveControl:=listbox1;{set focus on listbox1 text window}
end;
end;
end;
procedure Tform_listbox1.ok1Click(Sender: TObject);
begin
Screen.Cursor:=crHourglass;{$IfDef Darwin}{$else}application.processmessages;{$endif}// Show hourglass cursor, processmessages is for Linux. Note in MacOS processmessages disturbs events keypress for lv_left, lv_right key
keyboard_text:=edit1.text;
if find_object(keyboard_text ,ra_data,dec_data,length_data,width_data,pa_data) {find object in unit u_annotation} then
begin
object_found:=true;
form_listbox1.close;
end
else
begin {keyboard_text with length less then 2 or not found}
if decode_string(keyboard_text,ra_data,dec_data) {convert a string to position succesfull} then
begin
object_found:=true;
form_listbox1.close;
end;
keyboard_text:=StringReplace(uppercase(keyboard_text), ' ', '',[rfReplaceAll]);{replace all space and make upcase}
keyboard_text:=StringReplace(keyboard_text, '*', '',[rfReplaceAll]);{remove wildchard}
fill_listbox(keyboard_text);{fill listbox with suggestions}
end;
Screen.Cursor:=crDefault;
end;
procedure Tform_listbox1.cancel1Click(Sender: TObject);
begin
object_found:=false;
form_listbox1.close;
end;
end.