fccombo.pas

一套及时通讯的原码

  FButton := TfcDropDownButton.Create(self);
  with FButton do
  begin
    ControlStyle := ControlStyle + [csReplicatable];
    SetBounds (0, 0, FBtnParent.Width, FBtnParent.Height);
    Width := fcMax(GetSystemMetrics(SM_CXVSCROLL), 15);
    Parent := FBtnParent;
    OnMouseDown := BtnMouseDown;
  end;

  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnEditingChange := EditingChange;
  FDataLink.OnUpdateData := UpdateData;

  FSavedCursor := crIBeam;

  FFrame:= TfcEditFrame.create(self);
  FButtonEffects:= TfcComboButtonEffects.create(self, FButton);
//  FButton.Glyph.Handle:= LoadComboGlyph;  { Do after button effects is assigned }
//
//  FButtonGlyph := TBitmap.Create;
//  FButtonGlyph.OnChange := GlyphChanged;


end;

destructor TfcCustomCombo.Destroy;
begin
  if fcCOMBOHOOK <> 0 then
  begin
    UnhookWindowsHookEx(fcCOMBOHOOK);
    fcCOMBOHOOK := 0;
  end;
  FCanvas.Free;
  FPaintCanvas.Free;
  FDataLink.Free;
  FDataLink:= Nil;
  FFrame.Free;
  FButtonEffects.Free;
//  FButtonGlyph.Free;
  inherited Destroy;
end;

function TfcCustomCombo.isTransparentEffective: boolean;
begin
   result:= Frame.Transparent and Frame.IsFrameEffective
     and not fcIsDesigning(self)
end;

function TfcCustomCombo.GetIconIndent: Integer;
begin
  result:= FBtnParent.Width;
end;

function TfcCustomCombo.GetIconLeft: Integer;
begin
  result:= FBtnParent.Left - 1;
end;

function TfcCustomCombo.GetShowButton: Boolean;
begin
  result:= FBtnParent.Visible;
end;

procedure TfcCustomCombo.SetShowButton(Value: Boolean);
begin
  if (FBtnParent.Visible <> Value) then
  begin
    FBtnParent.Visible := Value;
    UpdateButtonPosition;
    if not (csLoading in Owner.ComponentState) then SetEditRect;
    Invalidate;
  end
end;

procedure TfcCustomCombo.DrawButton(Canvas: TCanvas; R: TRect; State: TButtonState;
    ControlState: TControlState; var DefaultPaint:boolean);
var Transparent: boolean;
begin
   if ButtonStyle=cbsCustom then exit;

   DefaultPaint:= False;
   Transparent:=  FButton.Flat and
      (not FMouseInButtonControl) and not (FFocused);
   if ButtonStyle=cbsDownArrow then
      fcDrawDropDownArrow(Canvas, R, State, Enabled, ControlState)
   else begin
      fcDrawEllipsis(Canvas, R, State, Enabled, Transparent,
         ButtonEffects.Transparent {and ButtonEffects.Flat},
         ControlState)
   end
end;

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

  with Params do
    Style := Style and not (ES_AUTOVSCROLL or ES_WANTRETURN) or
      WS_CLIPCHILDREN or ES_MULTILINE;

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


end;

procedure TfcCustomCombo.CreateWnd;
begin
  inherited;
  if (BorderStyle=bsNone) and AutoSize and
     not (parent is TCustomGrid) then Frame.AdjustHeight;
  SetEditRect;
  if IsTransparentEffective then
  begin
    fcDisableParentClipping(Parent);
  end
end;

function TfcCustomCombo.GetEditRect: TRect;
begin
  result.Bottom := ClientHeight + 1;
  if ShowButton then result.Right := FBtnParent.Left - 2   //10/4/2001 - Changed from -1 to -2
  else result.Right := ClientWidth - 2;

  { RSW - 3/27/99 }
  Result.Top := GetTopIndent;
  if fcIsInwwObjectView(Self) then
  begin
    Result.Top:= 1;
    Result.Left:=1;
  end
  else if (Frame.IsFrameEffective) then
  begin
     Frame.GetEditRectForFrame(Result);
  end
  else if (BorderStyle = bsNone) and fcIsInwwGrid(Self) then begin
     Result.Left := 2;
  end
  else if (BorderStyle = bsNone) then
  begin
     Result.Left := 1;
  end
  else begin
     Result.Left := 0;
  end;
//  if not Frame.isFrameEffective then { 11/22/99 - Don't do for frame }
     inc(result.Left, GetLeftIndent);
end;

procedure TfcCustomCombo.SetEditRect;
var r: TRect;
begin
  Canvas.font:= Font; { 4/14/99 }
  r := GetEditRect;
  SendMessage(Handle, EM_SETRECTNP, 0, LPARAM(@r));
end;

procedure TfcCustomCombo.UpdateButtonPosition;
var offset: integer;
begin
  if Frame.IsFrameEffective then
  begin
     offset:= 2
  end
  else offset:= 0;
  if (not NewStyleControls) or (BorderStyle = bsNone) or (not Ctl3d) then
     FBtnParent.SetBounds (Width - FButton.Width - offset, offset, FButton.Width, ClientHeight-offset*2)
  else
     FBtnParent.SetBounds (Width - FButton.Width - 4, offset, FButton.Width, ClientHeight-offset);

//  if (not NewStyleControls) or (BorderStyle = bsNone) or (not Ctl3d) then
//    FBtnParent.SetBounds(Width - FButton.Width, 0, FButton.Width, ClientHeight)
//  else
//    FBtnParent.SetBounds(Width - FButton.Width - 4, 0, FButton.Width, ClientHeight);

  if not FBtnParent.Visible and (csDesigning in ComponentState) then
    FBtnParent.Left := BoundsRect.Right;

  if BorderStyle = bsNone then
  begin
    FButton.Top := -1;
    FButton.Height := FBtnParent.Height+1;
  end else begin
    FButton.Top:= 0;
    FButton.Height := FBtnParent.Height;
  end;

  SetEditRect;
end;

function TfcCustomCombo.IsDataBound: Boolean;
begin
  result := (DataSource <> nil) and (DataSource.DataSet <> nil) and (DataField <> '');
end;

procedure TfcCustomCombo.CheckCancelMode;
var p, p2: TPoint;
    wndRect: TRect;
begin
  GetCursorPos(p);
  p2 := DropDownControl.ClientToScreen(Point(0, 0));
  GetWindowRect(Handle, wndRect);
  with p2 do
  begin
    if (not PtInRect(Rect(x, y, x + DropDownControl.Width, y + DropDownControl.Height), p)) and
       (not PtInRect(wndRect, p)) then CloseUp(False);
  end;
end;

procedure TfcCustomCombo.DoCloseUp(Accept: boolean);
begin
   if Assigned(FOnCloseUp) then FOnCloseUp(self, Accept);
end;

procedure TfcCustomCombo.CloseUp(Accept: boolean);
//var i: Integer;
begin
//  i := GetCapture; { RSW }
//  if Accept then Modified := True; { RSW - Rely on parent class to set modified as we don't really know }
//  if i <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
  { RSW - comment out as this causes problem with button not getting mouse up }
  try
    SelectAll;

    if IsDroppedDown then
    begin
      SetWindowPos(DropDownContainer.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
        SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
      DropDownContainer.Visible := False;
      Invalidate;
      if DropDownControl.Focused then SetFocus;
     { RSW - Let parent class call CloseUP so that its fired after things are updated (i.e. modified flag )}
//    if Assigned(FOnCloseUp) then FOnCloseUp(self, Accept);
    end;
    if Style = csDropDownList then HideCaret;
  finally
    if fcCOMBOHOOK <> 0 then
    begin
      UnhookWindowsHookEx(fcCOMBOHOOK);
      fcCOMBOHOOK := 0;
    end;
  end;
end;

procedure TfcCustomCombo.DataChange(Sender: TObject);
begin
  if FDataLink.Field <> nil then
  begin
    if not (csDesigning in ComponentState) then
    begin
      if (FDataLink.Field.DataType = ftString) and (MaxLength = 0) then
        MaxLength := FDataLink.Field.Size;
    end;
    if Focused and FDataLink.CanModify then
      Text := FDataLink.Field.Text
    else begin
      Text := FDataLink.Field.DisplayText;
{ 7/31/00 - Remove setting modified as this oode sets it to true even when the control does
 not have focus }
//      if FDataLink.Editing then
//        Modified := True;
    end;
  end else
  begin
    if csDesigning in ComponentState then
      Text := Name else
      Text := '';
  end;
end;

procedure TfcCustomCombo.EditingChange(Sender: TObject);
begin
  inherited ReadOnly := not FDataLink.Editing;  // RSW use inherited ReadOnly
end;

procedure TfcCustomCombo.UpdateData(Sender: TObject);
begin
  if FDataLink.Field.Text <> Text then
    FDataLink.Field.Text := Text;
end;

procedure TfcCustomCombo.DrawInGridCell(ACanvas: TCanvas; Rect: TRect;
  State: TGridDrawState);
begin
end;

procedure TfcCustomCombo.DoDropDown;
begin
  if Assigned(FOnDropDown) then FOnDropDown(self);
end;

procedure TfcCustomCombo.DoAfterDropDown;
begin
  if Assigned(FOnAfterDropDown) then FOnAfterDropDown(self);
end;

procedure TfcCustomCombo.DropDown;
var p: TPoint;
    NewControlSize: TSize;
    Border: Integer;
begin
  if fcCOMBOHOOK = 0 then fcCOMBOHOOK := SetWindowsHookEx(WH_MOUSE, @fcComboHookProc, HINSTANCE, GetCurrentThreadID);
  DoDropDown;

  p := Parent.ClientToScreen(Point(Left, Top));

  // 2/25/99 - Handle Grid Paint bug when closing up in grid
  if fcIsInwwGrid(Self) then inc(p.y);

  // Initialize size of DropDownControl
  Border := 2 * GetSystemMetrics(SM_CYBORDER);
  NewControlSize := ItemSize;
  if ItemCount > 0 then NewControlSize.cy :=
    fcMin(DropDownCount, ItemCount) * NewControlSize.cy
  else NewControlSize.cy := Height;
  inc(NewControlSize.cy, Border);
  DropDownContainer.Height := NewControlSize.cy;

  // 2/8/01 - Color combo too wide before
  if NewControlSize.cx=0 then
     NewControlSize.cx:= Width
  else
     NewControlSize.cx := fcMax(Width, NewControlSize.cx + Border + 2 * GetSystemMetrics(SM_CXVSCROLL));

  // Adjust if near right edge of screen
  if p.x > Screen.Width - NewControlSize.cx then p.x := (p.x + Width) - NewControlSize.cx;
  // Adjust if near bottom of screen
  if p.y + Height + NewControlSize.cy > Screen.Height{GetSystemMetrics(SM_CYFULLSCREEN)} then p.y := (p.y - Height) - NewControlSize.cy;

  TEdit(DropDownContainer).Color := TEdit(DropDownControl).Color;

  { 6/22/99 - Use HWND_TOPMOST only for formstyle=fsStayOnTop }
  if TForm(GetParentForm(self)).formstyle = fsStayOnTop then
    SetWindowPos(DropDownContainer.Handle, HWND_TOPMOST, p.x, p.y + Height, NewControlSize.cx, NewControlSize.cy,
      SWP_NOACTIVATE or SWP_SHOWWINDOW)
  else
    SetWindowPos(DropDownContainer.Handle, HWND_TOP, p.x, p.y + Height, NewControlSize.cx, NewControlSize.cy,
      SWP_NOACTIVATE or SWP_SHOWWINDOW);
  DoAfterDropDown;
  DropDownContainer.Visible := True;
  DropDownControl.Update;
  //2/25/99 - Let inherited classes do the selectall.
  //  SelectAll;
  ShowCaret;
end;

{ return true if allowed to type text into control }
function TfcCustomCombo.Editable: boolean;
begin
  result := true;
//  Result := IsDroppedDown;
end;

procedure TfcCustomCombo.HandleDropDownKeys(var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_F4: // Support F4 for dropping-down
      if not (ssAlt in Shift) then begin
        if isDroppedDown then CloseUp(True)
        else DropDown;
        Key := 0;
      end;
    VK_UP, VK_DOWN:
      if ssAlt in Shift then
      begin
        if IsDroppedDown then CloseUp(True)
        else DropDown;
        Key := 0;
      end;
    VK_RETURN, VK_ESCAPE:
      if IsDroppedDown and not (ssAlt in Shift) then
      begin
        CloseUp(Key = VK_RETURN);
        Key := 0;
      end
  end;
end;

procedure TfcCustomCombo.Change;
begin
  if ((DataLink<>Nil) and (FDataLink.Field=Nil)) then Modified:= True;
{  if (DataLink<>Nil) and
     ((FDataLink.Field=Nil) or
      (DataSource.dataset.state in [dsEdit, dsInsert])) then
  begin
     FDataLink.Modified;
     Modified:= True;
  end;}

  inherited;
end;

function TfcCustomCombo.EditCanModify: Boolean;
begin
  result:= False;
  if EffectiveReadOnly then exit; { RSW - otherwise CloseUP still goes into edit mode}

  // Respect autoedit
  if (DataSource<>Nil) and (not DataSource.autoEdit) then
     if (not (DataSource.state in [dsEdit, dsInsert])) then exit;

  if FDatalink.Field <> nil then result := FDataLink.Edit
  else result := True;
end;

procedure TfcCustomCombo.HandleGridKeys(var Key: Word; Shift: TShiftState);
type
  TSelection = record
    StartPos, EndPos: Integer;
  end;

var SkipGridCode: boolean;

  procedure SendToObjectView;
  begin
     TCheatGridCast(Parent).KeyDown(Key, Shift);
  end;

  procedure SendToParent;
  begin
    Parent.setFocus;
    if Parent.focused then
       SendMessage(Parent.handle,wm_keydown,key,0);
    Key := 0;
  end;

  procedure ParentEvent;
  var GridKeyDown: TKeyEvent;
  begin
    { 1/25/99 - RSW Prevent grid's OnKeyDown from firing twice when encounter tab or cr }
    if (Screen.ActiveControl<>self) and ((key=13) or (key=9)) then exit;

    GridKeyDown := TEdit(Parent).OnKeyDown;
    if Assigned(GridKeyDown) then GridKeyDown(Parent, Key, Shift);
  end;

  function Alt: Boolean;
  begin
    Result := ssAlt in Shift;
  end;

  function Ctrl: Boolean;
  begin
    Result := ssCtrl in Shift;
  end;

{  procedure Deselect;
  begin
    Exit;
    SendMessage(Handle, EM_SETSEL, -1, 0);
    selLength := 0;
  end;}

  function ForwardMovement: Boolean;
  begin
     Result := (dgAlwaysShowEditor in fcGetGridOptions(self));
  end;