wwkeycb.pas

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

                 isFound:= wwDataSetFindRecord(DataSet, Text, TempSearchField, mtPartialMatchStart, False);
            except { 7/1/97 - In case of capability not supported }
              isFound:= wwDataSetFindRecord(DataSet, Text, TempSearchField, mtPartialMatchStart, False);
            end;
            Screen.cursor:= crDefault;
         end
      end;
      {$else}
      isFound:= wwDataSetFindRecord(DataSet, Text, TempSearchField, mtPartialMatchStart, False);
      {$endif}

   end;

   if Assigned(FOnAfterSearch) then FOnAfterSearch(self, isFound);

   if FShowMatchText and isFound then begin
      SearchText:= Text;
      TempText:= '';
      APos:= 1;
      repeat
        // 2/14/04 - Should not exit if tempSearchField is blank, but instead use index field
        if tempSearchField<>'' then
        begin
          curSearchField:= strGetToken(tempSearchField, ';', APos);
          if CurSearchField='' then break;
        end;

        if TempText<>'' then TempText:= TempText + ';';
        if isQuery then
           TempText:=  TempText + DataSource.DataSet.FieldByName(CurSearchField).asString
        else if (TempSearchField<>'') then
           TempText:=  TempText + DataSource.DataSet.FieldByName(CurSearchField).asString
        else begin
           TempText:=  (DataSource.DataSet as TTable).IndexFields[0].asString;
           break; // 7/8/04 - break or infinit loop
        end
      until False;

      Text:= TempText;

      selStart:= length(SearchText);
      selLength:= length(Text)-length(SearchText)
   end
end;

Function TwwIncrementalSearch.FindSearchField: string;
var
   dataSet : TDataSet;
   tempSearchField: wwSmallString;
   {$ifdef wwDelphi3Up}
   IndexDefs: TIndexDefs;
   apos, idx: integer;
   {$endif}
   PropInfo: PPropInfo;

    function GetIndexName: string;
    begin
       PropInfo:= Typinfo.GetPropInfo(DataSource.DataSet.ClassInfo,'IndexName');
       if PropInfo<>Nil then Result:= GetStrProp(DataSource.DataSet, PropInfo);
    end;

begin
   if dataSource=Nil then exit;
   if dataSource.dataSet=Nil then exit;
   if not dataSource.dataset.Active then exit;
   dataSet := dataSource.DataSet as TDataSet;
   TempSearchField:= SearchField;

   if not (dataSet is TBDEDataset) then begin
      PropInfo:= Typinfo.GetPropInfo(DataSource.DataSet.ClassInfo,'IndexDefs');
      if PropInfo<>Nil then begin
         IndexDefs:= TIndexDefs(GetOrdProp(DataSource.DataSet, PropInfo));
         idx:= IndexDefs.indexof(GetIndexName);
         if idx>=0 then begin
            APos:= 1;
            if TempSearchField='' then
               TempSearchField:= strGetToken(IndexDefs.items[idx].fields, ';', APos);
         end
      end
   end;

   if (dataSet is TTable) then begin
     with (DataSet as TTable) do
        if not wwIsTableQuery(DataSet) and (IndexDefs.count=0) then IndexDefs.update;  { refreshes Index list }

     if ((dataset as TTable).indexFieldCount=0) then begin
        if SearchField='' then TempSearchField:= dataset.fields[0].FieldName
        else TempSearchField:= SearchField;
     end
     else begin
        if (DataSet as TTable).indexFieldCount>0 then
           TempSearchField:= (Dataset as TTAble).indexFields[0].FieldName;
     end
   end
   else begin
      if (SearchField='') and (TempSearchField='') then
         TempSearchField:= dataset.fields[0].FieldName
      else TempSearchField:= SearchField;
   end;
   result:= TempSearchField;
end;

procedure TwwIncrementalSearch.SetSearchField(ASearchField: string);
begin
   SearchField:= ASearchField;
end;

procedure TwwIncrementalSearch.Clear;
begin
   Text:= '';
   LastValue:= '';
end;

procedure TwwKeyCombo.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and
    (AComponent = DataSource) then DataSource := nil;
end;


procedure TwwIncrementalSearch.KeyPress(var Key: Char);
var tempSearchField: string;
    Mask: string;
    dummy1, dummy2: boolean;
begin
  inherited KeyPress(Key);

  if FPictureMask<>'' then
     wwApplyPictureMask(self, PictureMask, PictureMaskAutoFill, Key)
  else if FPictureMaskFromField then
  begin
     tempSearchField:= FindSearchField;
     if tempSearchField='' then exit;
     wwPictureByField(datasource.dataset, TempSearchField, False, Mask,
                      dummy1, dummy2);
     if Mask<>'' then
        wwApplyPictureMask(self, Mask, PictureMaskAutoFill, Key)
  end
end;

procedure TwwKeyDataLink.DataSetChanged;
begin
  FwwKeyCombo.DataChanged;
end;

procedure TwwKeyCombo.DataChanged;
begin
  if Patch[0]=True then exit; // not SkipRefresh
  if not HandleAllocated then Exit;
  if Datasource.state=dsBrowse then RefreshDisplay;
end;

function TwwIncrementalSearch.isTransparentEffective: boolean;
begin
   result:= Frame.Transparent and Frame.enabled and
      not (csDesigning in ComponentState) {UnderlineControl}
end;

procedure TwwIncrementalSearch.CreateParams(var Params: TCreateParams);
begin
   inherited CreateParams(Params);

   if (BorderStyle = bsNone) then begin
      Params.Style:= Params.Style or ES_MULTILINE;

     { 5/19/00 - Carriage return going to next line when borderstyle=bsnone }
     Params.Style := Params.Style and not (ES_AUTOVSCROLL or ES_WANTRETURN);
   end;

   if Frame.enabled then Params.Style:= Params.Style and not WS_BORDER;

   if IsTransparentEffective and Frame.CreateTransparent then
     Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
end;

procedure TwwIncrementalSearch.CMEnter(var Message: TCMEnter);
var exStyle, origStyle: longint;
begin
  SetEditRect;

  FFocused:= True;
  if AutoSelect and not (csLButtonDown in ControlState) then SelectAll;
  
  inherited;

  if IsTransparentEffective then begin
     Frame.CreateTransparent:= False;
     OrigStyle:= Windows.GetWindowLong(handle, GWL_EXSTYLE);
     exStyle:= OrigStyle and not WS_EX_TRANSPARENT;
     Windows.SetWindowLong(handle, GWL_EXSTYLE, exStyle);
     invalidate;
  end;

  if Frame.enabled then invalidate; { See if this causes any flicker }
end;

procedure TwwIncrementalSearch.CMExit(var Message: TCMExit);
begin
  inherited;

  FFocused:= False;
  if IsTransparentEffective then begin
     Frame.CreateTransparent:= True;
     RecreateWnd;
  end;

  if Frame.enabled then
  begin
     invalidate; { See if this causes any flicker }
     wwInvalidateTransparentArea(self, True);
  end;
end;

procedure TwwIncrementalSearch.CreateWnd;
begin
   inherited CreateWnd;
   if (BorderStyle=bsNone) and AutoSize then Frame.AdjustHeight;
   SetEditRect;

   if IsTransparentEffective then
   begin
     wwDisableParentClipping(Parent);
   end
end;


procedure TwwIncrementalSearch.SetEditRect;
var
  Loc: TRect;
begin
  if not Frame.enabled then exit;

  Loc.Bottom :=ClientHeight+1;
  Loc.Right := ClientWidth-1;

  Frame.GetEditRectForFrame(Loc);
  SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Loc));
end;


procedure TwwIncrementalSearch.WMPaint(var Message: TWMPaint);
var
  PS: TPaintStruct;
  Indent, Left: Integer;
  ARect: TRect;
  DC: HDC;
  TempLeft, TempIndent: integer;
  WriteOptions: TwwWriteTextOptions;
//  r: TRect;

  procedure CanvasNeeded;
  begin
    if FCanvas = nil then
    begin
      FCanvas := TControlCanvas.Create;
      FCanvas.Control := Self;
    end;
  end;

begin
  if ((not Frame.enabled) or FFocused) then
  begin
     inherited;
     if Frame.enabled then
     begin
       CanvasNeeded;
       FCanvas.Handle:= message.DC;
       wwDrawEdge(self, Frame, FCanvas, FFocused);
       FCanvas.Handle:= 0;
     end;
     Exit;
  end;

  { if not editable with focus, need to do drawing to show proper focus }
  CanvasNeeded;

  DC := Message.DC;
  if DC = 0 then DC := BeginPaint(Handle, PS);
  FCanvas.Handle := DC;
  try
    FCanvas.Font := Font;

    with FCanvas do
    begin
      ARect := ClientRect;

      if (not enabled) and (color<>clInactiveCaption) then font.color:= clInactiveCaption;
      Brush.Color := Color;

      // 4/15/01 - Back-color support
      if (not IsTransparentEffective) then
      begin
         if Frame.Enabled and (not FFocused) and (Frame.NonFocusColor<>clNone) then
         begin
            Brush.Color:= Frame.NonFocusColor;
            FillRect (ARect);
         end
      end;

      ARect:= ClientRect;
      InflateRect(ARect, -1, -1);  {Added for csDropDownList style }

//      Width := TextWidth(Text);

      Indent:= 1;

      if Frame.enabled then {IsTransparentEffective then}
      begin
         Frame.GetFrameTextPosition(Left, Indent, FFocused);
      end
      else Left:= Indent + 1;

      { 12/20/96 - Support multiple lines }
      TempIndent:= Indent;
      TempLeft:= Left;

      WriteOptions:= [wtoTransparent];

      if (not FFocused) and IsTransparentEffective and (Frame.NonFocusTransparentFontColor<>clNone) then
         FCanvas.Font.Color:= Frame.NonFocusTransparentFontColor
      // 4/15/01
      else if (not FFocused) and (Frame.Enabled) and
              (Frame.NonFocusFontColor<>clNone) then
         FCanvas.Font.Color:= Frame.NonFocusFontColor;

      wwWriteTextLinesT(FCanvas, ARect, TempLeft-1, TempIndent-1,
                Pchar(Text), taLeftJustify, WriteOptions);

    end;

    if Frame.enabled then
    begin
       wwDrawEdge(self, Frame, FCanvas, FFocused);
    end;

  finally
    FCanvas.Handle := 0;
    if Message.DC = 0 then EndPaint(Handle, PS);
  end;
end;

procedure TwwIncrementalSearch.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
  if (IsTransparentEffective and not FFocused) then
  begin
     Message.result:= 1;
  end
  else
     inherited;
end;

procedure TwwIncrementalSearch.CNKeyDown(var Message: TWMKeyDown);
begin
  if not (csDesigning in ComponentState) then with Message do
  begin
       { 1/4/2000 es_multiline style does not pass carriage return/line feed to form so
         we pass it ourselves }
       if ((charcode=vk_return) or (charcode=vk_escape)) then
       begin
//          if (not modified) or (charcode = vk_return) then { 5/19/00 - This test causes escape to fail when its modified }
            if (Windows.GetWindowLong(handle, GWL_STYLE) and es_multiline)<>0 then
            begin
               SendMessage(GetParent(Handle), TMessage(Message).Msg,
                 TMessage(Message).wParam, TMessage(Message).lParam);
            end
       end;
  end;
  inherited; { 1/31/2000 - Fix problem of tab not being passed }
end;

// 11/9/01 - Some fonts change the margin, so let us reset back to 0 so that
// borders will be ok
procedure TwwIncrementalSearch.WMSetFont(var Message: TWMSetFont);
begin
  inherited;
  if Frame.Enabled and NewStyleControls then
     SendMessage(Handle, EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, 0);
end;

procedure TwwIncrementalSearch.SetController(Value: TwwController);
begin
   if FController<>Value then
   begin
      wwUpdateController(TComponent(FController), Value, self);
      if FController<>nil then
      begin
         FFrame.Assign(FController.Frame);
         if HandleAllocated then RecreateWnd;
      end
   end
end;

procedure TwwIncrementalSearch.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) then begin
     if (AComponent = FController) then FController:= nil;
  end;

end;



end.