adbcombo.pas

来自「delphi编程控件」· PAS 代码 · 共 851 行 · 第 1/2 页

     AscOrder: SQL.Add('Order by 1 ASC');
     DescOrder: SQL.Add('Order by 1 DESC');
     SmartOrder: SQL.Add('Group by ' + FFieldName + ' Order by 2 DESC');
    end;
    if Assigned(FOnBeforeRefresh) then
      FOnBeforeRefresh(self, SQL);
  end;
  try
    Query.Active := Active;
  except
    raise;
  end;
  if Not (FLoadPartial) then begin
    Items.Clear;
    if Query.Active then
      with Query do  begin
        First;
        while Not EOF do begin
          Items.Add(Query.Fields[0].Text);
          Next;
        end;
        First;
      end;
  end;

end;

function TAutoCustomDBComboBox.LoadRecords : Boolean;
begin
  InitQuery(True);
  Result := Query.Active;
end;

procedure TAutoCustomDBComboBox.UpdateComboLBoxData;
Var
  i, OldIndex : Integer;
begin

  UpdateFlag := True;
  if(DropDownCount  <> FDataLink.BufferCount) then
     FDataLink.BufferCount := DropDownCount;

  SendMessage(Handle, CB_RESETCONTENT, 0, 0);

  OldIndex := FDataLink.ActiveRecord;

  for i := 0 to FDataLink.RecordCount - 1 do begin
    FDataLink.ActiveRecord := i;
    SendMessage(Handle, CB_ADDSTRING, 0, Longint(PChar(FQuery.Fields[0].Text)));
  end;

  FDataLink.ActiveRecord := OldIndex;
  UpdateFlag := False;
  ItemIndex := FDataLink.ActiveRecord;
  FroseSetCurSel := True;
end;

procedure TAutoCustomDBComboBox.SetDataBaseName(Value : TFileName);
begin
  if(FDataBaseName <> Value) then begin
    FDataBaseName := Value;
    InitQuery(FQuery.Active);
  end;  
end;

procedure TAutoCustomDBComboBox.SetFieldName(Value : String);
begin
  if(FFieldName <> Value) then begin
    FFieldName := Value;
    InitQuery(FQuery.Active);
  end;
end;

procedure TAutoCustomDBComboBox.SetDBComboBoxOrder(Value : TDBComboBoxOrder);
begin
  if(Value <> FDBComboBoxOrder) then begin
    FDBComboBoxOrder := Value;
    InitQuery(FQuery.Active);
  end;  
end;

procedure TAutoCustomDBComboBox.SetLoadPartial(Value : Boolean);
begin
  if(FLoadPartial <> Value) then begin
    FLoadPartial := Value;
    InitQuery(FQuery.Active);
  end;
end;

procedure TAutoCustomDBComboBox.SetTableName(Value : TFileName);
begin
  if(FTableName <> Value) then begin      
    FTableName := Value;
    InitQuery(FQuery.Active);
  end;
end;


{ TAutoDBComboBox }

constructor TAutoDBComboBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];
  FDataFieldLink := TFieldDataLink.Create;
  FDataFieldLink.Control := Self;
  FDataFieldLink.OnDataChange := DataChange;
  FDataFieldLink.OnUpdateData := UpdateData;
  FDataFieldLink.OnActiveChange := ActiveChange;
  FDataFieldLink.OnEditingChange := EditingChange;
end;

destructor TAutoDBComboBox.Destroy;
begin
  FDataFieldLink.Free;
  FDataFieldLink := nil;
  inherited Destroy;
end;

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

procedure TAutoDBComboBox.CreateWnd;
begin
  inherited CreateWnd;
  SetEditReadOnly;
end;

procedure TAutoDBComboBox.ActiveChange(Sender: TObject);
begin
  DataSetChanged(FDataLink.DataSet);
end;

procedure TAutoDBComboBox.DataChange(Sender: TObject);
begin
  if FDataFieldLink.Field <> nil then
    SetComboText(FDataFieldLink.Field.Text)
  else
    if csDesigning in ComponentState then
      SetComboText(Name)
    else
      SetComboText('');
end;

procedure TAutoDBComboBox.UpdateData(Sender: TObject);
begin
  FDataFieldLink.Field.Text := GetComboText;
end;

procedure TAutoDBComboBox.SetComboText(const Value: string);
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;

procedure TAutoDBComboBox.Change;
begin
  FDataFieldLink.Edit;
  inherited Change;
  FDataFieldLink.Modified;
end;

procedure TAutoDBComboBox.Click;
begin
  FDataFieldLink.Edit;
  inherited Click;
  FDataFieldLink.Modified;
end;

procedure TAutoDBComboBox.DropDown;
begin
  FDataFieldLink.Edit;
  inherited DropDown;
end;

function TAutoDBComboBox.GetDataSource: TDataSource;
begin
  Result := FDataFieldLink.DataSource;
end;

procedure TAutoDBComboBox.SetDataSource(Value: TDataSource);
begin
  FDataFieldLink.DataSource := Value;
  if Value <> nil then  Value.FreeNotification(Self);
end;

function TAutoDBComboBox.GetDataField: string;
begin
  Result := FDataFieldLink.FieldName;
end;

procedure TAutoDBComboBox.SetDataField(const Value: string);
begin
  if(FDataFieldLink.FieldName <> Value) then begin
    FDataFieldLink.FieldName := Value;
    FieldName := Value;
  end;
end;

function TAutoDBComboBox.GetReadOnly: Boolean;
begin
  Result := FDataFieldLink.ReadOnly;
end;

procedure TAutoDBComboBox.SetReadOnly(Value: Boolean);
begin
  FDataFieldLink.ReadOnly := Value;
end;

function TAutoDBComboBox.GetField: TField;
begin
  Result := FDataFieldLink.Field;
end;

procedure TAutoDBComboBox.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 FDataFieldLink.Edit and (Key in [VK_UP, VK_DOWN]) then
      Key := 0;
  end;
end;

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

procedure TAutoDBComboBox.EditingChange(Sender: TObject);
begin
  SetEditReadOnly;
end;

procedure TAutoDBComboBox.SetEditReadOnly;
begin
  if (Style in [csDropDown, csSimple]) and HandleAllocated then
    SendMessage(EditHandle, EM_SETREADONLY, Ord(not FDataFieldLink.Editing), 0);
end;

procedure TAutoDBComboBox.WndProc(var Message: TMessage);
begin
  if not (csDesigning in ComponentState) then
    case Message.Msg of
      WM_COMMAND:
        if TWMCommand(Message).NotifyCode = CBN_SELCHANGE then
          if not FDataFieldLink.Edit then
          begin
            if Style <> csSimple then
              PostMessage(Handle, CB_SHOWDROPDOWN, 0, 0);
            Exit;
          end;
      CB_SHOWDROPDOWN:
        if Message.WParam <> 0 then FDataFieldLink.Edit else
          if not FDataFieldLink.Editing then DataChange(Self);
    end;
  inherited WndProc(Message);
end;

procedure TAutoDBComboBox.ComboWndProc(var Message: TMessage; ComboWnd: HWnd;
  ComboProc: Pointer);
begin
  if not (csDesigning in ComponentState) then
    case Message.Msg of
      WM_LBUTTONDOWN:
        if (Style = csSimple) and (ComboWnd <> EditHandle) then
          if not FDataFieldLink.Edit then Exit;
    end;
  inherited ComboWndProc(Message, ComboWnd, ComboProc);
end;

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

procedure TAutoDBComboBox.CMGetDatalink(var Message: TMessage);
begin
  Message.Result := Integer(FDataFieldLink);
end;


{TAutoDBComboBoxLocate }
constructor TAutoDBComboBoxLocate.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];
  FDataFieldLink := TFieldDataLink.Create;
  FDataFieldLink.Control := Self;
  FDataFieldLink.OnActiveChange := ActiveChange;  
  FOldLocateSt := '';
end;

destructor TAutoDBComboBoxLocate.Destroy;
begin
  FDataFieldLink.Free;
  inherited Destroy;
end;

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

procedure TAutoDBComboBoxLocate.ActiveChange(Sender: TObject);
begin
  DataSetChanged(FDataLink.DataSet);
end;

procedure TAutoDBComboBoxLocate.Change;
begin
  Locate;
end;

procedure TAutoDBComboBoxLocate.Click;
begin
  Locate;
end;

function TAutoDBComboBoxLocate.GetDataSource: TDataSource;
begin
  Result := FDataFieldLink.DataSource;
end;

procedure TAutoDBComboBoxLocate.SetDataSource(Value: TDataSource);
begin
  FDataFieldLink.DataSource := Value;
  if Value <> nil then  Value.FreeNotification(Self);
end;

function TAutoDBComboBoxLocate.GetDataField: string;
begin
  Result := FDataFieldLink.FieldName;
end;

procedure TAutoDBComboBoxLocate.SetDataField(const Value: string);
begin
  if(FDataFieldLink.FieldName <> Value) then begin
    FDataFieldLink.FieldName := Value;
    FieldName := Value;
  end;
end;

function TAutoDBComboBoxLocate.GetField: TField;
begin
  Result := FDataFieldLink.Field;
end;

procedure TAutoDBComboBoxLocate.KeyPress(var Key: Char);
begin
  if (Key in [#32..#255]) and (FDataFieldLink.Field <> nil) and
    not FDataFieldLink.Field.IsValidChar(Key) then begin
    MessageBeep(0);
    Key := #0;
  end;
  inherited KeyPress(Key);
  Locate;
end;

procedure TAutoDBComboBoxLocate.Locate;
Var
  St : String;
begin
  if Field = Nil then exit;
  St := GetComboText;
  if(FOldLocateSt <> St) then begin
    FOldLocateSt := St;
    if(St <> '') then
      FDataLink.DataSet.Locate(Field.FieldName, St, FOptions);
  end;
end;

end.