mmbutton.pas

一套及时通讯的原码

          Pixels[X, Y] := FDownColor;  { on even/odd rows }
  end;
end;

{-- TMMSpeedButton ------------------------------------------------------}
procedure TMMSpeedButton.DrawGlyph(Canvas: TCanvas; const Client: TRect);
begin
     TButtonGlyph(FGlyph).Draw(Canvas,Client,Caption,FLayout,FMargin,
                               FSpacing,FState);
end;

{ DrawButtonFace - returns the remaining usable area inside the Client rect.}
{-- TMMSpeedButton ------------------------------------------------------}
function TMMSpeedButton.DrawButtonFace(Canvas: TCanvas; const Client: TRect;
         BevelStyle: TBevelStyle; IsDown: Boolean): TRect;
var
  R: TRect;

begin
  R := Client;
  with Canvas do
  begin
     Brush.Color := clBtnFace;
     Brush.Style := bsSolid;
     FillRect(R);

     if IsDown then
     begin
        Frame3D(Canvas, R, BevelColor, clBtnHighlight, 1);
        Frame3D(Canvas, R, clBtnShadow, clBtnFace, 1);
     end
     else
     begin
        if BevelStyle = bsRaised then
        begin
           Frame3D(Canvas, R, clBtnHighLight, BevelColor, 1);
           Frame3D(Canvas, R, clBtnFace, clBtnShadow, 1);
        end
        else
        begin
           Pen.Color := BevelColor;
           Rectangle(R.Left, R.Top, R.Right-1, R.Bottom-1);
           Pen.Color := clBtnHighLight;
           PolyLine([Point(R.Left+1, R.Bottom), Point(R.Left+1, R.Top+1),
                     Point(R.Right-2, R.Top+1)]);
           PolyLine([Point(R.Right-1, R.Top), Point(R.Right-1, R.Bottom-1),
                     Point(R.Left+1, R.Bottom-1)]);
        end;
     end;
  end;

  Result := Rect(Client.Left, Client.Top,
                 Client.Right - 1, Client.Bottom - 1);
  if IsDown then OffsetRect(Result, 1, 1);
end;

{-- TMMSpeedButton ------------------------------------------------------}
procedure TMMSpeedButton.Paint;
var
  PaintRect: TRect;
begin
  if not Enabled and not (csDesigning in ComponentState) then
  begin
    FState := bsDisabled;
    FDragging := False;
  end
  else if FState = bsDisabled then FState := bsUp;

  Canvas.Font := Self.Font;

  PaintRect := DrawButtonFace(Canvas, Rect(0, 0, Width, Height), FBevel,
               FState in [bsDown, bsExclusive]);

  if FState = bsExclusive then
  begin
    CreateBrushPattern;
    Canvas.Brush.Bitmap := FPattern;
    dec(PaintRect.Right);
    dec(PaintRect.Bottom);
    Canvas.FillRect(PaintRect);
    Canvas.Brush.Bitmap := nil;
    FPattern.Free;
    FPattern := nil;
  end;

  DrawGlyph(Canvas,PaintRect);
end;

{-- TMMSpeedButton ------------------------------------------------------}
procedure TMMSpeedButton.SetBevel(Value: TBevelStyle);
begin
   if (Value <> FBevel) then
   begin
      FBevel := Value;
      Invalidate;
   end;
end;

{-- TMMSpeedButton ------------------------------------------------------}
procedure TMMSpeedButton.SetDownColor(Value: TColor);
begin
   if (Value <> FDownColor) then
   begin
      FDownColor := Value;
      FPattern.Free;
      FPattern := nil;

      Invalidate;
   end;
end;

{-- TMMSpeedButton ------------------------------------------------------}
procedure TMMSpeedButton.SetBevelColor(Value: TColor);
begin
   if (Value <> FBevelColor) then
   begin
      FBevelColor := Value;
      Invalidate;
   end;
end;


{-- TMMSpeedButton ------------------------------------------------------}
procedure TMMSpeedButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
                                   X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if (Button = mbLeft) and Enabled then
  begin
    if not FDown then
    begin
      FState := bsDown;
      Repaint;
    end;
    FDragging := True;
  end;
end;

{-- TMMSpeedButton ------------------------------------------------------}
procedure TMMSpeedButton.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  NewState: TButtonState;
begin
  inherited MouseMove(Shift, X, Y);
  if FDragging then
  begin
    if not FDown then NewState := bsUp
    else NewState := bsExclusive;
    if (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight) then
      if FDown then NewState := bsExclusive else NewState := bsDown;
    if NewState <> FState then
    begin
      FState := NewState;
      Repaint;
    end;
  end;
end;

{-- TMMSpeedButton ------------------------------------------------------}
procedure TMMSpeedButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  DoClick: Boolean;
begin
  inherited MouseUp(Button, Shift, X, Y);
  if FDragging then
  begin
    FDragging := False;
    DoClick := (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight);
    FState := bsUp;
    if FGroupIndex = 0 then
      Repaint
    else
      if DoClick then SetDown(not FDown)
      else
      begin
        if FDown then FState := bsExclusive;
        Repaint;
      end;
    if DoClick then Click;
  end;
end;

{-- TMMSpeedButton ------------------------------------------------------}
procedure TMMSpeedButton.Click;
begin
  inherited Click;
end;

{-- TMMSpeedButton ------------------------------------------------------}
function TMMSpeedButton.GetPalette: HPALETTE;
begin
  Result := Glyph.Palette;
end;

{-- TMMSpeedButton ------------------------------------------------------}
function TMMSpeedButton.GetGlyph: TBitmap;
begin
  Result := TButtonGlyph(FGlyph).Glyph;
end;

{-- TMMSpeedButton ------------------------------------------------------}
procedure TMMSpeedButton.SetGlyph(Value: TBitmap);
begin
  TButtonGlyph(FGlyph).Glyph := Value;
  Invalidate;

  {$IFDEF WIN32}
  {$IFDEF TRIAL}
  {$DEFINE _HACK2}
  {$I MMHACK.INC}
  {$ENDIF}
  {$ENDIF}
end;

{-- TMMSpeedButton ------------------------------------------------------}
function TMMSpeedButton.GetNumGlyphs: TNumGlyphs;
begin
  Result := TButtonGlyph(FGlyph).NumGlyphs;
end;

{-- TMMSpeedButton ------------------------------------------------------}
procedure TMMSpeedButton.SetNumGlyphs(Value: TNumGlyphs);
begin
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK3}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}

  if Value < 0 then Value := 1
  else if Value > 4 then Value := 4;
  if Value <> TButtonGlyph(FGlyph).NumGlyphs then
  begin
    TButtonGlyph(FGlyph).NumGlyphs := Value;
    Invalidate;
  end;
end;

{-- TMMSpeedButton ------------------------------------------------------}
procedure TMMSpeedButton.GlyphChanged(Sender: TObject);
begin
  Invalidate;
end;

{-- TMMSpeedButton ------------------------------------------------------}
procedure TMMSpeedButton.UpdateExclusive;
var
  Msg: TMessage;
begin
  if (FGroupIndex <> 0) and (Parent <> nil) then
  begin
    Msg.Msg := CM_BUTTONPRESSED;
    Msg.WParam := FGroupIndex;
    Msg.LParam := Longint(Self);
    Msg.Result := 0;
    Parent.Broadcast(Msg);
  end;
end;

{-- TMMSpeedButton ------------------------------------------------------}
procedure TMMSpeedButton.SetDown(Value: Boolean);
begin
  if FGroupIndex = 0 then Value := False;
  if Value <> FDown then
  begin
    if FDown and (not FAllowAllUp) then Exit;
    FDown := Value;
    if Value then FState := bsExclusive
    else FState := bsUp;
    Invalidate;
    if Value then UpdateExclusive;
  end;
end;

{-- TMMSpeedButton ------------------------------------------------------}
procedure TMMSpeedButton.SetGroupIndex(Value: Integer);
begin
  if FGroupIndex <> Value then
  begin
    FGroupIndex := Value;
    UpdateExclusive;
  end;
end;

{-- TMMSpeedButton ------------------------------------------------------}
procedure TMMSpeedButton.SetLayout(Value: TButtonLayout);
begin
  if FLayout <> Value then
  begin
    FLayout := Value;
    Invalidate;
  end;
end;

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

{-- TMMSpeedButton ------------------------------------------------------}
procedure TMMSpeedButton.SetSpacing(Value: Integer);
begin
  if Value <> FSpacing then
  begin
    FSpacing := Value;
    Invalidate;
  end;
end;

{-- TMMSpeedButton ------------------------------------------------------}
procedure TMMSpeedButton.SetAllowAllUp(Value: Boolean);
begin
  if FAllowAllUp <> Value then
  begin
    FAllowAllUp := Value;
    UpdateExclusive;
  end;
  {$IFDEF WIN32}
  {$IFDEF TRIAL}
  {$DEFINE _HACK1}
  {$I MMHACK.INC}
  {$ENDIF}
  {$ENDIF}
end;

{-- TMMSpeedButton ------------------------------------------------------}
procedure TMMSpeedButton.WMLButtonDblClk(var Message: TWMLButtonDown);
begin
  inherited;
  if FDown then DblClick;
end;

{-- TMMSpeedButton ------------------------------------------------------}
procedure TMMSpeedButton.CMEnabledChanged(var Message: TMessage);
begin
  Invalidate;
end;

{$IFDEF WIN32}
{-- TMMSpeedButton ------------------------------------------------------}
procedure TMMSpeedButton.CMHintShow(var Message: TMessage);
begin
  Message.Result := Ord(not Enabled);
end;
{$ENDIF}

{-- TMMSpeedButton ------------------------------------------------------}
procedure TMMSpeedButton.CMButtonPressed(var Message: TMessage);
var
  Sender: TMMSpeedButton;
begin
  if Message.WParam = FGroupIndex then
  begin
    Sender := TMMSpeedButton(Message.LParam);
    if Sender <> Self then
    begin
      if Sender.Down and FDown then
      begin
        FDown := False;
        FState := bsUp;
        Invalidate;
      end;
      FAllowAllUp := Sender.AllowAllUp;
    end;
  end;
end;

{-- TMMSpeedButton ------------------------------------------------------}
procedure TMMSpeedButton.CMDialogChar(var Message: TCMDialogChar);
begin
  with Message do
    if IsAccel(CharCode, Caption) and Enabled then
    begin
      Click;
      Result := 1;
    end
    else inherited;
end;

{-- TMMSpeedButton ------------------------------------------------------}
procedure TMMSpeedButton.CMFontChanged(var Message: TMessage);
begin
  Invalidate;
end;

{-- TMMSpeedButton ------------------------------------------------------}
procedure TMMSpeedButton.CMTextChanged(var Message: TMessage);
begin
  Invalidate;
end;

{-- TMMSpeedButton ------------------------------------------------------}
procedure TMMSpeedButton.CMSysColorChange(var Message: TMessage);
begin
  TButtonGlyph(FGlyph).Invalidate;
end;

end.