dxbarextdbitems.pas

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

    LocateKey;
    FListVisible := True;
    if (ShowModal = mrOk) and FListActive then
    begin
      if FKeyField <> nil then FKeyValue := FKeyField.Value;
      KeyValueChanged;
    end;
    RowCount := FLocateList.RowCount;
    FPopupWidth := FLocateList.Width;
    ResetFindStr;
    FListVisible := False;
    Free;
    FLocateEdit := nil;
  end;
end;

function TdxBarLookupCombo.GetEditHandle: Integer;
begin
  if FLocateEdit = nil then
    Result := TCustomdxBarComboControl(CurItemLink.Control).Handle
  else
    Result := FLocateEdit.Handle;
end;

function TdxBarLookupCombo.GetEditText: string;
begin
  if FLocateEdit = nil then
    Result := CurText
  else
    Result := FLocateEdit.Text;
end;

procedure TdxBarLookupCombo.SetEditText(AText: string);
begin
  if FLocateEdit = nil then
    CurText := AText
  else
    FLocateEdit.Text := AText;
end;

function TdxBarLookupCombo.GetDropDownWindow: HWND;
begin
  Result := inherited GetDropDownWindow;
  if Result = 0 then Result := FPopupList.Handle;
end;

procedure TdxBarLookupCombo.DoKeyPress(Sender: TObject; var Key: Char);
begin
  KeyPress(Key);
end;

procedure TdxBarLookupCombo.DoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if CheckKeyForDropDownWindow(Key, Shift) then
  begin
    FLocateList.KeyDown(Key, Shift);
    Key := 0;
  end;
end;

procedure TdxBarLookupCombo.FormSize(Sender: TObject);
var
  H, W, D: Integer;
begin
  H := MulDiv(FLocateEdit.Height, 43, 42);
  W := MulDiv(H, 13, 4);
  D := FLocateEdit.Height div 4;

  FLocateEdit.SetBounds(D, D, FForm.ClientWidth - (D + D + W + D), FLocateEdit.Height);
  with FLocateList do
  begin
    Left := D;
    Top := FLocateEdit.Top + FLocateEdit.Height + D;
    Width := FLocateEdit.Width;
    Height := FForm.ClientHeight - D - Top;
  end;
  ButtonOk.SetBounds(FForm.ClientWidth - D - W, D, W, H);
  ButtonCancel.SetBounds(ButtonOk.Left, ButtonOk.Top + ButtonOk.Height + D, W, H);
end;

function TdxBarLookupCombo.CheckKeyForDropDownWindow(Key: Word; Shift: TShiftState): Boolean;
begin
//  if {(FCombo <> nil) and }(Key = VK_RETURN) then
  if Key in [VK_RETURN, VK_TAB] then
    FSetValue := True;
  Result := Key in [VK_UP, VK_LEFT, VK_DOWN, VK_RIGHT, VK_PRIOR, VK_NEXT, VK_HOME, VK_END];
end;

procedure TdxBarLookupCombo.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if Key = VK_ESCAPE then
    ResetFindStr;
  inherited KeyDown(Key, Shift);
end;

procedure TdxBarLookupCombo.KeyPress(var Key: Char);
var
  lFind, ASelectedAll: Boolean;
  AStartPos, AEndPos: Integer;
begin
  if FListField <> nil then
  try
    case Key of
      #8: // BkSpace
        begin
          SendMessage(GetEditHandle, EM_GETSEL, Longint(@AStartPos), Longint(@AEndPos));
          ASelectedAll := (AEndPos - AStartPos) = Length(EditText);
          if ASelectedAll then
          begin
            ResetFindStr;
            EditText := '';
          end
          else
            if FFindSelection then
            begin
              FFindStr := Copy(FFindStr, 0, Length(FFindStr)-1);
              SendMessage(GetEditHandle, EM_SETSEL, Length(FFindStr), Length(EditText));
            end;
        end;
      #32..#255:
        begin
          FInFindSelection := True;
          try
            if FFindSelection then begin
              FFindStr := FFindStr + Key;
            end else begin
              FFindSelection := true;
              FFindStr := Key;
            end;
            lFind := False;
            try
              lFind := FListLink.DataSet.Locate(FListField.FieldName, FFindStr, [loCaseInsensitive, loPartialKey])
            except end;
            if lFind then
            begin
              EditText := FListField.DisplayText;
              SendMessage(GetEditHandle, EM_SETSEL, Length(FFindStr), Length(EditText));
  //            FSetValue := True;
            end
            else
            begin
              if FFindSelection and (Length(FFindStr) > 1) then
              begin
                FFindStr := Copy(FFindStr, 1, Length(FFindStr)-1);
                if not FListVisible then DroppedDown := True;
              end
              else
              begin
                ResetFindStr;
                EditText := '';
              end;
              if not FListVisible then DroppedDown := True;
            end;
           if FImmediateDropDown and not FListVisible then
            begin
              DroppedDown := True;
            end;
          finally
            FInFindSelection := False;
          end;
        end;
    end;
  finally
    Key := #0;
    inherited KeyPress(Key);
  end;
end;

procedure TdxBarLookupCombo.UpdateListFields;
var
  DataSet: TDataSet;
begin
  FKeyField := nil;
  FListField := nil;
  FListFields.Clear;
  FListActive := False;
  if FListLink.Active {and (FKeyFieldName <> '') }then
  begin
    DataSet := FListLink.DataSet;
    FKeyField := DataSet.FindField(FKeyFieldName);
    try
      DataSet.GetFieldList(FListFields, FListFieldName);
    except
      raise;
    end;
    if (FListFields.Count = 0) and (FKeyField <> nil) then
      FListFields.Add(FKeyField);
    if FListFields.Count <> 0 then
      if (0 <= FListFieldIndex) and (FListFieldIndex < FListFields.Count) then
        FListField := FListFields[FListFieldIndex]
      else
        FListField := FListFields[0];
    FListActive := FListField <> nil;
  end;
  if FKeyField = nil then FKeyValue := Null;
end;

procedure TdxBarLookupCombo.ListLinkDataChanged;
begin
  if FListActive then
  begin
    if not VarIsNull(FKeyValue) and VarEquals(FKeyValue, FKeyField.Value) then
      Text := FListField.DisplayText;
  end;
end;

procedure TdxBarLookupCombo.KeyValueChanged;
begin
  if FListActive and not LocateKey then
    ListLink.DataSet.First;
  if (FListField <> nil) {and not VarIsNULL(FKeyValue) }then
    CurText := FListField.DisplayText
  else
    CurText := '';
  if Assigned(FOnKeyValueChange) then FOnKeyValueChange(Self);
  Text := CurText;  
end;

function TdxBarLookupCombo.LocateKey: Boolean;
var
  KeySave: Variant;
begin
  if FKeyField = nil then
    Result := True
  else
  begin
    Result := False;
    try
      KeySave := FKeyValue;
      if not VarIsNull(FKeyValue) and FListLink.Active and
        FListLink.DataSet.Locate(FKeyFieldName, FKeyValue, []) then
      begin
        Result := True;
        FKeyValue := KeySave;
      end;
    except
    end;
  end;
end;

procedure TdxBarLookupCombo.ResetFindStr;
begin
  FFindStr := '';
  FFindSelection := False;
//  FSetValue := False;
end;

function TdxBarLookupCombo.GetListSource: TDataSource;
begin
  Result := FListLink.DataSource;
end;

procedure TdxBarLookupCombo.SetKeyFieldName(const Value: string);
begin
  if FKeyFieldName <> Value then
  begin
    FKeyFieldName := Value;
    UpdateListFields;
  end;
end;

procedure TdxBarLookupCombo.SetKeyValue(const Value: Variant);
begin
  if not VarEquals(FKeyValue, Value) then
  begin
    FKeyValue := Value;
    KeyValueChanged;
  end;
end;

procedure TdxBarLookupCombo.SetListFieldIndex(Value: Integer);
begin
  if Value < 0 then Exit;
  FListFieldIndex := Value;
end;

procedure TdxBarLookupCombo.SetListFieldName(const Value: string);
begin
  if FListFieldName <> Value then
  begin
    FListFieldName := Value;
    UpdateListFields;
  end;
end;

procedure TdxBarLookupCombo.SetListSource(Value: TDataSource);
begin
  FListLink.DataSource := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;

procedure TdxBarLookupCombo.SetRowCount(Value: Integer);
begin
  if Value < 1 then Exit;
  FRowCount := Value;
end;

{ TdxBarLookupComboControl }

procedure TdxBarLookupComboControl.SetFocused(Value: Boolean);
var
  FCombo: TdxBarLookupCombo;
begin
  if Focused <> Value then
  begin
    inherited SetFocused(Value);
    FCombo := TdxBarLookupCombo(Item);
    if Value then
      FCombo.FCurKeyValue := FCombo.FKeyValue;
    if FCombo.FListActive and FCombo.FSetValue then
      if Value then
        FCombo.LocateKey
      else
        if (Text <> '') and (FCombo.FKeyField <> nil) then
          FCombo.KeyValue := FCombo.FKeyField.Value
        else
          FCombo.KeyValue := Null;
  end;
end;

procedure TdxBarLookupComboControl.WndProc(var Message: TMessage);
begin
  with Message do
    if (Msg = WM_KEYDOWN) and ((wParam = VK_RETURN) or (wParam = VK_TAB)) then
      with TdxBarLookupCombo(Item) do
      begin
        if FKeyField <> nil then FKeyValue := FKeyField.Value;
        KeyValueChanged;
      end;
  inherited WndProc(Message);
end;

{ TdxBarPopupLookupLink }

procedure TdxBarPopupLookupLink.ActiveChanged;
begin
  if FBarPopupLookup <> nil then FBarPopupLookup.UpdateListFields;
end;

procedure TdxBarPopupLookupLink.DataSetChanged;
begin
  if FBarPopupLookup <> nil then FBarPopupLookup.ListLinkDataChanged;
end;

procedure TdxBarPopupLookupLink.LayoutChanged;
begin
  if FBarPopupLookup <> nil then FBarPopupLookup.UpdateListFields;
end;

procedure TdxBarPopupLookupLink.DataSetScrolled(Distance: Integer);
begin
  if FBarPopupLookup <> nil then FBarPopupLookup.ListLinkDataChanged;
end;

{ TdxBarPopupLookupControl }

constructor TdxBarPopupLookupControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  ControlStyle := ControlStyle - [csCaptureMouse];

  FListLink := TdxBarPopupLookupLink.Create;
  FListLink.FBarPopupLookup := Self;
  FListFields := TList.Create;
  FRowCount := 7;
end;

destructor TdxBarPopupLookupControl.Destroy;
begin
  FListFields.Free;
  FListLink.FBarPopupLookup := nil;
  FListLink.Free;

  inherited Destroy;
end;

procedure TdxBarPopupLookupControl.WMCancelMode(var Message: TMessage);
begin
  StopTracking;
  inherited;
end;

procedure TdxBarPopupLookupControl.WMCaptureChanged(var Message: TMessage);
begin
  inherited;
  if FCloseButtonIsTracking then
  begin
    FCloseButtonIsTracking := False;
    FMouseAboveCloseButton := False;
    SendMessage(Handle, WM_NCPAINT, 0, 0);
  end;
  StopTracking;
end;

procedure TdxBarPopupLookupControl.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
  Message.Result := 1;
end;

procedure TdxBarPopupLookupControl.WMGetDlgCode(var Message: TMessage);
begin
  Message.Result := DLGC_WANTARROWS or DLGC_WANTCHARS;
end;

procedure TdxBarPopupLookupControl.WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo);
begin
  inherited;
  Message.MinMaxInfo^.ptMinTrackSize := Point(100, 100);
end;

procedure TdxBarPopupLookupControl.WMLButtonUp(var Message: TWMLButtonUp);
begin
  inherited;
  if FCloseButtonIsTracking then
  begin
    FCloseButtonIsTracking := False;
    ReleaseCapture;
    if FMouseAboveCloseButton then
      FCombo.BarManager.HideAll
    else
      SendMessage(Handle, WM_NCPAINT, 0, 0);
  end;
end;

procedure TdxBarPopupLookupControl.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
  inherited;
  if IsPopup then
    Painter.SysPanelCalcSize(Handle, Message.CalcSize_Params^.rgrc[0],
      FCorner, FCombo, FCombo.AllowResizing);
end;

procedure TdxBarPopupLookupControl.WMNCHitTest(var Message : TWMNCHITTEST);
var
  PrevMouseAboveCloseButton: Boolean;
begin
  inherited;
  with Message do
    if PtInRect(FGripRect, SmallPointToPoint(Pos)) then
      Result := GetHitTestByCorner(FCorner)
    else
    begin
      PrevMouseAboveCloseButton := FMouseAboveCloseButton;
      FMouseAboveCloseButton := (GetTopWindow(0) = Handle) and
        ((GetCapture = 0) or FCloseButtonIsTracking) and
        PtInRect(FCloseButtonRect, SmallPointToPoint(Pos));
      if FMouseAboveCloseButton then Result := HTBORDER;
      if PrevMouseAboveCloseButton <> FMouseAboveCloseButton then
        SendMessage(Handle, WM_NCPAINT, 0, 0);
    end;
end;

procedure TdxBarPopupLookupControl.WMNCLButtonDown(var Message: TWMNCLButtonDown);
begin
  inherited;
  if FMouseAboveCloseButton then
  begin
    FCloseButtonIsTracking := True;
    SetCapture(Handle);
    SendMessage(Handle, WM_NCPAINT, 0, 0);
  end;
end;

procedure TdxBarPopupLookupControl.WMNCPaint(var Message: TWMNCPaint);
begin
  inherited;
  if IsPopup then
    Painter.SysPanelDraw(Handle, FCombo.AllowResizing,
      FMouseAboveCloseButton, FCloseButtonIsTracking, FCloseButtonRect, FGripRect, FCorner);
end;

procedure TdxBarPopupLookupControl.WMSize(var Message: TWMSize);
var
  TextHeight, Rows: Integer;
begin
  inherited;
  TextHeight := GetTextHeight;
  Rows := Message.Height div TextHeight;
  if Rows < 1 then Rows := 1;
  FRowCount := Rows;