fcbutton.pas

一套及时通讯的原码

  with FTextRect do FTextRect := Rect(
    fcMax(0, Left), fcMax(0, Top), fcMin(ClientWidth, Right), fcMin(ClientHeight, Bottom));

  if not Glyph.Empty then DrawButtonGlyph(Canvas, FGlyphRect.TopLeft);
  DrawButtonText(Canvas, FTextRect);

  if (boFocusRect in Options) and (boFocusable in Options) and Focused then
  begin
    UnionRect(r, TextRect, GlyphRect);
    InflateRect(r, 2, 2);
    Canvas.Brush.Color := clWhite;
    Canvas.Font.Color := clBlack;
    Canvas.DrawFocusRect(r);
  end;
end;

function TfcCustomBitBtn.CalcButtonLayout(Canvas: TCanvas; Client: TRect;
  var TextRect: TRect; var GlyphRect: TRect; TextSize: TSize): TRect;
var GlyphSize: TSize;
    TopLeft: TPoint;
    Spacing: Integer;
    EffectiveMargin: Integer;
    DownFlag:boolean;
begin
  DownFlag := Down and not (csPaintCopy in ControlState); // 6/17/02
  if ShowDownAsUp then begin
     if Down then DownFlag := False;
     if FClicked and MouseInControl(-1,-1,False) and not Selected then
        DownFlag := True;
  end;

  InflateRect(Client, -Margin, -Margin);
  if Margin = -1 then EffectiveMargin := 4 else EffectiveMargin := Margin;
  SetRectEmpty(GlyphRect);
  GlyphSize := fcSize(0, 0);
  if not Glyph.Empty then GlyphSize := fcSize(GlyphWidth, Glyph.Height);
  Spacing := 0;
  if (GetDBCaption <> '') and (not Glyph.Empty) then Spacing := self.Spacing;
  case TextOptions.Alignment of
    taLeftJustify: TopLeft := Point(EffectiveMargin + (TextSize.cx + GlyphSize.cx + Spacing) div 2, Height div 2);
    taRightJustify: TopLeft := Point(-EffectiveMargin + Width - (TextSize.cx + GlyphSize.cx + Spacing) div 2, Height div 2);
    taCenter: TopLeft := Point(Width div 2, Height div 2);
  end;

  fcCalcButtonLayout(TopLeft, @TextRect, @GlyphRect, TextSize, GlyphSize, Layout, Spacing);

  OffsetRect(TextRect, Offsets.TextX, Offsets.TextY);
  OffsetRect(GlyphRect, Offsets.GlyphX, Offsets.GlyphY);

  // Offset if down
  if DownFlag then
  begin
    OffsetRect(TextRect, Offsets.TextDownX, Offsets.TextDownY);
    OffsetRect(GlyphRect, Offsets.TextDownX, Offsets.TextDownY);
  end;
  result := Client;
end;

procedure TfcCustomBitBtn.ReadRegionData(Stream: TStream);
begin
  Stream.ReadBuffer(FRegionData.dwSize, SizeOf(FRegionData.dwSize));
  if FRegionData.dwSize <> 0 then
  begin
    GetMem(FRegionData.rgnData, FRegionData.dwSize);
    Stream.ReadBuffer(FRegionData.rgnData^, FRegionData.dwSize);
  end;
end;

procedure TfcCustomBitBtn.ReadDownRegionData(Stream: TStream);
begin
  Stream.ReadBuffer(FDownRegionData.dwSize, SizeOf(FDownRegionData.dwSize));
  if FDownRegionData.dwSize <> 0 then
  begin
    GetMem(FDownRegionData.rgnData, FDownRegionData.dwSize);
    Stream.ReadBuffer(FDownRegionData.rgnData^, FDownRegionData.dwSize);
  end;
end;

procedure TfcCustomBitBtn.WriteRegionData(Stream: TStream);
begin
  if FRegionData.rgnData <> nil then
  begin
    Stream.WriteBuffer(FRegionData.dwSize, SizeOf(FRegionData.dwSize));
    Stream.WriteBuffer(FRegionData.rgnData^, FRegionData.dwSize);
  end else begin
    FRegionData.dwSize := 0;
    Stream.WriteBuffer(FRegionData.dwSize, SizeOf(FRegionData.dwSize));
  end;
end;

procedure TfcCustomBitBtn.WriteDownRegionData(Stream: TStream);
begin
  if FDownRegionData.rgnData <> nil then
  begin
    Stream.WriteBuffer(FDownRegionData.dwSize, SizeOf(FDownRegionData.dwSize));
    Stream.WriteBuffer(FDownRegionData.rgnData^, FDownRegionData.dwSize);
  end else begin
    FDownRegionData.dwSize := 0;
    Stream.WriteBuffer(FDownRegionData.dwSize, SizeOf(FDownRegionData.dwSize));
  end;
end;

procedure TfcCustomBitBtn.ApplyRegion;
var CurParent: TWinControl;
    DownFlag:Boolean;
begin
  if not HandleAllocated then Exit;
  if not UseRegions then exit;

  DownFlag := Down and not (csPaintCopy in ControlState); // 6/17/02
  if ShowDownAsUp then begin
     if Down then DownFlag := False;
     if FClicked and MouseInControl(-1,-1,False) and not Selected then
        DownFlag := True;
  end;

  SetWindowRgn(Handle, 0, False);
  if FRegion <> 0 then DeleteObject(FRegion);
  FRegion := CreateRegion(True, DownFlag);

  if (FLastRegion <> 0) and (FRegion <> 0) and IsMultipleRegions then
  begin
    CombineRgn(FLastRegion, FLastRegion, FRegion, RGN_XOR);

    CurParent := self;
    while (CurParent <> GetParentForm(self)) and (CurParent <> nil) do
    begin
      OffsetRgn(FLastRegion, CurParent.Left, CurParent.Top);
      InvalidateRgn(CurParent.Parent.Handle, FLastRegion, True);
      CurParent := CurParent.Parent;
    end;
  end;

  if IsMultipleRegions then
  begin
    if FLastRegion <> 0 then DeleteObject(FLastRegion);
    FLastRegion := CreateRectRgn(0, 0, 10, 10);
    CombineRgn(FLastRegion, FRegion, 0, RGN_COPY);
  end;

  SetWindowRgn(Handle, FRegion, False);
  if IsMultipleRegions and (Parent <> nil) then fcInvalidateOverlappedWindows(Parent.Handle, Handle);
end;

procedure TfcCustomBitBtn.ChangeButtonDown;
begin
  if IsMultipleRegions then ApplyRegion;
end;

procedure TfcCustomBitBtn.GetEvents(const s: string);
begin
  FEvents.Add(s);
end;
{
procedure TfcCustomBitBtn.WriteState(Writer: TWriter);
var
    FormDesigner: IFormDesigner;
    s: string;
begin
  if (csDesigning in ComponentState) and (GetParentForm(self) <> nil) and not (Owner is TCustomForm) then
  begin
    FormDesigner := IFormDesigner(GetParentForm(self).Designer);
    FEvents.Clear;
    FormDesigner.GetMethods(GetTypeData(TypeInfo(TNotifyEvent)), GetEvents);
    s := FormDesigner.GetMethodName(TMethod(OnClick));
    if FEvents.IndexOf(s) = -1 then OnClick := nil;
  end;
  inherited;
end;
}
procedure TfcCustomBitBtn.SelChange;
begin
  FSelected := Down;
  if Assigned(FOnSelChange) then FOnSelChange(self);
  NotifyChange;
end;

procedure TfcCustomBitBtn.SaveRegion(NewRegion: Longword; Down: Boolean);
var ARgnData: ^TfcRegionData;
begin
  if not Down then ARgnData := @FRegionData else ARgnData := @FDownRegionData;
  if ARgnData^.rgnData <> nil then FreeMem(ARgnData^.rgnData);
  ARgnData^.rgnData := nil;
  ARgnData^.dwSize := GetRegionData(NewRegion, 0, nil);
  GetMem(ARgnData^.rgnData, ARgnData^.dwSize);
  GetRegionData(NewRegion, ARgnData^.dwSize, ARgnData^.rgnData);
end;

function TfcCustomBitBtn.CreateRegion(DoImplementation: Boolean; Down: Boolean): HRgn;
var ARgnData: PRgnData;
begin
  if (not Down and (FRegionData.rgnData <> nil)) or (Down and (FDownRegionData.rgnData <> nil)) then
  begin
    if Down then ARgnData := FDownRegionData.rgnData else ARgnData := FRegionData.rgnData;
    result := ExtCreateRegion(nil, ARgnData.rdh.dwSize + ARgnData.rdh.nRgnSize, ARgnData^);
  end else result := 0;
end;

procedure TfcCustomBitBtn.ClearRegion(ARgnData: PfcRegionData);
begin
  if ARgnData^.rgnData <> nil then
  begin
    FreeMem(ARgnData^.rgnData);
    ARgnData^.rgnData := nil;
  end;
end;

procedure TfcCustomBitBtn.DrawButtonGlyph(Canvas: TCanvas; const GlyphPos: TPoint);
var
  ImageList: TImageList;
  TempGlyph: TBitmap;
  Offset: Integer;
  DownFlag:Boolean;
begin
  Offset := 0;
  DownFlag := Down and not (csPaintCopy in ControlState); // 6/17/02
  if ShowDownAsUp then begin
     if Down then DownFlag := False;
     if FClicked and MouseInControl(-1,-1,False) and not Selected then
        DownFlag := True;
  end;

  if not Enabled and (NumGlyphs > 1) then Offset := GlyphWidth
  else if Downflag and (NumGlyphs > 2) then Offset := 2 * GlyphWidth
  else if MouseInControl(-1, -1, False) and (NumGlyphs > 3) then Offset := 3 * GlyphWidth;

  ImageList := TImageList.Create(self);

// RSW - 7/6/00 - Resolve redline problem with some environments
  if ((Enabled) or (NumGlyphs > 1)) and odd(GlyphPos.x) then
    ImageList.Width := GlyphWidth+1
  else
    ImageList.Width := GlyphWidth;
  ImageList.Height := Glyph.Height;
  TempGlyph := TBitmap.Create;

  try
    TempGlyph.Width := ImageList.Width;
    TempGlyph.Height := Glyph.Height;

    if (not Enabled) and (NumGlyphs <= 1) then
    begin
       fcCreateDisabledBitmap(Glyph, TempGlyph);
       TempGlyph.Transparent := True;
       ImageList.AddMasked(TempGlyph, TempGlyph.TransparentColor);
       with GlyphPos do begin
         fcImageListDraw(ImageList, 0, Canvas, x, y, ILD_NORMAL, True)
       end
    end
    else begin
      if odd(GlyphPos.x) then begin
        TempGlyph.Canvas.CopyRect(Rect(0, 0, GlyphWidth, Glyph.Height),
           Glyph.Canvas, Rect(Offset, 0, Offset + GlyphWidth, Glyph.Height));
        TempGlyph.Canvas.Brush.Color:= TempGlyph.TransparentColor;
        TempGlyph.Canvas.FillRect(Rect(0, 0, 1, Glyph.Height));
        TempGlyph.Canvas.CopyRect(Rect(1, 0, GlyphWidth+1, Glyph.Height),
           Glyph.Canvas, Rect(Offset, 0, Offset + GlyphWidth, Glyph.Height));
      end
      else begin
        TempGlyph.Canvas.CopyRect(Rect(0, 0, TempGlyph.Width, TempGlyph.Height),
           Glyph.Canvas, Rect(Offset, 0, Offset + GlyphWidth, Glyph.Height));
      end;
      TempGlyph.Transparent := True;
      ImageList.AddMasked(TempGlyph, TempGlyph.TransparentColor);
      with GlyphPos do begin
        fcImageListDrawFixBug(ImageList, 0, Canvas, x, y, ILD_NORMAL, True)
      end
    end;
  finally
    ImageList.Free;
    TempGlyph.Free;
  end;
end;

procedure TfcCustomBitBtn.DrawButtonText(Canvas: TCanvas; TextBounds: TRect);
begin
  Canvas.Brush.Style := bsClear;
  TextOptions.TextRect := TextBounds;
  TextOptions.Draw;
end;

procedure TfcCustomBitBtn.DrawItem(const DrawItemStruct: TDrawItemStruct);
begin
  if csDestroying in ComponentState then exit;  // 7/2/02 - Exit if destroying
  if ( width < 1 ) or ( height < 1 ) then exit; // 7/3/02 - No space to draw

  FCanvas.Handle := DrawItemStruct.hDC;
  Paint;
  FCanvas.Handle := 0;
end;

procedure TfcCustomBitBtn.GetDrawBitmap(DrawBitmap: TfcBitmap; ForRegion: Boolean;
  ShadeStyle: TfcShadeStyle; Down: Boolean);
begin
end;

procedure TfcCustomBitBtn.GlyphChanged(Sender: TObject);
begin
  Invalidate;
end;

function TfcCustomBitBtn.GlyphWidth: Integer;
begin
  result := Glyph.Width;
  if NumGlyphs <> 0 then
    result := Glyph.Width div NumGlyphs;
end;

function TfcCustomBitBtn.IsMultipleRegions: Boolean;
begin
  result := False;
end;

function TfcCustomBitBtn.StoreRegionData: Boolean;
begin
  result := False;
end;

procedure TfcCustomBitBtn.NotifyLoaded;
var i: Integer;
begin
  for i := 0 to FChangeLinks.Count - 1 do
    with TfcChangeLink(FChangeLinks[i]) do
  begin
    Sender := self;
    Loaded;
  end;
end;

procedure TfcCustomBitBtn.NotifyChange;
var i: Integer;
begin
  for i := 0 to FChangeLinks.Count - 1 do
    with TfcChangeLink(FChangeLinks[i]) do
  begin
    Sender := self;
    Change;
  end;
end;

procedure TfcCustomBitBtn.NotifyChanging;
var i: Integer;
begin
  for i := 0 to FChangeLinks.Count - 1 do
    with TfcChangeLink(FChangeLinks[i]) do
  begin
    Sender := self;
    Changing;
  end;
end;

procedure TfcCustomBitBtn.Paint;
var DrawBitmap: TfcBitmap;
    DownFlag:Boolean;
begin
  DownFlag := Down and not (csPaintCopy in ControlState); // 6/17/02
  if ShowDownAsUp then begin
     if Down then DownFlag := False;
     if MouseInControl(-1,-1,False) and (not Selected) and (FClicked) then
        DownFlag := True;
  end;

  DrawBitmap := TfcBitmap.Create;
  DrawBitmap.UseHalftonePalette:= FUseHalftonePalette;
  try
    if (ShadeStyle=fbsFlat) and (BasePatch[0]=True) then { 6/8/99 }  {6/2/2000}
       GetDrawBitmap(DrawBitmap, False, fbsNormal, DownFlag)
    else
       GetDrawBitmap(DrawBitmap, False, ShadeStyle, DownFlag);

    Draw(DrawBitmap.Canvas);
    Canvas.Draw(0, 0, DrawBitmap);       // Paint TempBitmap to Canvas
    {$ifdef fcDelphi4Up} { 6/6/99 - Add SmoothFont property }
    if SmoothFont then begin
       TextOptions.Canvas:= Canvas;
       DrawButtonText(Canvas, TextRect); { Repaint text of button }
    end
    {$endif}
  finally
    DrawBitmap.Free;
  end;
end;

procedure TfcCustomBitBtn.Redraw;
begin
  FCanvas.Handle := GetDC(Handle);
  Paint;
  ReleaseDC(Handle, FCanvas.Handle);
  FCanvas.Handle := 0;
end;

procedure TfcCustomBitBtn.SetButtonDown(Value: Boolean; CheckAllowAllUp: Boolean; DoUpdateExclusive: Boolean; DoInvalidate: Boolean);
begin
  if Value <> FDown then