fccombo.pas

一套及时通讯的原码

  function Selection: TSelection;
  begin
    SendMessage(Handle, EM_GETSEL, Longint(@Result.StartPos), Longint(@Result.EndPos));
  end;

  function LeftSide: Boolean;
  begin
//    result := ((SelStart = 0) and (SelLength <> GetTextLen)) or (Style = csDropDownList)
    with Selection do
      Result := (StartPos = 0) and
      ((EndPos = 0) or (EndPos = GetTextLen));
  end;

  function RightSide: Boolean;
  begin
    with Selection do
      Result := ((StartPos = 0) or (EndPos = StartPos)) and
        (EndPos = GetTextLen);
   end;

  procedure Deselect; {!!! Don't do for Treecombo}
  begin
    SendMessage(Handle, EM_SETSEL, -1, 0);
    selLength:= 0;
  end;

begin
  if (Key in [vk_next, vk_prior, vk_up, vk_down, vk_home, vk_end, vk_right, vk_left]) and
     (IsDroppedDown) then skipGridCode:= True
  else SkipGridCode:= False;

  if (fcIsInwwGrid(Self)) and (not SkipGridCode) then begin
    case Key of
      VK_ESCAPE: if not Modified then SendToParent;
      VK_NEXT, VK_PRIOR, VK_UP, VK_DOWN: if (not Alt) then SendToParent;
       VK_LEFT: if fcIsInwwObjectView(self) then
                begin
//                   if Ctrl or LeftSide then SendToObjectView
                end
                else if ForwardMovement and (Ctrl or LeftSide) then SendToParent;
       VK_RIGHT: if fcIsInwwObjectView(self) then
                 begin
//                    if Ctrl or RightSide then SendToObjectView
                 end
                 else if ForwardMovement and (Ctrl or RightSide) then SendToParent;
//      VK_LEFT: if fcIsInwwObjectView(self) then SendToObjectView
//                else if ForwardMovement and (Ctrl or LeftSide) then SendToParent;
//      VK_RIGHT: if fcIsInwwObjectView(self) then SendToObjectView
//                 else if ForwardMovement and (Ctrl or RightSide) then SendToParent;
      VK_HOME: if ForwardMovement and (Ctrl or LeftSide) then SendToParent;
      //((SelStart = 0) and (SelLength <> GetTextLen)) or (Style = csDropDownList) then SendToParent;
      VK_END: if ForwardMovement and (Ctrl or RightSide) then SendToParent;
      //if (SelStart = GetTextLen) or (Style = csDropDownList) then SendToParent;
      VK_INSERT: if not (ssShift in Shift) then SendToParent;
      VK_DELETE: if Ctrl then SendToParent;
      VK_F2:
         begin
           ParentEvent;
           if Key = VK_F2 then
           begin
             if Editable and (Style=csDropDown) then Deselect;
             Key:=0;
           end;
         end;
    end;
    if not (Editable and (Style=csDropDown)) and
       (Key in [VK_LEFT, VK_RIGHT, VK_HOME, VK_END]) then
       if not fcIsInwwObjectView(self) then SendToParent;

    if Key <> 0 then ParentEvent;
  end;
  if Key = 0 then Exit;

  if (ssCtrl in Shift) then
  begin
    inherited KeyDown(Key, Shift);
     Exit;
  end;

  if fcIsInwwGrid(Self) and (Key = VK_TAB) then
  begin
    inherited KeyDown(Key, Shift);
    Exit;
  end;

  inherited KeyDown(Key, Shift);
end;

procedure TfcCustomCombo.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if GetKeyState(VK_MENU) < 0 then Include(Shift, ssAlt);

  if modified and (not isDroppedDown) and (key=VK_ESCAPE) then
  begin
    Reset;
    Key := 0;
  end;

  HandleDropDownKeys(Key, Shift);
  HandleGridKeys(Key, Shift);

  inherited KeyDown(Key, Shift);

  if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then
    if not EditCanModify then
       key:= 0;
//    FDataLink.Edit;

end;


procedure TfcCustomCombo.KeyPress(var Key: Char);
begin
  inherited;
  if EffectiveReadOnly then
  begin
     Key:= #0;
     exit;
  end;{ RSW }

  case Key of
    ^H, ^V, ^X, #32..#255:
//      if (Style = csDropDown) or IsDroppedDown then
//      if (Style = csDropDown) or isDroppedDown then
      if Editable then
      begin
         if (not IsDroppedDown) then
            if not EditCanModify then key:= #0
            //FDataLink.Edit
      end
      else Key := #0;
    #27:
      begin
//        Reset;  //12/11/1998 - Moved to OnKeyDown event.
        Key := #0;
      end;
    #9, #13: if fcIsInwwGrid(Self) then Key:= #0;
                                                         { 4/28/99 - Ignore tab and cr                            }
                                                         { cr needs to be eaten so that parentgrid is not confused }
                                                         { when using dgEnterToTab }
  end;
end;

function TfcCustomCombo.GetClientEditRect: TRect;
begin
  result := ClientRect;
  // 9/28/01 - Fix combo in grid problem where button area should still paint text
//  if not fcIsInwwObjectViewPaint(self) and ShowButton then
  if not fcIsInwwGridPaint(self) and ShowButton then
     result.Right := FBtnParent.Left;
end;

function TfcCustomCombo.GetDataField;
begin
  result := FDataLink.FieldName;
end;

function TfcCustomCombo.GetDataSource: TDataSource;
begin
  if FDataLink<>nil then
     result := FDataLink.DataSource
  else
    result:= nil;
end;

function TfcCustomCombo.EffectiveReadOnly: Boolean;
begin
  result:= FReadOnly or FDataLink.ReadOnly or {(inherited ReadOnly) or}
           ((FDataLink.Field<>nil) and (not FDataLink.Field.CanModify));
end;

function TfcCustomCombo.GetReadOnly: Boolean;
begin
  result:= FReadOnly;
//  if IsDataBound then result := FDataLink.ReadOnly else result := inherited ReadOnly;
end;

procedure TfcCustomCombo.SetButtonStyle(Value: TfcComboButtonStyle);
begin
  if Value <> FButtonStyle then
  begin
    FButtonStyle := Value;
    if HandleAllocated then RecreateWnd;
    FButton.Invalidate;
  end
end;

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

procedure TfcCustomCombo.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource := Value;
  if Value <> nil then Value.FreeNotification(self);
end;

procedure TfcCustomCombo.SetReadOnly(Value: Boolean);
begin
//  FDataLink.ReadOnly:= Value;
  FReadOnly:= Value;
{  if Style <> csDropDownList then }inherited ReadOnly := Value;
//  if IsDataBound then FDataLink.ReadOnly := Value;
//{  if Style <> csDropDownList then }inherited ReadOnly := Value;
end;

procedure TfcCustomcombo.SetStyle(Value: TfcComboStyle);
begin
  if FStyle <> Value then
  begin
    FStyle := Value;
    if HandleAllocated and not (csLoading in ComponentState) then
    begin
      if FStyle = csDropDownList then
      begin
        inherited ReadOnly := True;  { Should be inherited Readonly, but Hidecaret already does this }
        HideCaret;
      end else begin
        ShowCaret;
      end;
    end;
  end;
end;

function TfcCustomCombo.IsDroppedDown: boolean;
begin
  result := False;
end;

procedure TfcCustomCombo.Loaded;
begin
  if FButtonWidth=0 then
     FButton.Width := fcMax(GetSystemMetrics(SM_CXVSCROLL), 15);
  if (Parent <> nil) or (Owner <> nil) then
    UpdateButtonPosition;
  inherited Loaded;
end;

procedure TfcCustomCombo.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
//  InvalidateTransparentButton;

  if Style = csDropDownList then
  begin
    if not IsDroppedDown and (Button = mbLeft) then begin
      PostMessage(Handle, WM_FC_CALLDROPDOWN, 0, 0);
      ReleaseCapture; { RSW - Capture causes cursor problems }
    end
    else CloseUp(True);
  end;
end;

procedure TfcCustomCombo.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  FIgnoreCursorChange := True;
  if Style = csDropDownList then {Screen.}Cursor := crArrow else Cursor := FSavedCursor;   // Change component cursor, not screen cursor. -ksw (2/12/99)
  FIgnoreCursorChange := False;
end;

procedure TfcCustomCombo.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = DataSource) then DataSource := nil;
  if (Operation = opRemove) and (AComponent = FController) then FController:= nil;
end;

procedure TfcCustomCombo.WndProc(var Message: TMessage);
begin
  if Message.Msg = WM_FC_CALLDROPDOWN then
    DropDown;
  case Message.Msg of
    WM_PASTE, WM_CUT, WM_KEYFIRST..WM_KEYLAST:
      if fcIsInwwGrid(self) then Change;
    WM_NCLBUTTONDOWN: CloseUp(True);
  end;

  inherited;
end;

procedure TfcCustomCombo.CMCancelMode(var Message: TCMCancelMode);
begin
//  if (Message.Sender <> Self) and (Message.Sender <> DropDownControl) then
//    CloseUp(False);
end;

procedure TfcCustomCombo.CMCursorChanged(var Message: TMessage);
begin
  inherited;
  if not FIgnoreCursorChange then FSavedCursor := Cursor;
end;

procedure TfcCustomCombo.CMEnter(var Message: TCMEnter);
var exStyle, origStyle: longint;
begin
  if AutoSelect and not (csLButtonDown in ControlState) then SelectAll;
  inherited;

  SetFocused(True);

  if ButtonEffects.Flat then FButton.invalidate;
  
  if IsTransparentEffective then begin
     Frame.CreateTransparent:= False;
     OrigStyle:= Windows.GetWindowLong(handle, GWL_EXSTYLE);
     exStyle:= OrigStyle and not WS_EX_TRANSPARENT;
     Windows.SetWindowLong(handle, GWL_EXSTYLE, exStyle);
     invalidate;
  end;

  if Frame.enabled then invalidate; { See if this causes any flicker }
  
end;

procedure TfcCustomCombo.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  FButton.Enabled := Enabled;
end;

procedure TfcCustomCombo.SetFocused(Value: Boolean);
begin
  if FFocused <> Value then
  begin
    FFocused := Value;
//    if (FAlignment <> taLeftJustify) then Invalidate;
    if FDataLink.Field<>Nil then begin
       FDataLink.Reset;
    end
  end;
end;

procedure TfcCustomCombo.CMExit(var Message: TCMExit);
var exStyle, origStyle: longint;
begin
  try
    FDataLink.UpdateRecord;
    SetFocused(False);

    if ButtonEffects.Flat then FButton.invalidate;

    if IsTransparentEffective then begin
//       Frame.CreateTransparent:= True;
//       RecreateWnd;
       { Try not recreating window by testing following code instead of IP2000 code }
       OrigStyle:= Windows.GetWindowLong(handle, GWL_EXSTYLE);
       exStyle:= OrigStyle or WS_EX_TRANSPARENT;
       Windows.SetWindowLong(handle, GWL_EXSTYLE, exStyle);

       SetEditRect;
       Frame.RefreshTransparentText(True);
    end;
    if Frame.enabled then invalidate;

  except
    SelectAll;
    SetFocus;
    raise;
  end;
  DoExit;
end;

//3/23/1999 - PYW - Need to automatically set datasource when dropping control
//                  in a TDBCtrlGrid.
procedure TfcCustomCombo.CMGetDataLink(var Message: TMessage);
begin
  Message.Result := Integer(FDataLink);
end;

procedure TfcCustomCombo.CMTextChanged(var Message: TMessage);
begin
  if IsTransparentEffective and not FFocused then
     Frame.RefreshTransparentText;
  inherited;
  if fcIsInwwGrid(self) then Change;
end;

procedure TfcCustomCombo.CMFontChanged(var Message: TMessage);
begin
  inherited;
  // This is needed only when changing font in the middle of editing
  if not (csLoading in Owner.ComponentState) then SetEditRect;
end;

procedure TfcCustomCombo.CNKeyDown(var Message: TWMKeyDown);
var ShiftState: TShiftState;
begin
  if not (csDesigning in ComponentState) then
    with Message do
    begin
       if (charcode = VK_TAB) and IsDroppedDown then Closeup(True)
       else if((charcode=vk_return) or (charcode=vk_escape)) then begin
          if IsDroppedDown then exit
          else if (not modified) or (charcode = vk_return) then { 6/6/99 - Close this modal form }
             SendMessage(GetParent(Handle), TMessage(Message).Msg,
             TMessage(Message).wParam, TMessage(Message).lParam);
       end
    end;

  if not (csDesigning in ComponentState) and fcIsInwwGrid(self) then
  begin
    with Message do
    begin

      ShiftState := KeyDataToShiftState(KeyData);

      if (charcode = VK_TAB) or (charcode = VK_RETURN) then begin
         if parent is TCustomGrid then begin
           if (charcode <> VK_TAB) or (goTabs in TCheatGridCast(parent).Options) then {7/3/97}
           begin
              parent.setFocus;
              if parent.focused then { Bug fix - Abort in validation prevents focus change }
                TCheatGridCast(parent).KeyDown(charcode, shiftState);
              exit;
           end
         end
      end;

      if (CharCode = VK_TAB) or (CharCode = VK_RETURN) then
      begin
        if fcIsInwwGrid(self) then
        begin
          if (CharCode <> VK_TAB) or (dgTabs in (fcGetGridOptions(self))) then
          begin
            Parent.SetFocus;
            if Parent.Focused then
              SendMessage(Parent.Handle, WM_KEYDOWN, CharCode, 0);
            Exit;
          end
        end
      end
    end
  end;

  inherited;
end;

function TfcCustomCombo.SkipInheritedPaint : boolean;
begin
  result := False;
end;

procedure TfcCustomCombo.WMPaint(var Message: TWMPaint);
var r: TRect;
    DC: HDC;
    PS: TPaintStruct;

  procedure CanvasNeeded;
  begin
    if FCanvas = nil then
    begin
      FCanvas := TControlCanvas.Create;
      FCanvas.Control := Self;
    end;
  end;

begin
  if ((Frame.enabled or SkipInheritedPaint) and (not FFocused)) or
     (csPaintCopy in ControlState) then
  begin
     // 6/28/99 - Support unbound csPaintCopy }
      { if not editable with focus, need to do drawing to show proper focus }