wwdblook.pas

胜天进销存源码,国产优秀的进销存

  FGrid.FCombo := Self;
  FGrid.Parent := Self;
  FGrid.Visible := False;
  FGrid.OnClick := GridClick;
  FGrid.Ctl3D:= self.Ctl3D;
  FGrid.PadColumnStyle:= pcsPlain;
  FGrid.Options:= [];

  Height := 25;
  FDropDownCount := 8;

  FTimer:= TTimer.create(self);
  FTimer.enabled:= False;
  FSearchDelay:= 0;
  FTimer.Interval:= 200;
  FTimer.OnTimer:= OnEditTimerEvent;

  wwDBCalcFieldType:=cftUnknown;
  ChangingFromLink:= False;
  InAutoDropDown:= False;
  AutoDropDown:= False;
  InList:= True;

  SeqSearchOptions:= [ssoEnabled];
  FOrderByDisplay:= True;
  FUseTFields:= True;

  FControlInfoInDataset:= True;
//  Transparent:= False;
  FFrame:= TwwEditFrame.create(self);

//  FButtonGlyph := TBitmap.Create;
//  FButtonGlyph.OnChange := GlyphChanged;

  FButtonEffects:= TwwComboButtonEffects.create(self, FButton);
//  FButton.Glyph.Handle := LoadComboGlyph;

//  FLookupSearchType:= lstDefault;

end;

destructor TwwDBCustomLookupCombo.Destroy;
begin
  FPicture.Free;
  FDropDownGridOptions.Free;

  FFrame.Free;
  FButtonEffects.Free;
  FTimer.Free;
  FFieldLink.OnDataChange := nil;
  FFieldLink.Free;
  FFieldLink := nil;

  FButton.Free;
  FButton:= Nil;
  FCanvas.Free;
  FCanvas:= Nil;
  FGrid.Free;
  FGrid:= Nil;

  {$ifdef wwDelphi4up}
  if wwLookupComboHook<>0 then begin
     UnhookWindowsHookEx(wwLookupComboHook);
     wwLookupComboHook:= 0;
  end;
  {$endif}

//  FButtonGlyph.Free;
  inherited Destroy;
end;

Procedure TwwDBCustomLookupCombo.UpdatebuttonGlyph;
begin
//   FButton.Glyph.Handle:=0;  7/28/01 - Don't clear glyph
   if (FButtonStyle<>cbsCustom) and
      (ButtonEffects.Flat or ButtonEffects.Transparent) then
   begin
      if (FButtonStyle = cbsDownArrow) then
         FButton.Glyph.Handle:= LoadBitmap(HInstance, 'WWDROPDOWN')
   end;
end;

{Function TwwDBCustomLookupCombo.LoadComboGlyph: HBitmap;
begin
   result:= 0;
   if ButtonEffects.Flat or ButtonEffects.Transparent then
      result:= LoadBitmap(HInstance, 'WWDROPDOWN')
//   result:= LoadBitmap(0, PChar(32738));
end;
}
function TwwDBCustomLookupCombo.GetButtonGlyph: TBitmap;
begin
  result:= FButton.Glyph;
end;

procedure TwwDBCustomLookupCombo.SetButtonStyle(val: TwwComboButtonStyle);
begin
   if val<>FButtonStyle then begin
      FButtonStyle:= val;
      UpdateButtonGlyph;
//      FButton.Glyph.Handle:= LoadComboGlyph;
      FButton.Invalidate;
   end
end;

function TwwDBCustomLookupCombo.IsCustom: Boolean;
begin
  Result := ButtonStyle = cbsCustom;
end;

procedure TwwDBCustomLookupCombo.SetButtonGlyph(Value: TBitmap);
begin
  FButton.Glyph.Assign(Value);
  Invalidate;
end;
{
procedure TwwDBCustomLookupCombo.GlyphChanged(Sender: TObject);
begin
   FButton.Glyph.Handle:= LoadComboGlyph;
   Invalidate;
end;
}
Procedure TwwDBCustomLookupCombo.SetButtonWidth(val: integer);
begin
   if FButtonWidth<>val then
   begin
      FButtonWidth:= val;
      if val<>0 then FButton.Width:= val
      else FButton.Width:= wwmax(GetSystemMetrics(SM_CXVSCROLL), 15);
      UpdateButtonPosition;
   end
end;

function TwwDBCustomLookupCombo.GetButtonWidth: integer;
begin
   result:= FButtonWidth;
end;


function TwwDBCustomLookupCombo.GetShowButton: boolean;
begin
   result:= FBtnControl.visible;
end;

procedure TwwDBCustomLookupCombo.SetShowButton(sel: boolean);
begin
   if (FBtnControl.visible<> sel) then
   begin
      FBtnControl.visible:= sel;
      SetEditRect;
      self.invalidate;
   end
end;

Function TwwDBCustomLookupCombo.LTable: TwwTable;
begin
   result:= LookupTable as TwwTable;
end;

Function TwwDBCustomLookupCombo.UseSeqSearch: boolean;
begin
   result:= (not (LookupTable is TwwTable)) or
            ((LookupTable as TwwTable).indexDefs.count=0) or
            ((LookupTable as TwwTable).indexFieldCount=0) or
             Assigned(FOnPerformCustomSearch); // 7/12/01

   { Still perform index search if xBASE expression index }
   if result and (LookupTable is TwwTable) then with (LookupTable as TwwTable) do
   begin
       result:= not
         (isDBaseTable and (SearchField<>'') and (IndexDefs.indexof(IndexName)>=0) and
          (ixExpression in IndexDefs.Items[IndexDefs.indexof(IndexName)].Options));
   end
end;

function TwwDBCustomLookupCombo.FindRecord(
       KeyValue: string;
       LookupField: string;
       MatchType: TwwLocateMatchType;
       CaseSensitive: boolean;
       PerformLookup: boolean = False): boolean;
var curField: TField;
    SaveCursor: TCursor;
begin
   if InCustomSearch then exit;

   // If event assigned then don't treat as TwwTable
   if (LookupTable is TwwTable) and not Assigned(FOnPerformCustomSearch) then
      result:= (LookupTable as TwwTable).wwFindRecord(KeyValue, LookupField, MatchType, CaseSensitive)
   else begin
      { 5/12/99 - Avoid exception by checking if semi-colon exists in lookup field }
      curField:= LookupTable.FindField(LookupField);
      if (pos(';', LookupField)=0) and (curField<>nil) and (curField.asString=KeyValue) then begin
         result:= True;
         FGrid.invalidate;  { In case nothing was highlighted before }
      end
      else begin
         {7/24/97 - Limit length to be up to field size }
         if (curField is TStringField) and (curField.size>0) and (curField.size<length(Text)) then
            KeyValue:= copy(KeyValue, 1, curField.size);

         { If invalid value type or blank (blank lookup is slow) then skip search }
         if Assigned(FOnPerformCustomSearch) then begin
         {
             if (curField<>nil) and
                (not wwFieldIsValidLocateValue(curField, KeyValue)) or
                (KeyValue='') then
                } // 11/29/04 - Don't restrict input
//             if (curField<>nil) or
//                (KeyValue='') then
              if (KeyValue='') then // 1/6/07 - Event not firing before
              begin
                result:= False;
                FGrid.invalidate;
                exit;
             end;

             SkipDataChange:= True;
             InCustomSearch:= True;
             try
               PerformCustomSearch(LookupField, KeyValue, PerformLookup, Result);
             finally
               InCustomSearch:= False;
               SkipDataChange:= False;
             end;
         end
         else if
            (not wwFieldIsValidLocateValue(curField, KeyValue)) or
            (KeyValue='') then
         begin
            result:= False;
            FGrid.invalidate;
         end
         else if (not wwInternational.UseLocateMethodForSearch) then
             result:= wwDataSetFindRecord(LookupTable, KeyValue, LookupField, MatchType, caseSensitive)
         { 10/29/97 - Search on calculated or lookup fields }
         {$ifdef win32}
         else if (curfield.calculated or curfield.lookup) then
         {$else}
         else if (curfield.calculated) then
         {$endif}
             result:= wwDataSetFindRecord(LookupTable, KeyValue, LookupField, MatchType, False)
         {$ifndef win32}
         else result:= wwDataSetFindRecord(LookupTable, KeyValue, LookupField, MatchType, caseSensitive)
         {$else}
         else if not (LookupTable is TwwQuery) then
         begin
            { 9/20/97 - Replace wwDataSetFindRecord call with Locate to allow 3rd party engines
                        opportunity to take advantage of the index.  The end-user should set
                        SeqSearchOptions to the case sensitivity of the index so that the
                        index can be used }
            {$ifdef wwDelphi3Up}
            SaveCursor:= screen.cursor;
            Screen.cursor:= crHourGlass;
            if caseSensitive then begin
               if (MatchType=mtExactMatch) then result:= LookupTable.Locate(LookupField, KeyValue, [])
               else result:= LookupTable.Locate(LookupField, KeyValue, [loPartialKey]);
            end
            else begin
               if (MatchType=mtExactMatch) then result:= LookupTable.Locate(LookupField, KeyValue, [loCaseInsensitive])
               else result:= LookupTable.Locate(LookupField, KeyValue, [loPartialKey, loCaseInsensitive]);
            end;
            Screen.cursor:= SaveCursor;
            {$else}
            result:= wwDataSetFindRecord(LookupTable, KeyValue, LookupField, MatchType, caseSensitive)
            {$endif}
         end
         else if (LookupTable is TwwQuery) and TwwQuery(LookupTable).RequestLive and
                   TwwQuery(LookupTable).CanModify then
         begin
             SaveCursor:= screen.cursor;
             Screen.cursor:= crHourGlass;
             { Require seq search on live parameterized query as Delphi Locate does not support this}
             if (TwwQuery(LookupTable).DataSource<>Nil) then
                result:= wwDataSetFindRecord(LookupTable, KeyValue, LookupField, MatchType, caseSensitive)
             else if (MatchType=mtExactMatch) then begin
                try
                  if TwwQuery(LookupTable).isValidIndexField(LookupField, False) then
                     result:= LookupTable.Locate(LookupField, KeyValue, [loCaseInsensitive])
                  else if TwwQuery(LookupTable).isValidIndexField(LookupField, True) then
                     result:= LookupTable.Locate(LookupField, KeyValue, [])
                  else
                     result:= wwDataSetFindRecord(LookupTable, KeyValue,
                                                  LookupField, MatchType, caseSensitive);
                  Screen.cursor:= SaveCursor;
                except
                  result:= wwDataSetFindRecord(LookupTable, KeyValue, LookupField, MatchType, caseSensitive)
                end
             end
             else begin
                try
                  if TwwQuery(LookupTable).isValidIndexField(LookupField, False) then
                     result:= LookupTable.Locate(LookupField, KeyValue, [loCaseInsensitive, loPartialKey])
                  else if TwwQuery(LookupTable).isValidIndexField(LookupField, True) then
                     result:= LookupTable.Locate(LookupField, KeyValue, [loPartialKey])
                  else
                     result:= wwDataSetFindRecord(LookupTable, KeyValue,
                                                  LookupField, MatchType, caseSensitive);
                  Screen.cursor:= SaveCursor;
                except
                  result:= wwDataSetFindRecord(LookupTable, KeyValue, LookupField, MatchType, caseSensitive)
                end;
             end
         end
         else begin
            SaveCursor:= screen.cursor;
            Screen.cursor:= crHourGlass;
            if (MatchType=mtExactMatch) then result:= LookupTable.Locate(LookupField, KeyValue, [])
            else result:= LookupTable.Locate(LookupField, KeyValue, [loPartialKey, loCaseInsensitive]);
            Screen.cursor:= SaveCursor;
         end
         {$endif}
      end
   end;

   // 9/13/00 - Workaround problem where locate ignores trailing spaces
   if (not Assigned(FOnPerformCustomSearch)) and result then // 1/7/06 - Skip code if custom search
   begin
      if (pos(AnsiUpperCase(KeyValue),     //4/16/00 - Use AnsiUppercase instead.
          AnsiUpperCase(LookupTable.FieldByName(LookupField).asstring))<=0) then
         result:= false;
   end
end;

procedure TwwDBCustomLookupCombo.OnEditTimerEvent(Sender: TObject);
var SearchIndex: integer;
    isFound: boolean;
    SearchText: string;
    TempSearchField: string;
    PerformDropDown: boolean;
begin

   PerformDropDown:= False;
   FTimer.enabled:= False;

   if (text <> FLastSearchKey) and (LookupTable<>Nil)