fcbutton.pas

一套及时通讯的原码

    if ((FKind in [bkOK, bkYes]) xor Default) or
       ((FKind in [bkCancel, bkNo]) xor Cancel) or
       (ModalResult <> BITBTNMODALRESULTS[FKind]) or
       FModifiedGlyph then
      FKind := bkCustom;
  Result := FKind;
end;

procedure TfcCustomBitBtn.SetAllowAllUp(Value: Boolean);
begin
  if FAllowAllUp <> Value then
  begin
    FAllowAllUp := Value;
    UpdateExclusive;
  end;
end;

procedure TfcCustomBitBtn.SetDefault(Value: Boolean);
var
  Form: TCustomForm;
begin
  FDefault := Value;
  if HandleAllocated then
  begin
    Form := GetParentForm(Self);
    if Form <> nil then
      Form.Perform(CM_FOCUSCHANGED, 0, Longint(Form.ActiveControl));
  end;
end;

procedure TfcCustomBitBtn.SetDown(Value: Boolean);
begin
  if (FGroupIndex = 0) and (not (csLoading in ComponentState)) then Value := False;
  if FDown <> Value then
  begin
    SetButtonDown(Value, True, True, True);
    if FDown = Value then SelChange;
  end;
end;

procedure TfcCustomBitBtn.SetGlyph(Value: TBitmap);
begin
  Glyph.Assign(Value);
  Invalidate;
end;

procedure TfcCustomBitBtn.SetGroupIndex(Value: Integer);
begin
  if FGroupIndex <> Value then
  begin
    FGroupIndex := Value;
    UpdateExclusive;
  end;
end;

procedure TfcCustomBitBtn.SetKind(Value: TBitBtnKind);
begin
  if Value <> FKind then
  begin
    if Value <> bkCustom then
    begin
      Default := Value in [bkOK, bkYes];
      Cancel := Value in [bkCancel, bkNo];

      if ((csLoading in ComponentState) and (GetDBCaption = '')) or
        (not (csLoading in ComponentState)) then
      begin
        if BitBtnCaptions[Value] <> nil then
          Caption := LoadResString(BitBtnCaptions[Value]);
      end;

      ModalResult := BITBTNMODALRESULTS[Value];
      GetBitBtnGlyph(Value, FGlyph);
      NumGlyphs := 2;
      FModifiedGlyph := False;
    end;
    FKind := Value;
    Invalidate;
  end;
end;

procedure TfcCustomBitBtn.SetLayout(Value: TButtonLayout);
begin
  if FLayout <> Value then
  begin
    FLayout := Value;
    Invalidate;
  end;
end;

procedure TfcCustomBitBtn.SetMargin(Value: Integer);
begin
  if (Value <> FMargin) and (Value >= - 1) then
  begin
    FMargin := Value;
    Invalidate;
  end;
end;

procedure TfcCustomBitBtn.SetNumGlyphs(Value: TNumGlyphs);
begin
  Value := fcMin(fcMax(Value, 1), 4);
  if Value <> FNumGlyphs then
  begin
    FNumGlyphs := Value;
    Invalidate;
  end;
end;

procedure TfcCustomBitBtn.SetOptions(Value: TfcButtonOptions);
var ChangedOptions: TfcButtonOptions;
begin
  if FOptions <> Value then
  begin
    ChangedOptions := (FOptions - Value) + (Value - FOptions);
    FOptions := Value;
    if not (boFocusable in FOptions) then TabStop := False;
    if boAutoBold in ChangedOptions then SetButtonDown(Down, False, False, True);
  end;
end;

procedure TfcCustomBitBtn.SetShadeStyle(Value: TfcShadeStyle);
begin
  if FShadeStyle <> Value then
  begin
    FShadeStyle := Value;
    Recreatewnd;
  end;
end;

procedure TfcCustomBitBtn.SetSpacing(Value: Integer);
begin
  if FSpacing <> Value then
  begin
    FSpacing := Value;
    Invalidate;
  end;
end;

procedure TfcCustomBitBtn.SetStyle(Value: TButtonStyle);
begin
  if Value <> FStyle then
  begin
    FStyle := Value;
    Invalidate;
  end;
end;

function TfcCustomBitBtn.IsCustom: Boolean;
begin
  Result := Kind = bkCustom;
end;

function TfcCustomBitBtn.IsCustomCaption: Boolean;
begin
  Result := CompareStr(Caption, LoadResString(BitBtnCaptions[FKind])) <> 0;
end;

function TfcCustomBitBtn.MouseInControl(X, Y: Integer; AndClicked: Boolean): Boolean;
var p: TPoint;
    AHandle: HWND;
    TmpRgn: HRGN;
    Control: TWinControl;
    ParentForm:TCustomForm;
begin
  //11/17/99 - Make sure that only active window is hot-tracked.
  //2/22/00 - Disregard parent test if MDI form }
  ParentForm := GetParentForm(self);
  if (ParentForm<>nil) and (ParentForm.handle<>GetActiveWindow) then begin
    if not (TForm(ParentForm).formstyle in [fsMDIChild, fsMDIForm]) and
       not (fcIsClass(ParentForm.classType, 'TActiveForm')) then // 7/31/00 - Disregard parent test for ActiveX forms
      // 5/18/2000 - PYW - Don't exit if ParentForm was created using CreateParented.
      if (ParentForm.ParentWindow = 0) or (GetParent(ParentForm.ParentWindow) <> GetActiveWindow) then
      begin
        result := False;
        exit;
      end;
  end;

  if IsMultipleRegions then Control := self else Control := Parent;
  if (x = -1) and (y = -1) then p := Control.ScreenToClient(fcGetCursorPos)
  else p := Control.ScreenToClient(ClientToScreen(Point(x, y)));

  if IsMultipleRegions then
  begin
    TmpRgn := CreateRegion(True, not Down);
    CombineRgn(TmpRgn, TmpRgn, FLastRegion, RGN_OR);
    result := PtInRegion(TmpRgn, p.x, p.y);
    DeleteOBject(TmpRgn);
  end else begin
    //12/20/2001 - Skip invisible controls. {PYW}
    AHandle := ChildWindowFromPointEx(Parent.Handle, p, CWP_SKIPINVISIBLE);
    result := FindControl(AHandle) = self;
  end;
  if AndClicked then result := result and FClicked;
end;

procedure Initialize;
begin
  FillChar(BitBtnGlyphs, SizeOf(BitBtnGlyphs), 0);
  BitBtnCaptions[bkOK] := @SOKButton;
  BitBtnCaptions[bkCancel] := @SCancelButton;
  BitBtnCaptions[bkHelp] := @SHelpButton;
  BitBtnCaptions[bkYes] := @SYesButton;
  BitBtnCaptions[bkNo] := @SNoButton;
  BitBtnCaptions[bkClose] := @SCloseButton;
  BitBtnCaptions[bkAbort] := @SAbortButton;
  BitBtnCaptions[bkRetry] := @SRetryButton;
  BitBtnCaptions[bkIgnore] := @SIgnoreButton;
  BitBtnCaptions[bkAll] := @SAllButton;
end;

procedure Finalize;
var i: TBitBtnKind;
begin
  for i := Low(TBitBtnKind) to High(TBitBtnKind) do
    BitBtnGlyphs[I].Free;
end;

procedure TfcCustomBitBtn.WMSize(var Message: TWMSize);
var r: TRect;
begin
  inherited;
  ClearRegion(@FRegionData);
  ClearRegion(@FDownRegionData);
  SetWindowRgn(Handle, 0, True);
  ApplyRegion;
  Invalidate;
  r := BoundsRect;
  if Parent <> nil then InvalidateRect(Parent.Handle, @r, True);
end;

{ RSW - 3/9/99 - Process default button when carriage return or Cancel entered }
procedure TfcCustomBitBtn.CMDialogKey(var Message: TCMDialogKey);
begin
  with Message do
    if  (((CharCode = VK_RETURN) and FActive) or
      ((CharCode = VK_ESCAPE) and FCancel)) and
      (KeyDataToShiftState(Message.KeyData) = []) and CanFocus then
    begin
      Click;
      Result := 1;
    end else
      inherited;
end;

procedure TfcCustomBitBtn.WMCancelMode(var Message: TWMCancelMode);
begin
  inherited;
  if csLButtonDown in ControlState then Perform(WM_LBUTTONUP, 0, Integer($FFFFFFFF));
end;

procedure TfcCustomBitBtn.InvalidateNotRegion(const Erase: Boolean);
var Rgn, TmpRgn: HRGN;
  DownFlag:Boolean;
begin
  DownFlag := Down and not (csPaintCopy in ControlState); // 6/17/02
  if False and ShowDownAsUp then begin
     if Down then DownFlag := False;
     if FClicked and MouseInControl(-1,-1,False) and not Selected then
        DownFlag := True;
  end;

  with ClientRect do Rgn := CreateRectRgn(Left, Top, Right, Bottom);
  with ClientRect do TmpRgn := CreateRegion(False, DownFlag);

  try
    CombineRgn(Rgn, Rgn, TmpRgn, RGN_DIFF);
    OffsetRgn(Rgn, Left, Top);
    InvalidateRgn(Parent.Handle, Rgn, Erase);
  finally
    DeleteObject(Rgn);
    DeleteObject(TmpRgn);
  end;
end;

function TfcCustomBitBtn.UseRegions: boolean;
begin
   result:= False;
end;

// 6/17/02 - Support button painting in grid
procedure TfcCustomBitBtn.WMPaint(var Message: TWMPaint);
var tc: TColor;
  procedure CanvasNeeded;
  begin
    if FCanvas = nil then
    begin
      FCanvas := TControlCanvas.Create;
      TControlCanvas(FCanvas).Control := Self;
    end;
  end;

begin
  if not (csPaintCopy in ControlState) then
  begin
     inherited;
  end
  else begin
     tc:= Font.Color;
     if fcIsInwwGridPaint(self) and (message.dc<>0) then tc:= GetTextColor(message.dc);
     CanvasNeeded;
     FCanvas.Handle := Message.dc;
     FCanvas.Font:= Font;
     if fcIsInwwGridPaint(self) and (message.dc<>0) then FCanvas.Font.Color:= tc;
     Paint;
     FCanvas.Handle := 0;
  end;
end;

procedure TfcCustomBitBtn.CMGetDataLink(var Message: TMessage);
begin
  Message.Result := Integer(FDataLink);
end;

function TfcCustomBitBtn.GetDataSource: TDataSource;
begin
  if (FDataLink<>Nil) and (FDataLink.DataSource is TDataSource) then begin
     Result := FDataLink.DataSource as TDataSource
  end
  else Result:= Nil;
end;

procedure TfcCustomBitBtn.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource := Value;
end;

function TfcCustomBitBtn.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

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

{procedure TfcCustomBitBtn.SetCaption(val: string);
begin
   if FDataLink.Field<>nil then
   begin
      if (DataSource<>Nil) and (DataSource.autoEdit) then
         if not (DataSource.state in [dsEdit, dsInsert]) then
            FDataLink.Edit;
      FDataLink.Field.Text:= val;
   end
   else inherited Caption:= val
end;
}
function TfcCustomBitBtn.GetDBCaption: string;
begin
   if (not StaticCaption) and (csPaintCopy in ControlState) and (FDataLink.Field <> nil) then
   begin
      if (FDataLink.Field is TBlobField) then
         result:= FDataLink.Field.asString
      else
         result:= FDataLink.Field.DisplayText
   end
   else result:= inherited Caption
end;

procedure TfcCustomBitBtn.DataChange(Sender: TObject);
begin
  if (FDataLink.Field <> nil) and (not StaticCaption) then
  begin
    if (FDataLink.Field is TBlobField) then
       inherited Caption := FDataLink.Field.asString
    else inherited Caption := FDataLink.Field.DisplayText;
  end
end;

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

function TfcCustomBitBtn.GetField: TField;
begin
  Result := FDataLink.Field;
end;

initialization
  Initialize;
finalization
  Finalize;
end.