fcbutton.pas

一套及时通讯的原码

    with Dest as TfcOffsets do
  begin
    GlyphX := self.GlyphX;
    GlyphY := self.GlyphY;
    TextX := self.TextX;
    TextY := self.TextY;
    TextDownX := self.TextDownX;
    TextDownY := self.TextDownY;
  end else inherited;
end;

procedure TfcOffsets.SetGlyphX(Value: Integer);
begin
  if FGlyphX <> Value then
  begin
    FGlyphX := Value;
    Control.Invalidate;
  end;
end;

procedure TfcOffsets.SetGlyphY(Value: Integer);
begin
  if FGlyphY <> Value then
  begin
    FGlyphY := Value;
    Control.Invalidate;
  end;
end;

procedure TfcOffsets.SetTextX(Value: Integer);
begin
  if FTextX <> Value then
  begin
    FTextX := Value;
    Control.Invalidate;
  end;
end;

procedure TfcOffsets.SetTextY(Value: Integer);
begin
  if FTextY <> Value then
  begin
    FTextY := Value;
    Control.Invalidate;
  end;
end;

// TfcShadeColors

constructor TfcShadeColors.Create(Button: TfcCustomBitBtn);
begin
  inherited Create;
  FButton := Button;

  FBtnHighlight := clBtnHighlight;
  FBtn3DLight := cl3DLight;
  FBtnShadow := clBtnShadow;
end;

procedure TfcShadeColors.AssignTo(Dest: TPersistent);
begin
  if Dest is TfcShadeColors then
    with Dest as TfcShadeColors do
  begin
    Btn3dLight := self.Btn3dLight;
    BtnHighlight := self.BtnHighlight;
    BtnShadow := self.BtnShadow;
    BtnBlack := self.BtnBlack;
    BtnFocus := self.BtnFocus;
    Shadow := self.Shadow;
  end else inherited;
end;

procedure TfcShadeColors.SetBtn3DLight(Value: TColor);
begin
  if Value <> FBtn3DLight then
  begin
    FBtn3DLight := Value;
    FButton.Invalidate;
  end;
end;

procedure TfcShadeColors.SetBtnBlack(Value: TColor);
begin
  if FBtnBlack <> Value then
  begin
    FBtnBlack := Value;
    FButton.Invalidate;
  end;
end;

procedure TfcShadeColors.SetBtnHighlight(Value: TColor);
begin
  if Value <> FBtnHighlight then
  begin
    FBtnHighlight := Value;
    FButton.Invalidate;
  end;
end;

procedure TfcShadeColors.SetBtnShadow(Value: TColor);
begin
  if Value <> FBtnShadow then
  begin
    FBtnShadow := Value;
    FButton.Invalidate;
  end;
end;

procedure TfcShadeColors.SetBtnFocus(Value: TColor);
begin
  if Value <> FBtnFocus then
  begin
    FBtnFocus := Value;
    FButton.Invalidate;
  end;
end;

procedure TfcShadeColors.SetShadow(Value: TColor);
begin
  if FShadow <> Value then
  begin
    FShadow := Value;
    FButton.Invalidate;
  end;
end;

// TfcCustomBitBtn

function TfcCustomBitBtn.GetTextEnabled: Boolean;
begin
  result := Enabled;
end;

procedure TfcCustomBitBtn.AdjustBounds;
begin
end;

constructor TfcCustomBitBtn.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csSetCaption, csOpaque, csReflector];

  FShowDownAsUp:=False;
  FCanvas := TCanvas.Create;
  FChangeLinks := TList.Create;
  Color := clBtnFace;
  FChangeLink := TfcChangeLink.Create;
  FGlyph := TBitmap.Create;
  FGlyph.OnChange := GlyphChanged;
  Height := 25;
  FKind := bkCustom;
  FLayout := blGlyphLeft;
  FMargin := -1;
  FOffsets := CreateOffsets;
  FShadeColors := TfcShadeColors.Create(self);
  FShowFocusRect := True;
  FSpacing := 4;
  FShadeStyle := fbsNormal;
  FStyle := bsAutoDetect;
  TabStop := True;
  FTextOptions := TfcCaptionText.Create(MakeCallbacks(Invalidate, AdjustBounds, GetTextEnabled),
    FCanvas, Font);
  FTextOptions.Alignment := taCenter;
  FTextOptions.VAlignment := vaVCenter;
  FEvents := TStringList.Create;
  Width := 75;

  BasePatch:= VarArrayCreate([0, 1], varVariant);
  BasePatch[0]:= False; { 6/8/99 - Internal use to support painting issues with flat buttons }
  BasePatch[1]:= False; { 6/19/2000 - PYW - Internal use to solve MouseDown problems with nonfocus buttons.  Set to True to preserve old behavior.}

  FUseHalftonePalette:= False;

  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;

end;

destructor TfcCustomBitBtn.Destroy;
begin
  FDataLink.OnDataChange := nil;
  FDataLink.Free;
  FDataLink := nil;

  CleanUp;
  if FRegionData.rgnData <> nil then FreeMem(FRegionData.rgnData);
  if FDownRegionData.rgnData <> nil then FreeMem(FDownRegionData.rgnData);
  FCanvas.Free;
  FChangeLinks.Free;
  FChangeLinks:= nil;
  FChangeLink.Free;
  FGlyph.Free;
  FOffsets.Free;
  FShadeColors.Free;
  FTextOptions.Free;
  FEvents.Free;
  inherited Destroy;
end;

procedure TfcCustomBitBtn.CleanUp;
begin
  if FRegion <> 0 then
  begin
    if not (csDestroying in ComponentState) and HandleAllocated then SetWindowRgn(Handle, 0, False);
    DeleteObject(FRegion);
    DeleteObject(FLastRegion);
    FRegion := 0;
    FLastRegion := 0;
  end;
end;

//{$ifdef fcDelphi4Up}
//type TFormDesigner = IFormDesigner;
//{$endif}

procedure TfcCustomBitBtn.WndProc(var Message: TMessage);
var
//    Selections: TComponentList;
//    SelPosition: Integer;
    ButtonGroup: TWinControl;
{  function IsSelected: Boolean;
  var CompList: TComponentList;
      i: Integer;
  begin
    CompList := TComponentList.Create;
    TFormDesigner(GetParentForm(ButtonGroup).Designer).GetSelections(CompList);
    result := False;
    for i := 0 to CompList.Count - 1 do if Selections[i] = self then
      result := True;
    CompList.Free;
  end;
  function InList: Integer;
  var i: Integer;
  begin
    for i := 0 to Selections.Count - 1 do if Selections[i] = ButtonGroup then
    begin
      result := i;
      Exit;
    end;
    result := -1;
  end;
  procedure RemoveButtonGroup;
  var NewSelections: TComponentList;
      i: Integer;
  begin
    NewSelections := TComponentList.Create;
    for i := 0 to Selections.Count - 1 do
      if i <> SelPosition then NewSelections.Add(Selections[i]);
    Selections.Free;
    Selections := NewSelections;
  end;}
begin
  if (csDesigning in ComponentState) and (Parent <> nil) and fcIsClass(Parent.ClassType, 'TfcCustomButtonGroup') then
  begin
    ButtonGroup := Parent;
    case Message.Msg of
      // If the user right-clicks on the control then
      // this code will select the buttonGroup (instead of
      // having this button be selected) and then pass the
      // message along to the ButtonGroup.
      WM_RBUTTONDOWN: begin
        ButtonGroup.Perform(WM_LBUTTONDOWN, Message.wParam, MakeLParam(LoWord(Message.lParam) + Left, HiWord(Message.lParam) + Top));
        ButtonGroup.Dispatch(Message);
      end;

{      WM_RBUTTONDOWN: begin
        TFormDesigner(GetParentForm(ButtonGroup).Designer).SelectComponent(ButtonGroup);
        ButtonGroup.Dispatch(Message);
      end;
}
      WM_LBUTTONDOWN: begin
        if (GetKeyState(DESIGN_KEY) < 0) then
          inherited
        else begin
            ButtonGroup.Dispatch(Message);
            ButtonGroup.Perform(Message.Msg, Message.wParam, MakeLParam(LoWord(Message.lParam) + Left, HiWord(Message.lParam) + Top));
            { 2/21/99 -ksw - LockedWindow fix }
            if GetCapture = ButtonGroup.Handle then ReleaseCapture;
        end
      end;

      // Prevent the default ComponentEditor to occur if
      // the space key isn't pressed down. -ksw (6/24/98)
      WM_LBUTTONDBLCLK:
        if (GetKeyState(DESIGN_KEY) < 0) then
          inherited
        else begin
          // This line is a tweak that prevents an annoyance
          // in which after double-clicking on the Navigator,
          // clicking again would move attempt to move it, event
          // if you weren't clicking in the navigator.  -ksw (6/24/98)
          ButtonGroup.Perform(WM_LBUTTONDOWN, Message.wParam, MakeLParam(LoWord(Message.lParam) + Left, HiWord(Message.lParam) + Top));

          // These other two lines need to go together.  If the second line is called
          // without the call to the first, Delphi will exit out rather
          // ungracefully.  If the first one is called without the call to the
          // second one, the double-click isn't processed by Delphi.
          ButtonGroup.Dispatch(Message);
          ButtonGroup.Perform(Message.Msg, Message.wParam, Message.lParam);
        end;
      else inherited;
    end;
  end else inherited;
end;

procedure TfcCustomBitBtn.AssignTo(Dest: TPersistent);
begin
  if Dest is TfcCustomBitBtn then
    with Dest as TfcCustomBitBtn do
  begin
    Color := self.Color;
    Offsets.Assign(self.Offsets);
//    Glyph := self.Glyph;
    Layout := self.Layout;
    Margin := self.Margin;
    NumGlyphs := self.NumGlyphs;
    Options := self.Options;
    ShadeColors.Assign(self.ShadeColors);
    Spacing := self.Spacing;
    TabStop := self.TabStop;
    TextOptions.Assign(self.TextOptions);
  end else inherited;
end;

procedure TfcCustomBitBtn.CreateParams(var Params: TCreateParams);
const
  ButtonStyles: array[Boolean] of UINT = (BS_PUSHBUTTON, BS_DEFPUSHBUTTON);
begin
  inherited CreateParams(Params);

  CreateSubClass(Params, 'BUTTON');
//  Params.Style := Params.Style or ButtonStyles[FDefault];

  with Params do Style := Style or BS_OWNERDRAW;
end;

procedure TfcCustomBitBtn.Createwnd;
begin
  inherited;
  FActive := FDefault;
  ApplyRegion;
end;

procedure TfcCustomBitBtn.DestroyWnd;
begin
  CleanUp;
  inherited;
end;

procedure TfcCustomBitBtn.DefineProperties(Filer: TFiler);
begin
  inherited;
  Filer.DefineBinaryProperty('RegionData', ReadRegionData, WriteRegionData, StoreRegionData);
  Filer.DefineBinaryProperty('DownRegionData', ReadDownRegionData, WriteDownRegionData, StoreRegionData);
end;

function TfcCustomBitBtn.GetPalette: HPALETTE;
begin
  result := Glyph.Palette;
end;

function TfcCustomBitBtn.CreateOffsets: TfcOffsets;
begin
  result := TfcOffsets.Create(self);
end;

function TfcCustomBitBtn.Draw(Canvas: TCanvas): TRect;
var
  TextSize: TSize;
  r: TRect;
//  Details: TThemedElementDetails;
begin
{  if ThemeServices.ThemesEnabled then
  begin
     if MouseInControl(-1, -1, False) then
       Details := ThemeServices.GetElementDetails(tbPushButtonHot)
     else
       Details := ThemeServices.GetElementDetails(tbPushButtonNormal);
     r:= Rect(-1, -1, Width+2, Height+2);
     ThemeServices.DrawElement(Canvas.Handle, Details, r);
  end;
}
  result := ClientRect;
  InflateRect(result, -2, -2);

  TextOptions.Canvas := Canvas;
  TextOptions.Text := GetDBCaption;
  TextOptions.TextRect := result;

  with TextOptions.CalcDrawRect(True) do
    TextSize := fcSize(Right - Left, Bottom - Top);
  CalcButtonLayout(Canvas, result, FTextRect, FGlyphRect, TextSize);