File: unit_listbox.pas

package info (click to toggle)
astap 2024.11.13-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 7,032 kB
  • sloc: pascal: 49,240; sh: 205; makefile: 5
file content (178 lines) | stat: -rw-r--r-- 6,156 bytes parent folder | download | duplicates (2)
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.