fccombo.pas

一套及时通讯的原码

      try
         if FPaintCanvas = nil then
         begin
            FPaintCanvas := TControlCanvas.Create;
            FPaintCanvas.Control := Self;
         end;
         CanvasNeeded;

         if Message.DC = 0 then DC := BeginPaint(Handle, PS)
         else DC:= Message.DC;
         FPaintCanvas.Handle := DC;

         if FDataLink.Field=nil then
            PaintToCanvas(FPaintCanvas, GetClientEditRect, True, False,
               Text)
         else
            PaintToCanvas(FPaintCanvas, GetClientEditRect, True, False,
               FDataLink.Field.asString);

        if Frame.IsFrameEffective then
        begin
          DrawFrame(FPaintCanvas);
        end;

      finally
         FPaintCanvas.Handle := 0;
         if Message.DC = 0 then EndPaint(Handle, PS);
      end;
  end
  else begin
     inherited;
     Paint;

     if Frame.IsFrameEffective then
     begin
       CanvasNeeded;
       FCanvas.Handle:= message.DC;
       DrawFrame(FCanvas);
       FCanvas.Handle:= 0;
     end;
  end;

  r := FBtnParent.ClientRect;
  InvalidateRect(FBtnParent.Handle, @r, False);
end;

procedure TfcCustomCombo.WMSize(var Message: TWMSize);
begin
  inherited;
  UpdateButtonPosition;
  SetEditRect;
end;

procedure TfcCustomCombo.WMKillFocus(var Message: TWMKillFocus);
begin
  inherited;
  if (DropdownContainer<>nil) and
     DropDownContainer.HandleAllocated and (Message.FocusedWnd <> DropDownContainer.Handle) then
    CloseUp(True);
  if Style = csDropDownList then Invalidate;
end;

procedure TfcCustomCombo.WMSetFocus(var Message: TWMSetFocus);
begin
  inherited;
  if Style = csDropDownList then
  begin
    Invalidate;
    ShowCaret;
    HideCaret;
  end;
end;

procedure TfcCustomCombo.SetModified(Value: Boolean);
begin
  if Value then begin
     if (DataSource<>nil) and (DataSource.State in [dsEdit, dsInsert]) then
        FDatalink.modified;
  end;
  inherited Modified := Value;
end;

procedure TfcCustomCombo.BtnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var parentForm: TCustomForm;
begin
  if Button <> mbLeft then Exit;
  if IsDroppedDown then CloseUp(True) { 2/11/99 - RSW }
  else begin
   { RSW - Kirk, what was this line for
     It causes a problem as its not ever reset.  For instance, your CMEnter code
     checks ControlState.  To see problem put control in grid and click in the control.
     Then tab to it and it does not select all }
//    ControlState := ControlState +[csLButtonDown];

    // 6/3/2001 - PYW - MDI Child forms would not get activated prior to setting focus.
    parentForm:= GetParentForm(self);
    if (parentForm<>nil) and (TForm(parentForm).formstyle = fsMDIChild) then
       if Screen.ActiveForm <> parentForm then
          SendMessage(parentform.Handle, WM_ACTIVATE, 0, 0);

    if CanFocus then
    begin
       SetFocus;
       // 6/16/01 - Fix problem when using WebBrowse and it has text selected
       if Handle<>GetFocus then
          windows.SetFocus(Handle);
    end;

    if (Screen.ActiveControl=self) or Focused then // 8/16/2000 - Fire also if screen.activecontrol is me
       PostMessage(Handle, WM_FC_CALLDROPDOWN, 0, 0);
  end
end;

procedure TfcCustomCombo.HideCaret;
begin
  Windows.HideCaret(Handle);
  inherited ReadOnly := True;
end;

procedure TfcCustomCombo.Paint;
begin
end;

procedure TfcCustomCombo.Reset;
begin
  if DataLink.Field <> nil then DataLink.Reset;
  SelectAll;
  SetModified(False);
  Paint;
end;

procedure TfcCustomCombo.SelectAll;
begin
   inherited SelectAll;
end;

procedure TfcCustomCombo.ShowCaret;
begin
  if not HandleAllocated then exit; //3/25/99-PYW - Make sure handle is allocated.
  Windows.ShowCaret(Handle);
  inherited ReadOnly := False;
end;

function TfcCustomCombo.GetLeftIndent: Integer;
begin
  result := 0;
end;

procedure TfcCustomCombo.SetDropDownCount(Value: Integer);
begin
  FDropDownCount := Value;
end;

procedure TfcCustomCombo.WMPaste(var Message: TMessage);
begin
  if (Style=csDropDown) then
  begin
     if not EditCanModify then exit
     else begin
       FDataLink.Edit;
       inherited;
       SetModified(True);
     end
  end
  else inherited;
end;

procedure TfcCustomCombo.WMCut(var Message: TMessage);
begin
  if (Style=csDropDown) then
  begin
     if not EditCanModify then exit
     else begin
       FDataLink.Edit;
       inherited;
       SetModified(True);
     end
  end
  else inherited;
end;

function TfcCustomCombo.GetRightIndent(Rect:TRect): Integer;
begin
  result:= 0;
{  result := Width-2;
  if (ColorAlignment <> taRightJustify) then exit;
  if FColorListOptions = nil then exit;
  GetColorRectInfo(Rect,AWidth,AHeight);
  if (Awidth <> 0) then
     inc(result, -AWidth);}
end;

function TfcCustomCombo.GetTopIndent: Integer;
begin
  result := 0;
  if (BorderStyle = bsNone) and fcIsInwwGrid(Self) then begin
     Result := 2;
     if fcIsClass(parent.classtype, 'TwwDBGrid') then
     begin
        if ([dgRowLines, dgRowFixedLines] * fcGetGridOptions(self) = []) then Result:=1;
     end;

  end
  else if (BorderStyle = bsNone) then
  begin
     Result := 1;
  end;
  if AlignmentVertical = fcavCenter then
  begin
     if BorderStyle=bsNone then
        inc(result,(Height - Canvas.Textheight('A')-2) div 2)
     else
        result:= (Height - Canvas.Textheight('A')-5) div 2;
  end;
end;

procedure TfcCustomCombo.SetAlignmentVertical(Value: TfcAlignVertical);
begin
  if FAlignmentVertical <> Value then begin
     FAlignmentVertical := Value;
     Invalidate;
  end;
end;

Procedure TfcCustomCombo.DoEnter;
begin
   inherited DoEnter;
   if (FDataLink.Field=Nil) then modified:= False;  { 1/21/97 - Only clear if unbound }
end;


constructor TBtnWinControl.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
   EditControl:= AOwner as TfcCustomCombo;
end;

procedure TBtnWinControl.CMMouseLeave(var Message: TMessage);
var r: TRect;
    offset: integer;
begin
  inherited;
  if not EditControl.ButtonEffects.Flat then exit;

  if EditControl.BorderStyle=bsSingle then offset:=2 else offset:= 0;
  if not EditControl.FFocused then begin
     if EditControl.IsTransparentEffective then begin
        r:= Rect(parent.left + Left + offset, parent.Top+top+offset,
                 parent.left + left + offset + Width, parent.top + offset + Top + Height);
        if fcIsTransparentParent(self) then
          fcInvalidateTransparentArea(self) // just to be safer, but probably works in both cases
        else
          InvalidateRect(parent.parent.handle, @r, True);
//        InvalidateRect(parent.parent.handle, @r, True);
        Invalidate;
     end;
     Invalidate;
  end
end;

procedure TBtnWinControl.WMEraseBkgnd(var Message: TWmEraseBkgnd);
var r: TRect;
   control: TfcCustomCombo;
begin
  control:= TfcCustomCombo(parent);
  if control.SkipUpdate then exit;

  if fcIsInwwGridPaint(parent) or
     control.isTransparentEffective  then
  begin
     { Fixes paint problem when mouse is clicked in button and moved outside
       region, but it is not released }
     if (not fcIsInwwGridPaint(parent)) and
        (control.ButtonEffects.Flat or control.ButtonEffects.Transparent) and
        (csLButtonDown in control.FButton.ControlState) then
     begin
        r:= Rect(parent.left + Left , parent.Top+top,
                 parent.left + left + Width, parent.top + Top + Height);
        InvalidateRect(parent.parent.handle, @r, False);
        control.skipupdate:= true;
        parent.parent.update;
        control.skipupdate:= False;
     end;
     Message.result:= 1;
     exit;
  end
  else inherited;
end;

procedure TfcCustomCombo.WMEraseBkgnd(var Message: TWmEraseBkgnd);
var r: TRect;
begin
  if fcIsInwwObjectViewPaint(self) or
    (IsTransparentEffective and (not FFocused)) then
  begin
     Message.result:= 1;
  end
  // 8/1/02 - Respect NonFocusColor when it does not have focus
  else if (not fcIsInwwGridPaint(self)) and
      (not FFocused) and (Frame.NonFocusColor<>clNone) then
  begin
     r:= ClientRect;
     if FCanvas<>nil then
     begin
        FCanvas.Brush.Color:= Frame.NonFocusColor;
        Windows.FillRect(message.dc, r, FCanvas.brush.handle );
     end;
     message.result:=1
  end
  else inherited;
end;

procedure TfcCustomCombo.DrawFrame(Canvas: TCanvas);
begin
    fcDrawEdge(self, Frame, Canvas, FFocused);
end;

procedure TfcCustomCombo.InvalidateTransparentButton;
var r: TRect;
begin
   if ButtonEffects.Flat or ButtonEffects.Transparent then begin
     with FBtnParent do begin
         r:= Rect(parent.left + Left, parent.Top+top,
               parent.left + left+ Width, parent.top + Top + Height);
        { Calling with True causes flicker for any control that is invalidated.
          Test with False to see if any side effects  }
         InvalidateRect(parent.parent.handle, @r, False);
         parent.parent.Update;
      end
   end;
   FButton.invalidate;
end;

Procedure TfcCustomCombo.UpdatebuttonGlyph;
begin
//   FButton.Glyph.Handle:=0;  7/28/01 - Don't clear glyph
   if (FButtonStyle<>cbsCustom) and
      (ButtonEffects.Flat or ButtonEffects.Transparent) then
   begin
      if (FButtonStyle = cbsDownArrow) then
         FButton.Glyph.Handle:= LoadBitmap(HInstance, 'FCDROPDOWN')
   end;
end;

function TfcCustomCombo.IsCustom: Boolean;
begin
  Result := ButtonStyle = cbsCustom;
end;

function TfcCustomCombo.GetButtonGlyph: TBitmap;
begin
  result:= FButton.Glyph;
end;

procedure TfcCustomCombo.SetButtonGlyph(Value: TBitmap);
begin
  FButton.Glyph.Assign(Value);
//  FButtonGlyph.Assign(Value);
  Invalidate;
end;
{
procedure TfcCustomCombo.GlyphChanged(Sender: TObject);
begin
   FButton.Glyph.Handle:= LoadComboGlyph;
   Invalidate;
end;
}
Procedure TfcCustomCombo.SetButtonWidth(val: integer);
begin
   if FButtonWidth<>val then
   begin
      FButtonWidth:= val;
      if val<>0 then Button.Width:= val
      else Button.Width:= fcmax(GetSystemMetrics(SM_CXVSCROLL), 15);
      UpdateButtonPosition;
   end
end;

function TfcCustomCombo.GetButtonWidth: integer;
begin
   result:= FButtonWidth;
end;

procedure TfcCustomCombo.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  DoMouseEnter;
end;

procedure TfcCustomCombo.CMMouseLeave(var Message: TMessage);
var r:TRect;
    pt:TPoint;
begin
  GetCursorPos(pt);
  pt := ScreenToClient(pt);
  r := ClientRect;
  if (PtInRect(r,pt)) then exit;

  inherited;
  DoMouseLeave;
end;

procedure TfcCustomCombo.DoMouseEnter;
begin
  try
     If Assigned( FOnMouseEnter ) Then FOnMouseEnter( self );  //10/1/2001 - Added for OnMouseEnter and OnMouseLeave events.
  except
    exit;
  end;
  if Frame.IsFrameEffective and (not FFocused) and
     Frame.MouseEnterSameAsFocus then
     fcDrawEdge(self, Frame, FCanvas, True);
//     fcDrawEdge(self, Frame, ControlCanvas, True);
end;

procedure TfcCustomCombo.DoMouseLeave;
begin
  try
    If Assigned( FOnMouseLeave ) Then FOnMouseLeave( self ); //10/1/2001 - Added for OnMouseEnter and OnMouseLeave events.
  except
    exit;
  end;
  if Frame.IsFrameEffective and (not FFocused) and
     Frame.MouseEnterSameAsFocus then begin
     fcDrawEdge(self, Frame, FCanvas, False);
     if IsTransparentEffective then
        Frame.CreateTransparent:= True;
     RecreateWnd;
  end;
end;

// Some fonts change the margin, so let us reset back to 0 so that
// borders will be ok
procedure TfcCustomCombo.WMSetFont(var Message: TWMSetFont);
begin
  inherited;
  if Frame.Enabled and NewStyleControls then
     SendMessage(Handle, EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, 0);
end;

procedure TfcCustomCombo.SetController(Value: TComponent);
var tempFrame: TfcEditFrame;
begin
   if FController<>Value then
   begin
      fcUpdateController(TComponent(FController), Value, self);
      if FController<>nil then
      begin
         tempFrame:= TfcEditFrame.Get(TControl(FController));
         FFrame.Assign(tempFrame);
//         FFrame.Assign(FController.Frame);
         if HandleAllocated then RecreateWnd;
      end
   end
end;


initialization
  WM_FC_CALLDROPDOWN := RegisterWindowMessage('FCCOMBODROPDOWNMESSAGE');
end.