home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 December / Chip_2001-12_cd1.bin / zkuste / delphi / kolekce / d3456 / ALEXSOFT.ZIP / RUSSIAN / FMSEARCH.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-09-29  |  15.5 KB  |  480 lines
  1. (*////////////////////////////////////////////////////////////////////////////
  2. //   Part of AlexSoft VCL/DLL Library.                                      //
  3. //   All rights reserved. (c) Copyright 1998.                               //
  4. //   Created by: Alex Rabichooc                                             //
  5. //**************************************************************************//
  6. //  Users of this unit must accept this disclaimer of warranty:             //
  7. //    "This unit is supplied as is. The author disclaims all warranties,    //
  8. //    expressed or implied, including, without limitation, the warranties   //
  9. //    of merchantability and of fitness for any purpose.                    //
  10. //    The author assumes no liability for damages, direct or                //
  11. //    consequential, which may result from the use of this unit."           //
  12. //                                                                          //
  13. //  This Unit is donated to the public as public domain.                    //
  14. //                                                                          //
  15. //  This Unit can be freely used and distributed in commercial and          //
  16. //  private environments provided this notice is not modified in any way.   //
  17. //                                                                          //
  18. //  If you do find this Unit handy and you feel guilty for using such a     //
  19. //  great product without paying someone - sorry :-)                        //
  20. //                                                                          //
  21. //  Please forward any comments or suggestions to Alex Rabichooc at:        //
  22. //                                                                          //
  23. //  a_rabichooc@yahoo.com or alex@carmez.mldnet.com                         //
  24. /////////////////////////////////////////////////////////////////////////////*)
  25.  
  26. unit fmSearch;
  27.  
  28. interface
  29.  
  30. uses
  31.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  32.   ExtCtrls, StdCtrls, ComCtrls, DB, DBTables, Buttons, Mask, DBCtrls, StdUtils;
  33.  
  34. type
  35.   TSearchForm = class(TForm)
  36.     paBottom: TPanel;
  37.     paMiddle: TPanel;
  38.     paTop: TPanel;
  39.     laTemplate: TLabel;
  40.     btOk: TButton;
  41.     btCancel: TButton;
  42.     cbFields: TComboBox;
  43.     laFields: TLabel;
  44.     lbFindValues: TListBox;
  45.     ckContext: TCheckBox;
  46.     edTemplate: TMaskEdit;
  47.     ckExtendedSearch: TCheckBox;
  48.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  49.     procedure edTemplateKeyPress(Sender: TObject; var Key: Char);
  50.     procedure cbFieldsChange(Sender: TObject);
  51.     procedure lbFindValuesDrawItem(Control: TWinControl; Index: Integer;
  52.       Rect: TRect; State: TOwnerDrawState);
  53.     procedure edTemplateChange(Sender: TObject);
  54.     procedure ckContextClick(Sender: TObject);
  55.     procedure lbFindValuesDblClick(Sender: TObject);
  56.     procedure FormCreate(Sender: TObject);
  57.     procedure ckExtendedSearchClick(Sender: TObject);
  58.     procedure cbFieldsKeyPress(Sender: TObject; var Key: Char);
  59.   private
  60.     FDataSet: TDataSet;
  61.     FBookMark: TBookMark;
  62.     FRecords: TStringList;
  63.     FValues: TStringList;
  64.     FField: TField;
  65.     procedure CMChildKey(var Message: TCMChildKey); message CM_CHILDKEY;
  66.     procedure CreateFieldList(AFieldList: TList);
  67.     function FindValue(AString: string; var Index: Integer): Boolean;
  68.     procedure SetFilter(const AFilter: String);
  69.     procedure SetDefaultButton;
  70.     function ValidText: boolean;
  71.   public
  72.     { Public declarations }
  73.     constructor CreateWithDataSet(AOwner: TComponent;
  74.                                   ADataSet: TDataSet; AFieldList: TList;
  75.                                   AField: TField); virtual;
  76.     destructor Destroy; override;
  77.   end;
  78.  
  79. implementation
  80. uses dbConsts, dbTools;
  81.  
  82. {$R *.DFM}
  83.  
  84. {TSearchForm}
  85.  
  86. function TSearchForm.ValidText: boolean;
  87. var LKeyField: TField;
  88.     LDataSet: TDataSet;
  89. begin
  90.    Result := True;
  91.    LKeyField := nil;
  92.    Screen.Cursor := crHourGlass;
  93.    try
  94.      if (FField <> nil) and (FField.FieldKind in [fkData, fkLookup]) and
  95.         (not Assigned(FField.OnGetText) or
  96.                          (@FField.OnGetText = @TSenderClass.GetFieldText)) then
  97.      begin
  98.         if FField.FieldKind = fkLookUp then
  99.         begin
  100.            LDataSet := FField.LookupDataSet;
  101.            if LDataSet <> nil then
  102.              LKeyField := LDataSet.FindField(FField.LookUpKeyFields);
  103.         end
  104.          else
  105.            begin
  106.               LDataSet := FField.LookupDataSet;
  107.               if LDataSet <> nil then
  108.                 LKeyField := LDataSet.FindField(FField.LookUpKeyFields);
  109.            end;
  110.         if (LDataSet <> nil) and (LKeyField <> nil) then
  111.         begin
  112.            Result := LDataSet.Locate(LDataSet.FieldByName(FField.LookupResultField).FieldName, edTemplate.Text, [loCaseInsensitive]);
  113.            if Result then
  114.               Result := FDataSet.Locate(FField.FieldName, LKeyField.Value, [loCaseInsensitive]);
  115.         end
  116.           else
  117.            Result := FDataSet.Locate(FField.FieldName, edTemplate.Text, [loCaseInsensitive]);
  118.      end;
  119.    finally
  120.      Screen.Cursor := crDefault;
  121.    end;
  122. end;
  123.  
  124. constructor TSearchForm.CreateWithDataSet(AOwner: TComponent;
  125.                                           ADataSet: TDataSet; AFieldList: TList;
  126.                                           AField: TField);
  127. begin
  128.   Inherited Create(AOwner);
  129.   FDataSet := ADataSet;
  130.   FBookMark := FDataSet.GetBookmark;
  131.   FRecords := TStringList.Create;
  132.   FValues := TStringList.Create;
  133.   FField := AField;
  134.   CreateFieldList(AFieldList);
  135. end;
  136.  
  137. destructor TSearchForm.Destroy;
  138. begin
  139.   if FBookMark <> nil then
  140.      FDataSet.FreeBookmark(FBookMark);
  141.   if FRecords <> nil then
  142.      FRecords.Free;
  143.   if FValues <> nil then
  144.      FValues.Free;
  145.   Inherited Destroy;
  146. end;
  147.  
  148. procedure TSearchForm.FormClose(Sender: TObject; var Action: TCloseAction);
  149. begin
  150.   case ModalResult of
  151.      mrCancel: FDataSet.GotoBookmark(FBookmark);
  152.      mrOk: if not ckExtendedSearch.Checked and not ValidText then
  153.            begin
  154.               Action := caNone;
  155.               MessageBeep(MB_ICONEXCLAMATION);
  156.               MessageDlg(SRecordNotFound, mtError, [mbOk], 0);
  157.            end;
  158.   end;
  159. end;
  160.  
  161. procedure TSearchForm.edTemplateKeyPress(Sender: TObject; var Key: Char);
  162. var
  163.   ValidKey: boolean;
  164.   AField: TField;
  165. begin
  166.   if ckExtendedSearch.Checked and (lbFindValues.Items.Count = 0) then Exit;
  167.   ValidKey := True;
  168.   if Key in [#32..#255] then
  169.   begin
  170.      AField := nil;
  171.      if FField.LookUpDataSet <> nil then
  172.         AField := FField.LookUpDataSet.FindField(FField.LookUpResultField);
  173.      if AField = nil then
  174.         AField := FField;
  175.      ValidKey := AField.IsValidChar(Key);
  176.   end;
  177.   if not ValidKey then
  178.   begin
  179.     MessageBeep(0);
  180.     Key := #0;
  181.   end;
  182. end;
  183.  
  184. procedure TSearchForm.CreateFieldList(AFieldList: TList);
  185. var
  186.   i: integer;
  187. begin
  188.   with FDataSet do
  189.   begin
  190.     if (AFieldList <> nil) and (AFieldList.Count > 0) then
  191.     begin
  192.        for i := 0 to AFieldList.Count-1 do
  193.        begin
  194.            cbFields.Items.AddObject(TField(AFieldList[i]).DisplayLabel,
  195.                                                         TField(AFieldList[i]));
  196.            if FField = TField(AFieldList[i]) then
  197.               cbFields.ItemIndex := cbFields.Items.Count-1;
  198.        end;
  199.     end
  200.       else
  201.         for i := 0 To FieldCount - 1 do
  202.           if not Fields[i].IsBlob and
  203.                   not (Fields[i] is TBinaryField) and Fields[i].Visible
  204.             {$IFNDEF VER110}
  205.                 and (Fields[i].DataType <> ftDataSet)
  206.             {$ENDIF} then
  207.           begin
  208.              cbFields.Items.AddObject(Fields[i].DisplayLabel, Fields[i]);
  209.              if FField = Fields[i] then
  210.                 cbFields.ItemIndex := cbFields.Items.Count-1;
  211.           end;
  212.   end;
  213.   if cbFields.Items.Count = 0 then
  214.   begin
  215.      Destroy;
  216.      Exit;
  217.   end;
  218.   if cbFields.ItemIndex < 0 then
  219.      cbFields.ItemIndex := 0;
  220.   cbFieldsChange(Self);
  221.   cbFields.DropDownCount := cbFields.Items.Count;
  222. end;
  223.  
  224. function TSearchForm.FindValue(AString: string; var Index: Integer): Boolean;
  225. var HighIndex, LowIndex, CurIndex, CompResult: Integer;
  226.     TmpStr: String;
  227. begin
  228.   Result := False;
  229.   if Length(AString) = 0 then Exit;
  230.   HighIndex := lbFindValues.Items.Count - 1;
  231.   LowIndex := 0;
  232.   while LowIndex <= HighIndex do
  233.   begin
  234.     CurIndex := (LowIndex + HighIndex) div 2;
  235.     with lbFindValues do
  236.        if Length(AString) < Length(Items[CurIndex]) then
  237.         TmpStr := Copy(Items[CurIndex], 1, Length(AString))
  238.       else
  239.         TmpStr := Items[CurIndex];
  240.     CompResult := AnsiCompareText(TmpStr, AString);
  241.     if CompResult < 0 then
  242.         LowIndex := CurIndex + 1
  243.       else
  244.       begin
  245.         HighIndex := CurIndex - 1;
  246.         Result := True;
  247.       end;
  248.   end;
  249.   Index := LowIndex;
  250. end;
  251.  
  252. procedure TSearchForm.cbFieldsChange(Sender: TObject);
  253. var AObject: TObject;
  254.     AIndex: Integer;
  255. begin
  256.    FField := cbFields.Items.Objects[cbFields.ItemIndex] as TField;
  257.    if not (FField.FieldKind in [fkData, fkLookup]) or
  258.           (Assigned(FField.OnGetText) and
  259.                    (@FField.OnGetText <> @TSenderClass.GetFieldText)) then
  260.    begin
  261.       ckExtendedSearch.Enabled := False;
  262.       if not ckExtendedSearch.Checked then
  263.       begin
  264.          ckExtendedSearch.Checked := True;
  265.          exit;
  266.       end;
  267.    end
  268.      else
  269.        ckExtendedSearch.Enabled := True;
  270.    edTemplate.EditMask := FField.EditMask;
  271.    if ckExtendedSearch.Checked then
  272.    begin
  273.      FDataSet.DisableControls;
  274.      try
  275.         Screen.Cursor := crHourGlass;
  276.         lbFindValues.Items.BeginUpdate;
  277.         lbFindValues.Clear;
  278.         FRecords.BeginUpdate;
  279.         FRecords.Clear;
  280.         FValues.BeginUpdate;
  281.         FValues.Clear;
  282.         FDataSet.First;
  283.         while not FDataSet.EOF do
  284.         begin
  285.            AObject := TObject(FRecords.Add(FDataSet.Bookmark));
  286.            AIndex := FValues.AddObject(FField.Text, AObject);
  287.            lbFindValues.Items.AddObject(FValues[AIndex], AObject);
  288.            FDataSet.Next;
  289.         end;
  290.         FDataSet.First;
  291.      finally
  292.         FDataSet.EnableControls;
  293.         Screen.Cursor := crDefault;
  294.         lbFindValues.Items.EndUpdate;
  295.         FRecords.EndUpdate;
  296.         FValues.EndUpdate;
  297.         edTemplate.OnChange := nil;
  298.         try
  299.           if ckContext.Checked then
  300.              edTemplate.Text := ''
  301.             else
  302.             if lbFindValues.Items.Count > 0 then
  303.               edTemplate.Text := lbFindValues.Items[0];
  304.           if lbFindValues.Items.Count > 0 then
  305.              lbFindValues.ItemIndex := 0;
  306.         finally
  307.           edTemplate.OnChange := edTemplateChange;
  308.         end;
  309.      end;
  310.    end
  311.      else
  312.         edTemplate.Text := '';
  313.    if Visible and not cbFields.DroppedDown then
  314.       edTemplate.SetFocus;
  315.    SetDefaultButton;
  316. end;
  317.  
  318. procedure TSearchForm.lbFindValuesDrawItem(Control: TWinControl;
  319.   Index: Integer; Rect: TRect; State: TOwnerDrawState);
  320. var ABookmark: TBookmarkStr;
  321. begin
  322.    if not ckExtendedSearch.Checked then
  323.       exit;
  324.    with Control as TListBox do
  325.    begin
  326.       inc(Rect.Bottom);
  327.       Canvas.FillRect(Rect);
  328.       Canvas.TextOut(Rect.Left+1, Rect.Top+1, Items[Index]);
  329.       if (odFocused in State) or (odSelected in State) then
  330.       begin
  331.         ABookmark := TBookmarkStr(FRecords.Strings[Integer(lbFindValues.
  332.                                                         Items.Objects[Index])]);
  333.         if ABookMark <> FDataSet.BookMark then
  334.            FDataSet.BookMark := ABookMark;
  335.       end;
  336.       if odFocused in State then
  337.       begin
  338.          edTemplate.OnChange := nil;
  339.          try
  340.            if not ckContext.Checked then
  341.               edTemplate.Text := Items[Index];
  342.            edTemplate.SelectAll;
  343.          finally
  344.            edTemplate.OnChange := edTemplateChange;
  345.          end;
  346.       end;
  347.    end;
  348.    SetDefaultButton;
  349. end;
  350.  
  351. procedure TSearchForm.edTemplateChange(Sender: TObject);
  352. var i: Integer;
  353. begin
  354.    if not ckExtendedSearch.Checked then
  355.       exit;
  356.    if not ckContext.Checked then
  357.    begin
  358.       if FindValue(edTemplate.Text, i) then
  359.          lbFindValues.ItemIndex := i;
  360.    end
  361.      else
  362.        SetFilter(edTemplate.Text);
  363.    SetDefaultButton;
  364. end;
  365.  
  366. procedure TSearchForm.CMChildKey(var Message: TCMChildKey);
  367. begin
  368.    if not ckExtendedSearch.Checked or (ActiveControl = cbFields) then
  369.       exit;
  370.    with Message do
  371.    case CharCode of
  372.      VK_DOWN, VK_UP, VK_NEXT, VK_PRIOR:
  373.        begin
  374.           if [ssCtrl] = GetShiftState then
  375.           begin
  376.              if CharCode = VK_NEXT then
  377.                CharCode := VK_END;
  378.              if CharCode = VK_PRIOR then
  379.                CharCode := VK_HOME;
  380.           end;
  381.           SendMessage(lbFindValues.Handle, WM_KEYDOWN, CharCode, LongInt(Self));
  382.           Result := 1;
  383.           Application.ProcessMessages;
  384.           if not ckContext.Checked then
  385.           begin
  386.              edTemplate.OnChange := nil;
  387.              try
  388.                edTemplate.Text := lbFindValues.Items[lbFindValues.ItemIndex];
  389.                edTemplate.SelectAll;
  390.              finally
  391.                edTemplate.OnChange := edTemplateChange;
  392.              end;
  393.           end;
  394.        end;
  395.    end;
  396.    SetDefaultButton;
  397. end;
  398.  
  399. procedure TSearchForm.ckContextClick(Sender: TObject);
  400. begin
  401.    if Visible then
  402.      edTemplate.SetFocus
  403.     else
  404.      edTemplate.Text := '';
  405.    SetFilter(edTemplate.Text);
  406.    edTemplate.SelectAll;
  407.    SetDefaultButton;
  408. end;
  409.  
  410. procedure TSearchForm.SetFilter(const AFilter: String);
  411. var i: Integer;
  412. begin
  413.    if not ckExtendedSearch.Checked then
  414.       exit;
  415.    try
  416.       lbFindValues.Items.BeginUpdate;
  417.       lbFindValues.Clear;
  418.       for i := 0 to FValues.Count-1 do
  419.         if not ckContext.Checked or
  420.            (Length(AFilter) = 0) or
  421.            (Pos(AnsiUpperCase(AFilter),
  422.             AnsiUpperCase(FValues[i])) <> 0) then
  423.           lbFindValues.Items.AddObject(FValues[i], FValues.Objects[i]);
  424.    finally
  425.       lbFindValues.Items.EndUpdate;
  426.       if not ckContext.Checked then
  427.             edTemplate.Text := lbFindValues.Items[0];
  428.    end;
  429.    if lbFindValues.Items.Count > 0 then
  430.       lbFindValues.ItemIndex := 0;
  431.    SetDefaultButton;
  432. end;
  433.  
  434. procedure TSearchForm.lbFindValuesDblClick(Sender: TObject);
  435. begin
  436.    btOk.Click;
  437. end;
  438.  
  439. procedure TSearchForm.FormCreate(Sender: TObject);
  440. var ParentForm: TCustomForm;
  441.     TM: TTextMetric;
  442. begin
  443.    if (Owner is TWinControl) then
  444.    begin
  445.       ParentForm := GetParentForm(Owner as TWinControl);
  446.       if ParentForm <> nil then
  447.         Font := ParentForm.Font;
  448.    end;
  449.    GetTextMetrics(lbFindValues.Canvas.Handle, TM);
  450.    lbFindValues.ItemHeight := TM.tmHeight+2;
  451. end;
  452.  
  453. procedure TSearchForm.SetDefaultButton;
  454. begin
  455.    btOk.Default := not ckExtendedSearch.Checked or
  456.                    not ((lbFindValues.ItemIndex < 0) or
  457.                          ((edTemplate.Text <>
  458.                              lbFindValues.Items[lbFindValues.ItemIndex]) and
  459.                                                     not ckContext.Checked));
  460. end;
  461.  
  462. procedure TSearchForm.ckExtendedSearchClick(Sender: TObject);
  463. begin
  464.    ckContext.Visible := ckExtendedSearch.Checked;
  465.    if not ckExtendedSearch.Checked then
  466.       ClientHeight := paTop.Height + paBottom.Height
  467.      else
  468.       ClientHeight := paTop.Height+paBottom.Height+(lbFindValues.ItemHeight+1)*10+
  469.                       paMiddle.BorderWidth*2;
  470.    cbFieldsChange(cbFields);
  471. end;
  472.  
  473. procedure TSearchForm.cbFieldsKeyPress(Sender: TObject; var Key: Char);
  474. begin
  475.    if (Key = char(VK_RETURN)) and Visible then
  476.       edTemplate.SetFocus;
  477. end;
  478.  
  479. end.
  480.