unit webdbdrp;   // MODIFIED - SEE BELOW.

////////////////////////////////////////////////////////////////////////
//  Copyright (c) 1995-97 HREF Tools Corp.  All Rights Reserved.      //
//  This source is a part of the WebHub(tm) Component Package.        //
//  You may not redistribute this file unless you redistribute the    //
//  entire WebHub(tm) Trial Package. The full license is on the web.  //
//  http://www.href.com/webhub/  http://www.href.com/techsupport.html //
////////////////////////////////////////////////////////////////////////

//Web Dropdown Component -- creates HTML SELECT list from a StringList
//max, 3/8/96
//Changed to a Web DataAware component, to be used with webdataposter
//9/11/97 Mods by Robert Martin   rob@robmart.com
{ Used Michaels Basic code for TWebdrop down and added a pointer to a
webdatasource.  wire it up to the webdatasource,
type in the fieldname that you are keying on and put in the contents
for the select in the inifile under "[Componentname.List]"   }

//

interface

uses
  Windows, SysUtils, Classes, DsgnIntf, Dialogs
, WebLink, WebIList,WDBsorce;

const
  cRows=1;

type
  TWebDataAwareDropdownDefault= (ddFirst,ddBlank);
  TWebDataAwareDropdownChange = procedure(Sender:TObject;var NewValue:String; var ok:boolean) of object;

type
  TWebDataAwareDropdown = class(TWebAction)
  private
    fRows: Integer;
    fList: TWebIniList;
    fValue: String;
    fMultiple: Boolean;
    fDefault: TWebDataAwareDropdownDefault;
    fTesting: Boolean;
    fOnChange: TWebDataAwareDropdownChange;
    fwebDataSource : TWebDataSource;
    fFieldName : String;
    procedure SetList(Value:TWebIniList);
    procedure SetValue(const Text:String);
    function  GetValue:String;
    procedure SetText(const Text:String);
    function  GetText:String;
  protected

    function  GetLocalVerbCount: Integer;
    function  GetVerbCount: Integer; Override;
    function  GetVerb(Index: Integer): string; Override;
    procedure ExecuteVerb(Index: Integer); Override;

    procedure SetSaveState(const State:String); override;
    function  GetSaveState:String; override;
    procedure SetTest(Value:Boolean); override;

    function  DoUpdate:Boolean; override;
    procedure DoExecute; override;
  public
    constructor Create(aOwner:TComponent); override;
    destructor Destroy; override;
    procedure SendListBox(const aName:String);dynamic;
  published
    property List: TWebIniList read fList write SetList;
      //list of possible choices. (not from ini file yet)
    property Value: String read GetValue write SetValue;
      //dynamically maintained value selected by surfer
    property Text: String read GetText write SetText;
      //'translated' value of selection
    property Rows: Integer read fRows write fRows default cRows;
      //number of rows (size) for output. 1-default, 0-all.
    property DefaultValue: TWebDataAwareDropdownDefault read fDefault write fDefault;
      //how the default value is picked (blank or first list element)
      //can not blank out an item unless a blank item is in the list!
    property Multiple: Boolean read fMultiple write fMultiple default false;
      //controls the multiple select tag
    property OnChange: TWebDataAwareDropdownChange read fOnChange write fOnChange;
      //called whenever a surfer selects (a) new value.
    property WebDataSource: TWebDataSource read fWEbDataSource
      write fWebdatasource;
    property Fieldname : String Read fFieldName Write fFieldName;
    end;

type
  TWebDataAwareDropdownValueProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
    end;


//procedure Register;

{----------------------------------------------------------------------}

implementation


uses
  ucInteg, ucString;

{----------------------------------------------------------------------}

constructor TWebDataAwareDropdown.Create(aOwner:TComponent);
begin
  inherited Create(aOwner);
  fRows:=cRows;
  fList:=TWebIniList.CreateFor(Self,'List');
end;

destructor TWebDataAwareDropdown.Destroy;
begin
  webini.WriteSection(name + '.list',flist);
  fList.Free;
  inherited Destroy;
end;

{----------------------------------------------------------------------}

function TWebDataAwareDropdown.DoUpdate:Boolean;
begin
  Result:=inherited DoUpdate;
  if not result then exit;
  With WebIni do begin
    ReadNoComment(Name + '.list', flist);
    end;
end;

 procedure TWebDataAwareDropDown.DoExecute;
//process commands, literals and output the dropdown
var
  a1:string;
begin
    //assemble the dropdown
  if fTesting then
    with WebOutput do
      SendLine('<FORM METHOD=POST ACTION="%=where=%'+Self.Name+'">');
  //
  if webdatasource = Nil then a1:= name
    else begin
      a1 := WebDataSource.dbFieldName(fFieldName);
      if ffieldname <> '' Then
        Value := Webdatasource.dataset.findfield(fFieldname).asString
        else Value := '';
      end;
  SendListBox(a1);
  //
  if fTesting then
    with WebOutput do
      SendLine('</FORM>');
end;


procedure TWebDataAwareDropdown.SetTest(Value:Boolean);
begin
  fTesting:=true;
  try
    inherited SetTest(Value);
  finally
    fTesting:=false;
    end;
end;

procedure TWebDataAwareDropdown.SetList(Value:TWebIniList);
begin
  fList.Assign(Value);
end;

procedure TWebDataAwareDropdown.SetValue(const Text:String);
var
  a1:string;
  b:boolean;
begin
  if fMultiple
  //gotta write validation for each item sometime.
  //for now accept any value list if it's a multiple select item.
  or (List.FindByKey(Text)>-1) then begin //weblist
    if fValue<>Text then begin
      a1:=Text;
      b:=true;
      if assigned(fOnChange) then
        fOnChange(Self,a1,b);
      if b then
        fValue:=a1;
      end;
    end
  else
    fValue:='';
  //adjust for default value
//  if (Value='') and (fDefault=ddFirst) then
//    fValue:=LeftOf('=',List[0]);
end;

function TWebDataAwareDropdown.GetValue:String;
begin
  //adjust for default value
  if (fValue='')
  and (fDefault=ddFirst)
  and (fList.Count>0) then
    fValue:=LeftOf('=',List[0]);
  Result:=fValue;
end;

procedure TWebDataAwareDropdown.SetText(const Text:String);
begin
  if fValue<>'' then
    fList.Values[fValue]:=Text;
end;

function TWebDataAwareDropdown.GetText:String;
begin
  //not ok for multi-select, but translates single items fine.
  if fValue<>'' then
    Result:=fList.Values[fValue]
  else
    Result:='';
end;

{----------------------------------------------------------------------}

procedure TWebDataAwareDropdown.SendListBox(const aName:String);
//assemble the dropdown
var
  i:integer;
  a1,a2: String;
  b:boolean;
begin
  with WebOutput do begin
    if List.Count=0 then begin
      WebOutput.SendComment('Empty');
      exit;
      end;
    //setup the select command
    if fRows=1 then       //size controls the number of rows taken up
      a1:=''             //one row is the default
    else
    if fRows=0 then       //size controls the number of rows taken up
      if (Value='') then
        a1:=' SIZE='+IntToStr(List.Count+1)
      else
        a1:=' SIZE='+IntToStr(List.Count)
    else
      a1:=' SIZE='+IntToStr(min(fRows,List.Count));
    if fMultiple then    //add multiselect modifier
      a1:=a1+' MULTIPLE';
    //and output it.
    SendLine('<SELECT NAME="'+aName+'"'+a1+'>');

    //figure out a default value to
    if (Value='') then
      SendLine('<OPTION VALUE="" SELECTED>');

    for i:=0 to pred(List.Count) do begin
      SplitString(List[i],'=',a1,a2);
      //figure out if it's a/the selected item
      if fMultiple then
        b:=(pos(','+a1+',', ','+Value+',')>0)
      else
        b:=(Value=a1);
      //send respective html.
      if b then
        SendLine('<OPTION VALUE="'+a1+'" SELECTED>'+a2)
      else
        SendLine('<OPTION VALUE="'+a1+'">'+a2);
      end;

    Send('</SELECT>');
    end;
end;

{-----------------------------------------------------------------------------------------}

function TWebDataAwareDropdown.GetLocalVerbCount: Integer;
begin
  Result := 2;
end;

function TWebDataAwareDropdown.GetVerbCount: Integer;
begin
  Result := inherited GetVerbCount + GetLocalVerbCount;
end;

function TWebDataAwareDropdown.GetVerb(Index: Integer): string;
begin
  case Index of
    0: Result := 'Edit List';
    1: Result := 'Edit Value';
  else
    Result:=inherited GetVerb(Index - GetLocalVerbCount);
  end;
end;

procedure TWebDataAwareDropdown.ExecuteVerb(Index: Integer);
begin
  case Index of
    0: with List do Edit;
    1: Value:= InputBox(Name,'Value:',Value);
  else
    Inherited ExecuteVerb(Index - GetLocalVerbCount);
    end;
end;

{----------------------------------------------------------------------}

procedure TWebDataAwareDropdown.SetSaveState(const State:String);
var
  a1,a2:string;
begin
  try
    SplitString(State,'|',a1,a2); Value:=WebApp.LiteralState[Self,'Value',a1];
    inherited SetSaveState(a2);
  except
    WebOutput.SendException(Self,Exception(ExceptObject));
    end;
end;

function TWebDataAwareDropdown.GetSaveState:String;
begin
  Result:= fValue+'|'+inherited GetSaveState;
end;

{---------------------------------------------------------------}

function TWebDataAwareDropdownValueProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList];
end;

procedure TWebDataAwareDropdownValueProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
begin
  with TWebDataAwareDropdown(GetComponent(0)).List do
    for I := 0 to pred(Count) do
      Proc(LeftOf('=',Strings[i]));
end;

{----------------------------------------------------------------------}

//procedure Register;
//begin
//  RegisterComponents('HREF', [TWebDataAwareDropdown]);
//end;

end.