transbtn.pas

透明按钮 透明按钮 透明按钮

       else
       begin
         TmpRect := Rect(1,1,Width,Height);
         Frame3D(Canvas,TmpRect,clBlack,clBlack,BorderWidth);
       end;
     end;

     fsIndent:
     begin
      { draw outline }
       Pen.Color := clBtnShadow;
       if not Transparent then
         Rectangle(0,0,Width-1,Height-1)
       else
       begin
         TmpRect := Rect(0,0,Width-1,Height-1);
         Frame3D(Canvas,TmpRect,clBtnShadow,clBtnShadow,BorderWidth)
       end;
       TmpRect := Rect(1,1,Width,Height);
       Frame3D(Canvas,TmpRect,clBtnHighLight,clBtnHighLight,BorderWidth);
     end;
     fsLight:
     begin
       if not Transparent then
         FillRect(Rect(0,0,width,height));
       if (csDesigning in ComponentState) then
         Frame3D(Canvas,TmpRect,clBtnHighLight,clBtnShadow,1);
     end;

     fsDark:
     begin
       if not Transparent then
         FillRect(Rect(0,0,width,height));
       if (csDesigning in ComponentState) then
         Frame3D(Canvas,TmpRect,clBtnFace,cl3DDkShadow,1);
     end;

     fsMono:
     begin
       if not Transparent then
         FillRect(Rect(0,0,width,height));
       if (csDesigning in ComponentState) then
         Frame3D(Canvas,TmpRect,clBtnHighLight,cl3DDkShadow,1);
     end;

     end; { case }

     TmpRect := Rect(1,1,Width-1,Height-1);

     if (FState = bsDown) then
     begin
      if not (FrameStyle=fsNone) then
      begin
        InflateRect(TmpRect,1,1);
        case FrameStyle of
        fsRegular:
        if ShowPressed then
        begin
          Frame3D(Canvas,TmpRect,clBlack,clBtnHighLight,BorderWidth);
          Frame3D(Canvas,TmpRect,clBtnShadow,clBtnFace,BorderWidth);
        end;

        fsExplorer:
        if FInsideButton or FStayDown then
        begin
          if ShowPressed then
            Frame3D(Canvas,TmpRect,clBtnShadow,clBtnHighLight,BorderWidth)
          else
            Frame3D(Canvas,TmpRect,clBtnHighLight,clBtnShadow,BorderWidth);
        end;

        fsIndent:
        if ShowPressed then
        begin
          Frame3D(Canvas,TmpRect,clBlack,clBtnHighLight,BorderWidth);
          Frame3D(Canvas,TmpRect,clBtnShadow,clBtnFace,BorderWidth);
        end;

       fsLight:
         if ShowPressed then
           Frame3D(Canvas,TmpRect,clBtnShadow,clBtnHighLight,1);

       fsDark:
         if ShowPressed then
           Frame3D(Canvas,TmpRect,cl3DDkShadow,clBtnFace,1);

       fsMono:
         if ShowPressed then
           Frame3D(Canvas,TmpRect,cl3DDkShadow,clBtnHighLight,1);

        end; { case }
      end;
    end;

     if (FState = bsUp) then
     begin
       InflateRect(TmpRect,1,1);

       case FrameStyle of
       fsRegular:
       begin
         Frame3D(Canvas,TmpRect,clBtnHighLight,clBlack,BorderWidth);
         Frame3D(Canvas,TmpRect,clBtnFace,clBtnShadow,BorderWidth);
       end;

       fsExplorer:
       if FInsideButton then
         Frame3D(Canvas,TmpRect,clBtnHighLight,clBtnShadow,BorderWidth);

       fsIndent:
         Frame3D(Canvas,TmpRect,clBtnShadow,clBtnHighLight,BorderWidth);
       fsLight: Frame3D(Canvas,TmpRect,clBtnHighLight,clBtnShadow,1);
       fsDark:  Frame3D(Canvas,TmpRect,clBtnFace,cl3DDkShadow,1);
       fsMono:  Frame3D(Canvas,TmpRect,clBtnHighLight,cl3DDkShadow,1);

       end; { case }
    end;
   end; { with Canvas do }

   { repaint rest }
   PaintButton;
end;

procedure TTransparentButton.PaintButton;
var Dest:TRect;TmpWidth:integer;
begin
   with Canvas do
   begin
    { find glyph bounding rect - adjust according to textalignment}
    TmpWidth := FGlyph.Width div NumGlyphs;

    if TmpWidth <= 0 then TmpWidth := FGlyph.Width;

    { do top }
    if TextAlign in [ttaBottomLeft,ttaBottom,ttaBottomRight] then
        Dest.Top := Spacing
    else if TextAlign in [ttaTopLeft,ttaTop,ttaTopRight] then
      Dest.Top := Height - FGlyph.Height - Spacing
    else
      Dest.Top :=  (Height - FGlyph.Height) div 2;

    { do left }
    if TextAlign = ttaLeft then
      Dest.Left := Width - TmpWidth- Spacing
    else if TextAlign = ttaRight then
      Dest.Left := Spacing
    else { left, center, right }
      Dest.Left := (Width - TmpWidth) div 2;

{
    if Dest.Top < Spacing then Dest.Top := Spacing;
    if Dest.Left < Spacing then Dest.Left := Spacing;
}
    
    Dest.Bottom:= Dest.Top + FGlyph.Height;
    Dest.Right := Dest.Left + TmpWidth;
    
{
    if Dest.Bottom > Height - Spacing then
       Dest.Top := Height - FGlyph.Height - Spacing;
}

    if not FGlyph.Empty then
    begin
      DrawTheBitmap(Dest);
      FGlyph.Dormant;
    end;
   { finally, do the caption }
    if Length(FCaption) > 0 then
      DrawTheText(Dest);
 end;
end;

{ aRect contains the bitmap bounds }
procedure TTransparentButton.DrawTheText(aRect: TRect);
var Flags,MidX,MidY: Integer;DC:THandle; { Col:TColor; }
    tmprect:TRect;
begin

  Canvas.Font := Self.Font;
  DC := Canvas.Handle; { reduce calls to GetHandle }

  if FWordWrap then
    Flags := DT_WORDBREAK
  else
    Flags := DT_SINGLELINE;

  tmpRect := Rect(0,0,Width,Height);

  { calculate width and height of text: }
  DrawText(DC, PChar(FCaption), Length(FCaption), tmpRect, Flags or DT_CALCRECT);
  MidY := tmpRect.Bottom - tmpRect.Top;
  MidX := tmpRect.Right-tmpRect.Left;
  Flags := DT_CENTER;
  { div 2 and shr 1 generates the exact same Asm code... }
  case TextAlign of
      ttaTop:
        OffsetRect(tmpRect,Width div 2-MidX div 2,aRect.Top - MidY - Spacing);
      ttaTopLeft:
        OffsetRect(tmpRect,Spacing,aRect.Top - MidY - Spacing);
      ttaTopRight:
        OffsetRect(tmpRect,Width - tmpRect.right - Spacing,aRect.Top - MidY - Spacing);
      ttaBottom:
        OffsetRect(tmpRect,Width div 2-MidX div 2,aRect.Bottom + Spacing);
      ttaBottomLeft:
        OffsetRect(tmpRect,Spacing,aRect.Bottom + Spacing);
      ttaBottomRight:
        OffsetRect(tmpRect,Width - MidX - Spacing,aRect.Bottom + Spacing);
      ttaCenter:
        OffsetRect(tmpRect,Width div 2 - MidX div 2,Height div 2 - MidY div 2);
      ttaRight:
        OffsetRect(tmpRect,Width  - MidX - Spacing,Height div 2 - MidY div 2);
      ttaLeft:
        OffsetRect(tmpRect,Spacing,Height div 2 - MidY div 2);
  end; { case }
  if FWordWrap then
    Flags := Flags or DT_WORDBREAK or DT_NOCLIP
  else
    Flags := Flags or DT_SINGLELINE or DT_NOCLIP;

  if ((FState = bsDown) and FShowPressed) then
      OffsetRect(tmpRect,1,1);

  SetBkMode(DC,Windows.TRANSPARENT);

  if not Enabled then
  begin
  { draw disabled text }
  {    Col := GetSysColor(COLOR_GRAYTEXT);
      SetTextColor(DC,Col);}
    SetTextColor(DC,ColorToRGB(clBtnHighLight));
    OffsetRect(tmpRect,1,1);
    DrawText(DC, PChar(FCaption), Length(FCaption), tmpRect, Flags);
    OffsetRect(tmpRect,-1,-1);
    SetTextColor(DC,ColorToRGB(clBtnShadow));
  end
  else
    SetTextColor(DC,self.Font.Color);

  DrawText(DC, PChar(FCaption), Length(FCaption), tmpRect, Flags);
end;

procedure TTransparentButton.DrawTheBitmap(aRect:TRect);
var index:integer;
{  HelpRect:TRect; }
begin
   with ImList do
   begin
     Index := 0;

     case FNumGlyphs of   {normal,disabled,down,down }
     2: if not Enabled then Index := 1;
     3: if not Enabled then
          Index := 1
        else if (FState = bsDown) then
          Index := 2;
     4: if not Enabled then
          Index := 1
        else if (FState = bsDown) then
          Index := 2;
        else
          Index := 0;
     end; { case }

     if FGlyph.Empty then Exit;

     if ((FState = bsDown) and FShowPressed) then
       OffsetRect(aRect,1,1);
     { do we need the grayed bitmap ? }
     if (FrameStyle = fsExplorer) and FAutoGray and not FInsideButton then
       Index := Count-2;

     { do we need the disabled bitmap ? }
     if not Enabled and (FNumGlyphs = 1) then Index := Count-1;

     { Norris }
     if {FIsDown and }FStayDown and (FState = bsDown) then
     begin
{       HelpRect := ClientRect;
       InflateRect(HelpRect, -2, -2);
       Canvas.Brush.Bitmap := FPattern;
       Self.Canvas.FillRect(HelpRect);
}     end;

     if Transparent then
       ImageList_DrawEx(Handle, Index, Canvas.Handle, aRect.Left,aRect.Top,0, 0,
         clNone, clNone, ILD_Transparent)
     else
       ImageList_DrawEx(Handle, Index, Canvas.Handle, aRect.Left,aRect.Top,0, 0,
         ColorToRGB(clBtnFace), CLR_DEFAULT, ILD_Normal);
   end; { with ImList do }
end;


procedure TTransparentButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var tmp:TPoint;Msg:TMsg;
begin
  if not Enabled then Exit;

  if FIsDown then Exit
  else FIsDown := not FIsDown;

  inherited MouseDown(Button,Shift,X,Y);

   If FMovable then begin
     posX:= X;  {we get the mouse position}
     posY:= Y;
     {we start moving the button, if Movable, with MouseMove}
   end;

   if Assigned(OnMouseDown) then OnMouseDown(Self,Button,Shift,X,Y);

   if InsideBtn(X,Y) then
   begin
     FMouseDown := True;
     FState := bsDown;
     Repaint; 
   end;



   if Assigned(FPopUpMenu) then
   begin
     { calc where to put menu }
			tmp := ClientToScreen(Point(0, Height));
			FPopUpMenu.Popup(tmp.X, tmp.Y);
     { wait 'til menu is done }
			while PeekMessage(Msg, 0, WM_MOUSEFIRST, WM_MOUSELAST, PM_REMOVE) do
				;
     { release button }
     MouseUp(Button,Shift,X,Y);
   end;
end;


procedure TTransparentButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin

  if not Enabled then Exit;
  if not FIsDown then Exit
  else FIsDown := not FIsDown;
  if FStayDown then Exit;
  inherited MouseUp(Button,Shift,X,Y);

  FMouseDown := False;
  FState := bsUp;
  Repaint;
  if Assigned(OnMouseUp) then OnMouseUp(Self,Button,Shift,X,Y);
end;


procedure TTransparentButton.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
   inherited MouseMove(Shift,X,Y);
   if Assigned(OnMouseMove) then OnMouseMove(Self,Shift,X,Y);
   if FMouseDown then
   begin
     if Movable then begin Top:=Top+Y-PosY; Left:=Left+X-PosX end; {moving the button}
     if not InsideBtn(X,Y) then
     begin
       if FState = bsDown then { mouse has slid off, so release }
       begin
         FState := bsUp;
         Repaint;
       end;
     end
     else
     begin
       if FState = bsUp then { mouse has slid back on, so push }
       begin
         FState := bsDown;
         Repaint; 
       end;
     end;
   end;
end;


procedure TTransparentButton.GlyphChanged(Sender:TObject);
var GlyphNum:integer;
begin
  Invalidate;
  GlyphNum := 1;
  if (Glyph <> nil) and (Glyph.Height > 0) then
  begin
    if Glyph.Width mod Glyph.Height = 0 then
    begin
      GlyphNum := Glyph.Width div Glyph.Height;
      if GlyphNum > 4 then GlyphNum := 1;
      SetNumGlyphs(GlyphNum);
    end;
  AddGlyphs(Glyph,Glyph.TransparentColor {Glyph.Canvas.Pixels[0,0]},GlyphNum);
  end;
end;

{ Handle speedkeys (Alt + key) }
procedure TTransparentButton.CMDialogChar(var Message: TCMDialogChar);
begin
  with Message do
    if IsAccel(CharCode, FCaption) and Enabled then
    begin
      Click;
      Result := 1;
    end else
      inherited;
end;

procedure TTransparentButton.CMEnabledChanged(var Message: TMessage);
begin
 if not(Enabled) then
 begin
  	FState := bsUp;
  	FMousedown := False;
 	FIsDown := False;
 	FInsideButton := False;
 end;
 Repaint; 
end;

procedure TTransparentButton.CMMouseEnter(var msg: TMessage);
begin
  if Enabled then
  begin
    FInsideButton := True;
    if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
    if (FrameStyle = fsExplorer) then Repaint; 
  end;
end;

procedure TTransparentButton.CMMouseLeave(var msg: TMessage);
begin
  if Enabled then
  begin
    if FInsideButton then FInsideButton := False;
    if Assigned(FOnMouseExit) then FOnMouseExit(Self);
    if (FrameStyle = fsExplorer) then Repaint; 
  end;

end;

procedure TTransparentButton.Click;
begin
  inherited Click;
end;
procedure TTransparentButton.Notification(AComponent: TComponent; Operation:TOperation);
begin
	if (Operation = opRemove) and (AComponent = FPopUpMenu) then
		FPopUpMenu := nil ;
end;


procedure Register;
begin
  RegisterComponents('MyButton',[TTransparentButton]);
end;
end.