home *** CD-ROM | disk | FTP | other *** search
/ Delphi Anthology / aDELPHI.iso / Runimage / Delphi50 / Demos / Midas / InternetExpress / InetXCustom / webcombo.pas < prev   
Pascal/Delphi Source File  |  1999-08-11  |  10KB  |  323 lines
  1. unit WebCombo;
  2.  
  3. interface
  4.  
  5. uses Classes, HTTPApp, Db, DbClient, Midas,
  6.   XMLBrokr, WebComp, PagItems, MidItems;
  7.  
  8. type
  9.   TSearchSelectOptionsInput = class(TWebTextInput, IScriptComponent)
  10.   private
  11.     FValuesField: string;
  12.     FItemsField: string;
  13.     FDataSet: TDataSet;
  14.     FValues: TStrings;
  15.     FItems: TStrings;
  16.     FDisplayRows: Integer;
  17.   protected
  18.     { IHTMLField }
  19.     function ImplGetHTMLControlName: string; override;
  20.     { IScriptComponent implementation }
  21.     procedure AddElements(AddIntf: IAddScriptElements);
  22.     function GetSubComponents: TObject; // Object implementing IWebComponentContainer
  23.     function ControlContent(Options: TWebContentOptions): string; override;
  24.     function EventContent(Options: TWebContentOptions): string; override;
  25.     function GetSelectIndex(ItemsStrings,
  26.       ValuesStrings: TStrings): Integer; virtual;
  27.     function FormatInputs(ItemsStrings, ValuesStrings: TStrings;
  28.       Options: TWebContentOptions; var MaxWidth: Integer): string;
  29.     function InputName: string;
  30.     function ListName: string;
  31.     procedure SetItems(const Value: TStrings);
  32.     procedure SetValues(const Value: TStrings);
  33.     procedure AddListAttributes(var Attrs: string);
  34.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  35.     procedure SetDataSet(const Value: TDataSet);
  36.    public
  37.     constructor Create(AOwner: TComponent); override;
  38.     destructor Destroy; override;
  39.     property Values: TStrings read FValues write SetValues;
  40.     property Items: TStrings read FItems write SetItems;
  41.     property DataSet: TDataSet read FDataSet write SetDataSet;
  42.     property ValuesField: string Read FValuesField write FValuesField;
  43.     property ItemsField: string read FItemsField write FItemsField;
  44.     property DisplayRows: Integer read FDisplayRows write FDisplayRows;
  45.   end;
  46.  
  47.   TQuerySearchSelectOptions = class(TSearchSelectOptionsInput, IQueryField)
  48.   private
  49.     FText: string;
  50.   protected
  51.     function GetText: string;
  52.     procedure SetText(const Value: string);
  53.     function GetSelectIndex(ItemsStrings,
  54.       ValuesStrings: TStrings): Integer; override;
  55.     procedure AddAttributes(var Attrs: string); override;
  56.   public
  57.     class function IsQueryField: Boolean; override;
  58.   published
  59.     property ParamName;
  60.     property Values;
  61.     property Items;
  62.     property DataSet;
  63.     property ValuesField;
  64.     property ItemsField;
  65.     property DisplayRows;
  66.     property Style;
  67.     property Custom;
  68.     property StyleRule;
  69.     property CaptionAttributes;
  70.     property CaptionPosition;
  71.     property Text: string read GetText write SetText;
  72.     property FieldName;
  73.     property TabIndex;
  74.     property Caption;
  75.   end;
  76.  
  77. implementation
  78.  
  79. uses sysutils, WbmConst;
  80.  
  81. { TSearchSelectOptionsInput }
  82.  
  83. const
  84.   sComboSelChange = 'ComboSelChange';
  85.   sComboSelChangeFunction =
  86.    'function %0:s(list, input)'                         + #13#10 +
  87.    '{'                                                  + #13#10 +
  88.    '  input.value = list.options[list.selectedIndex].text;' + #13#10 +
  89.    '}'                                                  + #13#10;
  90.  
  91.   sComboLookup = 'ComboLookup';
  92.   sComboLookupFunction =
  93.    'function %0:s(input, list)'                      + #13#10 +
  94.    '{'                                               + #13#10 +
  95.    '  var s = input.value.toUpperCase();'              + #13#10 +
  96.    '  var count = list.options.length;'                + #13#10 +
  97.    '  var i = 0;'                                      + #13#10 +
  98.    '  while (i < count)'                               + #13#10 +
  99.    '  {'                                               + #13#10 +
  100.    '    if (list.options[i].text.toUpperCase().indexOf(s)==0)' + #13#10 +
  101.    '    {'                                             + #13#10 +
  102.    '      list.selectedIndex = i;'                     + #13#10 +
  103.    '      break;'                                      + #13#10 +
  104.    '    }'                                             + #13#10 +
  105.    '    i++;'                                          + #13#10 +
  106.    '  }'                                               + #13#10 +
  107.    '}'                                                 + #13#10;
  108.  
  109.  
  110. constructor TSearchSelectOptionsInput.Create(AOwner: TComponent);
  111. begin
  112.   inherited;
  113.   FValues := TStringList.Create;
  114.   FItems := TStringList.Create;
  115.   FDisplayRows := -1;
  116. end;
  117.  
  118. destructor TSearchSelectOptionsInput.Destroy;
  119. begin
  120.   inherited;
  121.   FValues.Free;
  122.   FItems.Free;
  123. end;
  124.  
  125. function TSearchSelectOptionsInput.EventContent(Options: TWebContentOptions): string;
  126. var
  127.   HTMLForm: IHTMLForm;
  128.   HTMLFormName: string;
  129. begin
  130.   HTMLForm := GetHTMLForm;
  131.   if Assigned(HTMLForm) then
  132.     HTMLFormName := HTMLForm.HTMLFormName;
  133.   Result := inherited EventContent(Options);
  134.   Result := Format('%0:s onkeyup="%1:s(this, %2:s.%3:s);"',
  135.     [Result, sComboLookup, HTMLFormName, ListName]);
  136. end;
  137.  
  138. function TSearchSelectOptionsInput.ControlContent(Options: TWebContentOptions): string;
  139. var
  140.   ItemsStrings, ValuesStrings: TStrings;
  141.   ListContent: string;
  142.   MaxWidth: Integer;
  143. begin
  144.   if GetItemValuesFromDataSet(FDataSet, ItemsField, ValuesField, ItemsStrings, ValuesStrings) then
  145.   begin
  146.     try
  147.       ListContent := FormatInputs(ItemsStrings, ValuesStrings, Options, MaxWidth);
  148.     finally
  149.       ItemsStrings.Free;
  150.       ValuesStrings.Free;
  151.     end;
  152.   end
  153.   else
  154.     ListContent := FormatInputs(Items, Values, Options, MaxWidth);
  155.   // Define edit control
  156.   DisplayWidth := MaxWidth;
  157.   Result := inherited ControlContent(Options);
  158.   Result := Format(#13#10'<TABLE>' +
  159.                    '  <TR>' +
  160.                    '    <TD>' +
  161.                    '    %0:s'  +
  162.                    '    </TD>' +
  163.                    '  </TR>'#13#10 +
  164.                    '  <TR>'  +
  165.                    '    <TD>' +
  166.                    '    %1:s' +
  167.                    '    </TD>' +
  168.                    '  </TR>'  +
  169.                    '</TABLE>',
  170.     [Result, ListContent]);
  171. end;
  172.  
  173. function TSearchSelectOptionsInput.InputName: string;
  174. begin
  175.   Result := Format('_%s', [ListName]);
  176. end;
  177.  
  178. function TSearchSelectOptionsInput.ListName: string;
  179. begin
  180.   Result := inherited ImplGetHTMLControlName;
  181. end;
  182.  
  183. procedure TSearchSelectOptionsInput.AddListAttributes(var Attrs: string);
  184. begin
  185.   AddQuotedAttrib(Attrs, 'NAME', ListName);
  186.   AddIntAttrib(Attrs, 'SIZE', DisplayRows);
  187.   AddIntAttrib(Attrs, 'TABINDEX', TabIndex);
  188.   AddQuotedAttrib(Attrs, 'STYLE', Style);
  189.   AddQuotedAttrib(Attrs, 'CLASS', StyleRule);
  190.   AddCustomAttrib(Attrs, Custom);
  191. end;
  192.  
  193. function TSearchSelectOptionsInput.GetSelectIndex(ItemsStrings,
  194.   ValuesStrings: TStrings): Integer;
  195. begin
  196.   Result := -1;
  197. end;
  198.  
  199. function TSearchSelectOptionsInput.FormatInputs(ItemsStrings, ValuesStrings: TStrings; Options: TWebContentOptions;
  200.   var MaxWidth: Integer): string;
  201. var
  202.   Index: Integer;
  203.   Attrs, Events, Value: string;
  204.   Item: string;
  205.   HTMLForm: IHTMLForm;
  206.   HTMLFormName: string;
  207.   SelectIndex: Integer;
  208.   OptionAttr: string;
  209. begin
  210.   Result := '';
  211.   MaxWidth := -1;
  212.   AddListAttributes(Attrs);
  213.   HTMLForm := GetHTMLForm;
  214.   if Assigned(HTMLForm) then
  215.     HTMLFormName := HTMLForm.HTMLFormName;
  216.   if (not (coNoScript in Options.Flags)) then
  217.     Events := Format(' onchange="%0:s(this, %1:s.%2:s);"',
  218.       [sComboSelChange, HTMLFormName, GetHTMLControlName]);
  219.   SelectIndex := GetSelectIndex(ItemsStrings, ValuesStrings);
  220.   Result := Format('<SELECT%0:s%1:s>'#13#10, [Attrs, Events]);
  221.   for Index := 0 to ItemsStrings.Count - 1 do
  222.   begin
  223.     Item := ItemsStrings[Index];
  224.     if ItemsStrings.IndexOf(Item) <> Index then continue;  // not unique
  225.     if Length(Item) > MaxWidth then
  226.       MaxWidth := Length(Item);
  227.     if ValuesStrings.Count > Index then
  228.       Value := ValuesStrings[Index]
  229.     else
  230.       Value := Item;
  231.     OptionAttr := '';
  232.     AddQuotedAttrib(OptionAttr, 'VALUE', Value);
  233.     AddBoolAttrib(OptionAttr, 'SELECTED', Index = SelectIndex);
  234.     Result := Format('%0:s  <OPTION %1:s>%2:s'#13#10,
  235.       [Result, OptionAttr, Item]);
  236.   end;
  237.   Result := Format('%0:s</SELECT>', [Result]);
  238. end;
  239.  
  240. procedure TSearchSelectOptionsInput.AddElements(AddIntf: IAddScriptElements);
  241. begin
  242.   inherited;
  243.   if Assigned(FDataSet) and (FDataSet.Active = False) then
  244.     AddIntf.AddError(Format(sDataSetNotActive, [FDataSet.Name]));
  245.   AddIntf.AddFunction(sComboSelChange, Format(sComboSelChangeFunction, [sComboSelChange]));
  246.   AddIntf.AddFunction(sComboLookup, Format(sComboLookupFunction, [sComboLookup]));
  247. end;
  248.  
  249. procedure TSearchSelectOptionsInput.SetItems(const Value: TStrings);
  250. begin
  251.   FItems.Assign(Value);
  252. end;
  253.  
  254. procedure TSearchSelectOptionsInput.SetValues(const Value: TStrings);
  255. begin
  256.   FValues.Assign(Value);
  257. end;
  258.  
  259. function TSearchSelectOptionsInput.ImplGetHTMLControlName: string;
  260. begin
  261.   Result := InputName;
  262. end;
  263.  
  264. procedure TSearchSelectOptionsInput.SetDataSet(const Value: TDataSet);
  265. begin
  266.   if FDataSet <> Value then
  267.   begin
  268.     FDataSet := Value;
  269.     if Value <> nil then
  270.     begin
  271.       Value.FreeNotification(Self);
  272.       if not (csLoading in ComponentState) then
  273.         Value.Active := True;
  274.     end;
  275.   end;
  276. end;
  277.  
  278. procedure TSearchSelectOptionsInput.Notification(AComponent: TComponent;
  279.   Operation: TOperation);
  280. begin
  281.   if (Operation = opRemove) and (AComponent = FDataSet) then
  282.     DataSet := nil;
  283. end;
  284.  
  285. function TSearchSelectOptionsInput.GetSubComponents: TObject;
  286. begin
  287.   Result := nil;
  288. end;
  289.  
  290. { TQuerySearchSelectOptiosn }
  291.  
  292. procedure TQuerySearchSelectOptions.AddAttributes(var Attrs: string);
  293. begin
  294.   Inherited;
  295.   AddQuotedAttrib(Attrs, 'VALUE', Text);
  296. end;
  297.  
  298. function TQuerySearchSelectOptions.GetSelectIndex(ItemsStrings,
  299.   ValuesStrings: TStrings): Integer;
  300. begin
  301.   Result := ItemsStrings.IndexOf(Text);
  302. end;
  303.  
  304. function TQuerySearchSelectOptions.GetText: string;
  305. begin
  306.   Result := FText;
  307. end;
  308.  
  309. class function TQuerySearchSelectOptions.IsQueryField: Boolean;
  310. begin
  311.   Result := True;
  312. end;
  313.  
  314. procedure TQuerySearchSelectOptions.SetText(const Value: string);
  315. begin
  316.   if Value <> FText then
  317.   begin
  318.     FText := Value;
  319.   end;
  320. end;
  321.  
  322. end.
  323.