{ Form Template - Source and Destination Choices Lists }
unit Setplace;

interface

uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,
  StdCtrls, DB, DBTables, inputdat, Dialogs;

type
  TDualListDlg = class(TForm)
    OKBtn: TBitBtn;
    CancelBtn: TBitBtn;
    SrcList: TListBox;
    DstList: TListBox;
    SrcLabel: TLabel;
    DstLabel: TLabel;
    IncludeBtn: TSpeedButton;
    IncAllBtn: TSpeedButton;
    ExcludeBtn: TSpeedButton;
    ExAllBtn: TSpeedButton;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    OpenDialog1: TOpenDialog;
    procedure IncludeBtnClick(Sender: TObject);
    procedure ExcludeBtnClick(Sender: TObject);
    procedure IncAllBtnClick(Sender: TObject);
    procedure ExcAllBtnClick(Sender: TObject);
    procedure MoveSelected(List: TCustomListBox; Items: TStrings);
    procedure SetItem(List: TListBox; Index: Integer);
    procedure DeleteSelected(List: TCustomListBox);
    function item_include(Item:string;Items:TStrings):Boolean;
    function GetFirstSelection(List: TCustomListBox): Integer;
    procedure SetButtons;
    procedure OKBtnClick(Sender: TObject);
    procedure CancelBtnClick(Sender: TObject);
    procedure HelpBtnClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure RefreshList;
    procedure Button3Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  DualListDlg: TDualListDlg;

implementation

uses indpoint;

{$R *.DFM}

procedure TDualListDlg.IncludeBtnClick(Sender: TObject);
var
  Index: Integer;
begin
  Index := GetFirstSelection(SrcList);
  MoveSelected(SrcList, DstList.Items);
  SetItem(SrcList, Index);
end;

procedure TDualListDlg.ExcludeBtnClick(Sender: TObject);
var
  Index: Integer;
begin
  Index := GetFirstSelection(DstList);
  DeleteSelected(DstList);
  SetItem(DstList, Index);
end;

procedure TDualListDlg.IncAllBtnClick(Sender: TObject);
var
  I: Integer;
  n: integer;
  cad: string;
begin
  n:=SrcList.Items.Count;
  if (n+DstList.Items.count) > 1000 then n:=1000-DstList.Items.count;
  for I := 0 to n - 1 do
  begin
   cad:=SrcList.Items[I];
   {if not item_include(cad,DstList.items) then}
    DstList.Items.Add(cad);
  end;
  SetButtons;
end;

procedure TDualListDlg.ExcAllBtnClick(Sender: TObject);
begin
  DstList.Items.Clear;
  SetItem(DstList, 0);
end;

function TDualListDlg.item_include(item:string;Items:TStrings):Boolean;
 var
 I:integer;
begin
 I:=0;
 while (I<Items.count) and (Items[I]<>item) do
  inc(I);
 if I=Items.count then
 Result:=False
 else
 Result:=True;
end;

procedure TDualListDlg.MoveSelected(List: TCustomListBox; Items: TStrings);
var
  I: Integer;
begin
  for I := List.Items.Count - 1 downto 0 do
    if List.Selected[I] then
     if not item_include(List.Items[I],items)  then begin
      DstList.Items.AddObject(SrcList.Items[I],SrcList.Items.Objects[I]);
     end;
end;

procedure TDualListDlg.DeleteSelected(List: TCustomListBox);
var
  I: Integer;
begin
  for I := List.Items.Count - 1 downto 0 do
    if List.Selected[I] then
      List.Items.Delete(I);
end;

procedure TDualListDlg.SetButtons;
var
  SrcEmpty, DstEmpty: Boolean;
begin
  SrcEmpty := SrcList.Items.Count = 0;
  DstEmpty := DstList.Items.Count = 0;
  IncludeBtn.Enabled := not SrcEmpty;
  IncAllBtn.Enabled := not SrcEmpty;
  ExcludeBtn.Enabled := not DstEmpty;
  ExAllBtn.Enabled := not DstEmpty;
end;

function TDualListDlg.GetFirstSelection(List: TCustomListBox): Integer;
begin
  for Result := 0 to List.Items.Count - 1 do
    if List.Selected[Result] then Exit;
  Result := LB_ERR;
end;

procedure TDualListDlg.SetItem(List: TListBox; Index: Integer);
var
  MaxIndex: Integer;
begin
  with List do
  begin
    SetFocus;
    MaxIndex := List.Items.Count - 1;
    if Index = LB_ERR then Index := 0
    else if Index > MaxIndex then Index := MaxIndex;
    Selected[Index] := True;
  end;
  SetButtons;
end;

procedure TDualListDlg.OKBtnClick(Sender: TObject);
var
k,j,i,cod:integer;
cad,code,site,cad1,cadcode:string;
F1:TextFile;
longitude,latitude:real;
siteload:boolean;
begin
 j:=0;
 k:=0;
 for i:=0 to DstList.items.Count - 1 do
  begin
   cadcode:=copy(DstList.items[i],1,40);
   siteload:=False;
   for k:=1 to MaxSelSite do
    if EfecHuman[k].code = cadcode then
     begin
      j:=j+1;
      SelSite[j].code := cadcode;
      SelSite[j].efecto := EfecHuman[k].efecto;
      SelSite[j].latitud := EfecHuman[k].latitud;
      SelSite[j].longitud := EfecHuman[k].longitud;
      SelSite[j].natura := EfecHuman[k].natura;
      SelSite[j].ClaseVul := EfecHuman[k].ClaseVul;
      SelSite[j].intensidad := EfecHuman[k].intensidad;
      siteload:=True;
      break;
     end;
        if not siteload then
    for k:=1 to NinputSite do
     begin
      code := InpSite[k].name;
      longitude := InpSite[k].longitud;
      latitude := InpSite[k].latitud;
      site := InpSite[k].name;
    if code = cadcode then
     begin
      j:=j + 1;
      SelSite[ j ].code:=code;
      SelSite[ j ].Longitud:=longitude;
      SelSite[ j ].Latitud := Latitude;
      SelSite[ j ].efecto := inicial;
      SelSite[ j ].natura := initNatura;
      SelSite[ j ].ClaseVul := initClaseVul;
      SelSite[ j ].intensidad := 0;
      siteload:=True;
      break;
     end;
    end;
    if not siteload then
    for k:=1 to NSite do
     begin
      code := listplaces[k].name;
      longitude := listplaces[k].longitud;
      latitude := listplaces[k].latitud;
    if code = cadcode then
     begin
      j:=j + 1;
      SelSite[ j ].code:=code;
      SelSite[ j ].Longitud:=longitude;
      SelSite[ j ].Latitud := Latitude;
      SelSite[ j ].efecto := inicial;
      SelSite[ j ].natura := initNatura;
      SelSite[ j ].ClaseVul := initClaseVul;
      SelSite[ j ].intensidad := 0;
      siteload:=True;
      break;
     end;
    end;
  end;
  MaxSelSite:= j;
  for i:=1 to MaxSelSite do
   begin
    EfecHuman[i].code := SelSite[i].code;
    EfecHuman[i].efecto := SelSite[i].efecto;
    EfecHuman[i].latitud := SelSite[i].latitud;
    EfecHuman[i].longitud := SelSite[i].longitud;
    EfecHuman[i].natura := SelSite[i].natura;
    EfecHuman[i].ClaseVul := SelSite[i].ClaseVul;
    EfecHuman[i].intensidad := SelSite[i].intensidad;
   end;
  close;
end;

procedure TDualListDlg.CancelBtnClick(Sender: TObject);
begin
Close;
end;

procedure TDualListDlg.RefreshList;
var
cad,filename,site,cad1,code:string;
i,c:integer;
F1:TextFile;
begin
 nsite:=0;
 SrcList.items.clear;
 SetItem(SrcList, 0);
 AssignFile(F1, namepost);
 {$I-}
    Reset(F1);
 {$I+}
    if IOResult <> 0 then
      MessageDlg('File '+namepost+' not found', mtWarning, [mbOk], 0)
     else
     begin
     Readln(F1, cad);
    while (not Eof(F1)) and (nsite<10000) do
      begin
        Readln(F1, cad);
        nsite:=nsite+1;
        getfirstcad(cad,cad1);
        val(cad1,listplaces[nsite].latitud,c);
        getfirstcad(cad,cad1);
        val(cad1,listplaces[nsite].longitud,c);
        getfirstcad(cad,cad1);
        cad:=cad1+cad;
        for i:=1 to length(cad) do
         if ord(cad[i])=9 then cad[i]:=' ';
        listplaces[nsite].name:=copy(cad,1,40);
        for i:=length(listplaces[nsite].name) to 39 do
         listplaces[nsite].name:=listplaces[nsite].name+' ';
        SrcList.items.add(listplaces[nsite].name);
      end;
      CloseFile(F1);
     end;
end;

procedure TDualListDlg.HelpBtnClick(Sender: TObject);
begin
Application.HelpJump('Select_site');
end;

procedure TDualListDlg.Button1Click(Sender: TObject);
begin
 namepost:=syspath+'dat\'+selectedlist;
 RefreshList;
 SetButtons;
end;

procedure TDualListDlg.Button2Click(Sender: TObject);
begin
 namepost:=syspath+'dat\'+masterlist;
 RefreshList;
 SetButtons;
end;

procedure TDualListDlg.Button3Click(Sender: TObject);
begin
 if Opendialog1.Execute then
  begin
   namepost:=Opendialog1.filename;
   RefreshList;
   SetButtons;
  end;
end;

procedure TDualListDlg.FormActivate(Sender: TObject);
var
i,k:integer;
cad:string;
begin
   RefreshList;
   DstList.items.clear;
   SetItem(DstList, 0);
   for i:=1 to MaxSelSite do
   begin
    cad:=SelSite[ i ].code;
    DstList.items.add(cad);
   end;
   SetButtons;
end;

procedure TDualListDlg.Button4Click(Sender: TObject);
var
 i,cod:integer;
 cad:string;
begin
if InputPoint.ShowModal=mrOK then
 begin
 cad:=copy(InputPoint.code.text,1,40);
 for i:=length(cad) to 39 do
  cad:=cad+' ';
 DstList.items.add(cad);
 NinputSite:=NinputSite+1;
 InpSite[NinputSite].name:=cad;
 val(InputPoint.long.text,InpSite[NinputSite].longitud,cod);
 val(InputPoint.lat.text,InpSite[NinputSite].latitud,cod);
 SetButtons;
 end;
end;

end.
