dbtreecbox.pas

delphi编程控件

    if not (dtKeepDataSetConnected in Options) then
      FTreeSelect.DBTreeView.DataSource := nil;
    FFSearchText := '';
    FListVisible := True; { CanModify cannot get true if FListVisible = False }
    if (Action <> caCancel) and CanModify then
      SelectKeyValue(ListValue);
    FListVisible := False;
    if Assigned(FOnCloseUp) then
      FOnCloseUp(Action);
    FNoMouseDropDown := true;
    Invalidate;
  end;
end;

procedure TDbTreeLookupComboBox.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    if NewStyleControls and Ctl3D then
      ExStyle := ExStyle or WS_EX_CLIENTEDGE
    else
      Style := Style or WS_BORDER;
  end;
end;

function GetScreenRect: TRect;
{ Get the rect a window can use without getting hidden by the Win95-Taskbar.
  Thanks to Peter M. Jagielski ([e-mail]) for contributing
  an idea how to do this (procedure SizeForTaskBar in sizetask.zip). }
var
  TaskBarHandle: HWnd;   { Handle to the Win95 Taskbar }
  TaskBarCoord: TRect;   { Coordinates of the Win95 Taskbar }
  CxScreen: Integer;     { Width of screen in pixels }
  CyScreen: Integer;     { Height of screen in pixels }
  CxFullScreen: Integer; { Width of client area in pixels }
  CyFullScreen: Integer; { Heigth of client area in pixels }
  CyCaption: Integer;    { Height of a window's title bar in pixels }
begin
  result.Left := 0;
  result.Top := 0;
{ Get Win95 Taskbar handle: }
  TaskBarHandle := FindWindow('Shell_TrayWnd', nil);
  if (TaskBarHandle = 0) then
  begin
  { We're running WinNT w/o Win95 shell, so use TScreen-values: }
    result.Right := Screen.Width - 1;
    result.Bottom := Screen.Height - 1;
  end
  else { We're running Win95 or WinNT w/Win95 shell: }
  begin
  { Get coordinates of Win95 Taskbar: }
    GetWindowRect(TaskBarHandle, TaskBarCoord);
  { Get various screen dimensions: }
    CxScreen := GetSystemMetrics(SM_CXSCREEN);
    CyScreen := GetSystemMetrics(SM_CYSCREEN);
    CxFullScreen := GetSystemMetrics(SM_CXFULLSCREEN);
    CyFullScreen := GetSystemMetrics(SM_CYFULLSCREEN);
    CyCaption     := GetSystemMetrics(SM_CYCAPTION);
    result.Right  := CxScreen - (CxScreen - CxFullScreen) - 1;
    result.Bottom := CyScreen - (CyScreen - CyFullScreen) + CyCaption - 1;
  { look if Taskbar is on either top or left: }
    if (TaskBarCoord.Top = -2) and (TaskBarCoord.Left = -2) then
      if TaskBarCoord.Right > TaskBarCoord.Bottom then
      { Taskbar on top }
        result.Top  := TaskBarCoord.Bottom
      else
      { Taskbar on left }
        result.Left := TaskBarCoord.Right;
  end;
end;

procedure TDbTreeLookupComboBox.DropDown;
var
  ComboBoxOrigin: TPoint;
  X: Integer;
  Y: Integer;
  ScreenRect: TRect;
{ I: Integer; S: string; }
begin
  if not FListVisible and FFListActive then
  begin
    if Assigned(FOnDropDown) then FOnDropDown(Self);
    if FDropDownWidth > 0 then
      TreeSelect.Width := FDropDownWidth
    else
      TreeSelect.Width := Width;
    if FDropDownHeight > 0 then
      FTreeSelect.Height := FDropDownHeight;
{
    FTreeSelect.ReadOnly := not CanModify;
    FTreeSelect.KeyField := FKeyFieldName;
    for I := 0 to FListFields.Count - 1 do
      S := S + TField(FListFields[I]).FieldName + ';';
    FTreeSelect.ListField := S;
    FTreeSelect.ListFieldIndex := FListFields.IndexOf(FListField);
    FTreeSelect.ListSource := FListLink.DataSource;
    FTreeSelect.KeyValue := KeyValue;
}
    ScreenRect.TopLeft := ScreenToClient(GetScreenRect.TopLeft);
    ScreenRect.BottomRight := ScreenToClient(GetScreenRect.BottomRight);
    ScreenRect := GetScreenRect;
    ComboBoxOrigin := Parent.ClientToScreen(Point(Left, Top));
    Y := ComboBoxOrigin.Y + Height;
    if Y + FTreeSelect.Height > ScreenRect.Bottom then
    begin
      Y := ComboBoxOrigin.Y - FTreeSelect.Height;
      FTreeSelect.FPosUnderComboBox := false;
    end
    else
      FTreeSelect.FPosUnderComboBox := true;
    case FDropDownAlign of
      daRight: X := ComboBoxOrigin.X - (FTreeSelect.Width - Width);
      daCenter: X := ComboBoxOrigin.X - ((FTreeSelect.Width - Width) div 2);
      else X := ComboBoxOrigin.X;
    end;
    if ((X + FTreeSelect.Width) > ScreenRect.Right) then
      X := ScreenRect.Right - (FTreeSelect.Width - 1);
    if (X < ScreenRect.Left) then
      X := ScreenRect.Left;
    FTreeSelect.DBTreeView.Color := Color;
    FTreeSelect.DBTreeView.Font := Font;
    FTreeSelect.DBTreeView.TableTextField := FFListField.Fieldname;
  { Now, if not done already, we connect the Datasource. We will disconnect
    it at CloseUp if not dtKeepDataSetConnected in Options: }
    if (FTreeSelect.DBTreeView.DataSource = nil) then
      FTreeSelect.DBTreeView.DataSource := FFListLink.DataSource;
    LocateKey; { TTable(ListSource.DataSet).FindKey([KeyValue]); }
    with FTreeSelect.DBTreeView do
    begin
      If (Items.GetFirstNode <> nil) then
      begin
        Items.GetFirstNode.MakeVisible; { begin at top of list }
{       Selected := Items.GetFirstNode; }
      end;
      SynchronizeSelectedNodeToCurrentRecord;
    end;
    FTreeSelect.Resize;
  { Show window: }
    SetWindowPos(FTreeSelect.Handle, HWND_TOP, X, Y, 0, 0,
      SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW);
    FTreeSelect.Show;
    FListVisible := True;
    Repaint;
  end;
end;

procedure TDbTreeLookupComboBox.ProcessSearchKey(Key: Char);
var
  aDBTreeView: TCustomDBTreeView;
  i: Integer;
  TickCount: Integer;
  S: string;
  Accept: Boolean;
  IDList: TStringList;
begin
  case Key of
    #8, #27: FFSearchText := '';
    #32..#255:
      if CanModify and FListLink.Active then
      begin
        TickCount := GetTickCount;
        if ((TickCount - SearchTickCount) > 2000) then
          FFSearchText := '';
        SearchTickCount := TickCount;
        if (Length(FFSearchText) < 32) then
        begin
          S := FFSearchText + Key;
          aDBTreeView := DBTreeView;
          if Assigned(aDBTreeView) then
          begin
            if (aDBTreeView.DataSource = nil) then
              aDBTreeView.DataSource := FFListLink.DataSource;
            IDList := aDBTreeView.TextIDList(AnsiUpperCase(S),
              [tvftCaseInsensitive, tvftPartial]);
            if (IDList <> nil) then
            try
              for i := 0 to IDList.Count - 1 do
              begin
                Accept := true;
                AcceptNode(aDBTreeView.GetIDNode(IDList[i]), Accept);
                if Accept then
                begin
                  SelectKeyValue(IDList[i]);
                  FFSearchText := S;
                  break;
                end;
              end;
            finally
              IDList.Free;
            end;
          end;
        end;
      end;
  end;
end;

procedure TDbTreeLookupComboBox.KeyDown(var Key: Word; Shift: TShiftState);
var
  aDBTreeView: TCustomDBTreeView;
  Node: TTreeNode;
  Accept: Boolean;
begin
  inherited KeyDown(Key, Shift);
  if FFListActive and ((Key = VK_UP) or (Key = VK_DOWN)) then
    if ssAlt in Shift then
    begin
      if FListVisible then
        CloseUp(caAccept)
      else
        DropDown;
      Key := 0;
    end
    else
    begin
      if (not FListVisible) then
      begin
        aDBTreeView := DBTreeView;
        if Assigned(aDBTreeView) then
        begin
          if (aDBTreeView.DataSource = nil) then
            aDBTreeView.DataSource := FFListLink.DataSource;
          Node := aDBTreeView.GetIDNode(KeyValue);
          if (Node <> nil) then
          begin
            repeat
              if (Key = VK_UP) then
                Node := Node.GetPrev
              else
                Node := Node.GetNext;
              if (Node <> nil) then
              begin
                Accept := true;
                AcceptNode(Node, Accept);
              end;
            until (Node = nil) or Accept;
            if Accept then
              SelectKeyValue(aDBTreeView.IDOfNode(Node));
          end;
          Key := 0;
        end;
      end;
    end;
end;

procedure TDbTreeLookupComboBox.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  ProcessSearchKey(Key);
end;

procedure TDbTreeLookupComboBox.KeyValueChanged;
begin
  if FFLookupMode and Assigned(FFDataField) then
  begin
    FText := FFDataField.DisplayText;
    FAlignment := FFDataField.Alignment;
  end else
  if FFListActive and LocateKey then
  begin
    FText := FFListField.DisplayText;
    FAlignment := FFListField.Alignment;
  end else
  begin
    FText := '';
    FAlignment := taLeftJustify;
  end;
  Invalidate;
end;

procedure TDbTreeLookupComboBox.ListLinkActiveChanged;
begin
  inherited;
  KeyValueChanged;
  if Assigned(FTreeSelect) then
    try
      TreeSelect.DBTreeView.DataSource := FFListLink.DataSource;
    except end;
end;

procedure TDbTreeLookupComboBox.SetListTreeIDField(const Value: String);
begin
  FListTreeIDField := Value;
  if Assigned(FTreeSelect) then
    try
      TreeSelect.DBTreeView.TableIDField := Value;
    except end;
end;

procedure TDbTreeLookupComboBox.SetListTreeParentField(const Value: String);
begin
  FListTreeParentField := Value;
  if Assigned(FTreeSelect) then
    try
      TreeSelect.DBTreeView.TableParentField := Value;
    except end;
end;

procedure TDbTreeLookupComboBox.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    SetFocus;
    if not FFFocused then Exit;
    if FListVisible then CloseUp(caCancel) else
      if FFListActive and not FNoMouseDropDown then
      begin
        MouseCapture := True;
        FTracking := True;
        TrackButton(X, Y);
        DropDown;
      end;
  end;
  inherited MouseDown(Button, Shift, X, Y);
end;

procedure TDbTreeLookupComboBox.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  ListPos: TPoint;
  MousePos: TSmallPoint;
  ADBTreeView: TCustomDBTreeView;
begin
  FNoMouseDropDown := false;
  if FTracking then
  begin
    TrackButton(X, Y);
    if FListVisible then
    begin
      ADBTreeView := DBTreeView;
      if Assigned(ADBTreeView) then
      begin
        ListPos := ADBTreeView.ScreenToClient(ClientToScreen(Point(X, Y)));
        if PtInRect(ADBTreeView.ClientRect, ListPos) then
        begin
          StopTracking;
          MousePos := PointToSmallPoint(ListPos);
          SendMessage(ADBTreeView.Handle, WM_LBUTTONDOWN, 0, Integer(MousePos));
          Exit;
        end;
      end;
    end;
  end;
  inherited MouseMove(Shift, X, Y);
end;

procedure TDbTreeLookupComboBox.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  FNoMouseDropDown := false;
  StopTracking;
  inherited MouseUp(Button, Shift, X, Y);
end;

procedure TDbTreeLookupComboBox.Paint;
var
  W, X, Flags: Integer;
  Text: string;
  Alignment: TAlignment;
  Selected: Boolean;
  R: TRect;
begin
  Canvas.Font := Font;
  Canvas.Brush.Color := Color;
  Selected := FFFocused and not FListVisible and
    not (csPaintCopy in ControlState);
  if Selected then
  begin
    Canvas.Font.Color := clHighlightText;
    Canvas.Brush.Color := clHighlight;
  end;
  if (csPaintCopy in ControlState) and (FFDataField <> nil) then
  begin
    Text := FFDataField.DisplayText;
    Alignment := FFDataField.Alignment;
  end else
  begin
    Text := FText;
    Alignment := FAlignment;
  end;
  W := ClientWidth - FButtonWidth;
  X := 2;
  case Alignment of
    taRightJustify: X := W - Canvas.TextWidth(Text) - 3;
    taCenter: X := (W - Canvas.TextWidth(Text)) div 2;
  end;
  SetRect(R, 1, 1, W - 1, ClientHeight - 1);
  Canvas.TextRect(R, X, 2, Text);
  if Selected then Canvas.DrawFocusRect(R);
  SetRect(R, W, 0, ClientWidth, ClientHeight);
  if not FFListActive then
    Flags := DFCS_SCROLLCOMBOBOX or DFCS_INACTIVE
  else if FPressed then