tntlookupcomboboxex.pas

TntExUpdate 是 流行的 TntUnicodeControls控件的扩展包.包括很难找到的 TntJVCL 也在里面. TntSysUtils2.pas/TntSysUtilsEx.pa

    if Assigned(FOnSetupDataSource) then
      FOnSetupDataSource(Self, Text);
    ClearColumns;
    FCancelFlag := False;
    OnMouseUp := Self.GridMouseUp;
    DataSource := Self.ListSource;
    FieldPos := 1;
    while FieldPos <= Length(ListField) do
    begin
      FieldLength := 0;
      while (ListField[FieldPos + FieldLength] <> ';')
        and (FieldPos + FieldLength <= Length(ListField)) do
        Inc(FieldLength);
      CurrentField := Copy(ListField, FieldPos, FieldLength);
      Inc(FieldPos, FieldLength + 1);
      with Columns.Add do
      begin
        FieldName := CurrentField;
        {Width:=DataSource.Dataset.
           FieldByName(CurrentField).DisplayWidth*
           Defau;}
      end;
    end;
    FShowing := True;
    FForm.Font := Self.Font;
    FForm.Visible := True;
    SetFocus;
  end;
end;

procedure TTntCustomDynLookupComboBox.GridKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_RETURN) or (Key = VK_ESCAPE) then
  begin
    FCancelFlag := (Key = VK_ESCAPE);
    Key := 0;
    LeavePopup(Sender);
  end
end;

procedure TTntCustomDynLookupComboBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
end;

procedure TTntCustomDynLookupComboBox.LeavePopup(Sender: TObject);
begin
  if not FLeavingPopup then
  begin
    FLeavingPopup := True;
    try
      if not FCancelFlag then
      begin
        if (Assigned(FGrid)) and (FGrid.Columns.Count > 0) and (FGrid.DataSource <> nil) then
          Text := GetAsWideString(FGrid.Columns[FListIndex].Field);
      end;
      try
        if Assigned(FOnCloseUp) then
          FOnCloseUp(Self, not FCancelFlag);
      finally
        FCancelFlag := False;
        FShowing := False;
        FForm.Visible := False;
      end;
    finally
      FLeavingPopup := False;
    end;
  end;
end;

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

procedure TTntCustomDynLookupComboBox.GridMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  LeavePopup(Sender);
end;

{ TTntDBDynLookupComboBox }

constructor TTntDBDynLookupComboBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnUpdateData := UpdateData;
  FDataLink.OnEditingChange := EditingChange;
  FPaintControl := TTntPaintControl.Create(Self, 'COMBOBOX');
end;

destructor TTntDBDynLookupComboBox.Destroy;
begin
  FPaintControl.Free;
  FDataLink.Free;
  FDataLink := nil;
  inherited Destroy;
end;

procedure TTntDBDynLookupComboBox.Loaded;
begin
  inherited Loaded;
  if (csDesigning in ComponentState) then
    DataChange(Self);
end;

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

procedure TTntDBDynLookupComboBox.CreateWnd;
begin
  inherited CreateWnd;
end;

procedure TTntDBDynLookupComboBox.DataChange(Sender: TObject);
begin
  if not (Style = csSimple) and DroppedDown then
    Exit;
  if FDataLink.Field <> nil then
    SetComboText(GetAsWideString(FDataLink.Field))
  else if csDesigning in ComponentState then
    SetComboText(Name)
  else
    SetComboText('');
end;

procedure TTntDBDynLookupComboBox.UpdateData(Sender: TObject);
begin
  SetAsWideString(FDataLink.Field, GetComboText);
end;

procedure TTntDBDynLookupComboBox.SetComboText(const Value: WideString);
var
  I: Integer;
  Redraw: Boolean;
begin
  if Value <> GetComboText then
  begin
    if Style <> csDropDown then
    begin
      Redraw := (Style <> csSimple) and HandleAllocated;
      if Redraw then
        SendMessage(Handle, WM_SETREDRAW, 0, 0);
      try
        if Value = '' then
          I := -1
        else
          I := Items.IndexOf(Value);
        ItemIndex := I;
      finally
        if Redraw then
        begin
          SendMessage(Handle, WM_SETREDRAW, 1, 0);
          Invalidate;
        end;
      end;
      if I >= 0 then
        Exit;
    end;
    if Style in [csDropDown, csSimple] then
      Text := Value;
  end;
end;

function TTntDBDynLookupComboBox.GetComboText: WideString;
var
  I: Integer;
begin
  if Style in [csDropDown, csSimple] then
    Result := Text
  else
  begin
    I := ItemIndex;
    if I < 0 then
      Result := ''
    else
      Result := Items[I];
  end;
end;

procedure TTntDBDynLookupComboBox.Change;
begin
  if FDataLink.Edit then
  begin
    inherited Change;
    FDataLink.Modified;
  end;
end;

procedure TTntDBDynLookupComboBox.Click;
begin
  if FDataLink.Edit then
  begin
    inherited Click;
    FDataLink.Modified;
  end;
end;

function TTntDBDynLookupComboBox.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TTntDBDynLookupComboBox.SetDataSource(Value: TDataSource);
begin
  if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
    FDataLink.DataSource := Value;
  if Value <> nil then
    Value.FreeNotification(Self);
end;

function TTntDBDynLookupComboBox.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

procedure TTntDBDynLookupComboBox.SetDataField(const Value: string);
begin
  FDataLink.FieldName := Value;
end;

function TTntDBDynLookupComboBox.GetReadOnly: Boolean;
begin
  Result := FDataLink.ReadOnly;
end;

procedure TTntDBDynLookupComboBox.SetReadOnly(Value: Boolean);
begin
  FDataLink.ReadOnly := Value;
end;

function TTntDBDynLookupComboBox.GetField: TField;
begin
  Result := FDataLink.Field;
end;

procedure TTntDBDynLookupComboBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  if Key in [VK_BACK, VK_DELETE, VK_UP, VK_DOWN, 32..255] then
  begin
    if not FDataLink.Edit and (Key in [VK_DELETE, VK_UP, VK_DOWN]) then
      Key := 0;
  end;
end;

procedure TTntDBDynLookupComboBox.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
    not FDataLink.Field.IsValidChar(Key) then
  begin
    MessageBeep(0);
    Key := #0;
  end;
  case Key of
    ^H, ^V, ^X, #32..#255:
      if not FDataLink.Edit then
        Key := #0;
    #27:
      begin
        FDataLink.Reset;
        SelectAll;
      end;
  end;
end;

procedure TTntDBDynLookupComboBox.EditingChange(Sender: TObject);
begin
end;

procedure TTntDBDynLookupComboBox.DropDown;
begin
  if not FDataLink.Edit then
  begin
    DroppedDown := False;
  end
  else
    inherited DropDown;
end;


procedure TTntDBDynLookupComboBox.CMEnter(var Message: TCMEnter);
begin
  inherited;
  if SysLocale.FarEast and FDataLink.CanModify then
    ReadOnly := False;
end;

procedure TTntDBDynLookupComboBox.CMExit(var Message: TCMExit);
begin
  try
    FDataLink.UpdateRecord;
  except
    SelectAll;
    SetFocus;
    raise;
  end;
  inherited;
end;

procedure TTntDBDynLookupComboBox.WMPaint(var Message: TWMPaint);
var
  S: WideString;
begin
  if csPaintCopy in ControlState then
  begin
    if FDataLink.Field <> nil then
      S := GetWideText(FDataLink.Field)
    else
      S := '';
    TntDBComboBox_WMPaint(Message.DC, FPaintControl, Style, S, Items.IndexOf(S) <> -1);
  end else
    inherited;
end;

procedure TTntDBDynLookupComboBox.SetItems(Value: TTntStrings);
begin
  Items.Assign(Value);
  DataChange(Self);
end;

procedure TTntDBDynLookupComboBox.SetStyle(Value: TComboboxStyle);
begin
  if (Value = csSimple) and Assigned(FDatalink) and FDatalink.DatasourceFixed then
    DatabaseError(SNotReplicatable);
  inherited SetStyle(Value);
end;

function TTntDBDynLookupComboBox.UseRightToLeftAlignment: Boolean;
begin
  Result := DBUseRightToLeftAlignment(Self, Field);
end;

procedure TTntDBDynLookupComboBox.CMGetDatalink(var Message: TMessage);
begin
  Message.Result := Integer(FDataLink);
end;

function TTntDBDynLookupComboBox.ExecuteAction(Action: TBasicAction): Boolean;
begin
  Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
    FDataLink.ExecuteAction(Action);
end;

function TTntDBDynLookupComboBox.UpdateAction(Action: TBasicAction): Boolean;
begin
  Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
    FDataLink.UpdateAction(Action);
end;

procedure TTntCustomDynLookupComboBox.WMSetFocus(var Message: TWMSetFocus);
begin
  inherited;
  FJustLeftGrid := False;
end;

procedure TTntCustomDynLookupComboBox.CMCancelMode(
  var Message: TCMCancelMode);
begin
  Message.Result := 0;
end;

procedure TTntDBDynLookupComboBox.LeavePopup(Sender: TObject);
begin
  inherited;
  if not CancelFlag then
  try
    FDataLink.Modified;
    FDataLink.UpdateRecord;
  except
    SetFocus;
    raise;
  end;
end;

procedure TTntDBDynLookupComboBox.WndProc(var Message: TMessage);
begin
  with Message do
    if (Msg = WM_CREATE) or (Msg = WM_WINDOWPOSCHANGED) or
      (Msg = CM_TEXTCHANGED) or (Msg = CM_FONTCHANGED) then
      FPaintControl.DestroyHandle;
  inherited;
end;

procedure TTntCustomDynLookupComboBox.SetGridWidth(const Value: Integer);
begin
  FGridWidth := Value;
end;

{ TTntCustomValueComboBox }

procedure LoadValueComboBox(C: TTntCustomValueComboBox; DataSet: TDataSet;
  const FieldName, FieldValueName: string);
begin
  WideLoadDataColumnValues(C.Items, C.Values, DataSet, FieldName, FieldValueName);
end;

procedure TTntCustomValueComboBox.Clear;
begin
  Items.Clear;
  Values.Clear;
end;

constructor TTntCustomValueComboBox.Create(AOwner: TComponent);
begin
  inherited;
  FValues := TTntStringList.Create;
  Style := csDropDownList;
end;

destructor TTntCustomValueComboBox.Destroy;
begin
  FValues.Free;
  inherited;
end;

function TTntCustomValueComboBox.GetValue: WideString;
begin
  if (ItemIndex <> -1) and (ItemIndex < FValues.Count) then
    Result := FValues[ItemIndex]
  else
    Result := '';
end;

procedure TTntCustomValueComboBox.SetStyle(Value: TComboBoxStyle);
begin
  if (Value in [csSimple, csDropDown]) then
    Value := csDropDownList;
  inherited SetStyle(Value);
end;

procedure TTntCustomValueComboBox.SetValue(const Value: WideString);
begin
  ItemIndex := FValues.IndexOf(Value);
end;

procedure TTntCustomValueComboBox.SetValues(const Value: TTntStrings);
begin
  FValues.Assign(Value);
end;


end.