xpbitbtn.pas

非常好的xp界面控件

      ACanvas.Canvas.Font.Assign (FFont);

      ACanvas.Canvas.Brush.Style := bsClear;
      if Assigned (FImageList) then
      begin
        AImageWidth := FImageList.Width;
        AImageHeigth := FImageList.Height;

        FImageList.Draw (ACanvas.Canvas,
          (Width - ACanvas.Canvas.TextWidth (AText) - AImageWidth - 6) div 2 + Integer (FDowned),
          (Height - AImageHeigth) div 2 + Integer (FDowned),
          FImageIndex);
      end
      else
      begin
        AImageWidth := FGlyph.Width;
        AImageHeigth := FGlyph.Height;

        DrawBitmapTransparent (ACanvas.Canvas, (Width - ACanvas.Canvas.TextWidth (AText) - AImageWidth - 6) div 2 + Integer (FDowned),
          (Height - AImageHeigth) div 2 + Integer (FDowned), FGlyph, FGlyph.Canvas.Pixels [0, 0]);
      end;

      ACanvas.Canvas.Font.Color := clLtGray;
      ACanvas.Canvas.TextRect (Rect (4, 4, Width-4, Height-4),
        (Width - ACanvas.Canvas.TextWidth (AText) - AImageWidth) div 2 + AImageWidth + 3 + Integer (FDowned) + 1,
        (Height - ACanvas.Canvas.TextHeight (AText)) div 2 + Integer (FDowned) + 1, AText);
      ACanvas.Canvas.Font.Color := FFont.Color;
      ACanvas.Canvas.TextRect (Rect (4, 4, Width-4, Height-4),
        (Width - ACanvas.Canvas.TextWidth (AText) - AImageWidth) div 2 + AImageWidth + 3 + Integer (FDowned),
        (Height - ACanvas.Canvas.TextHeight (AText)) div 2 + Integer (FDowned), AText);

      if FFocused then
      begin
        ACanvas.Canvas.Brush.Style := bsSolid;
        ACanvas.Canvas.Pen.Color := clWhite;
        ACanvas.Canvas.Pen.Width := 2;
        ACanvas.Canvas.DrawFocusRect (Rect (4, 4, Width - 4, Height - 4));
      end;

    end
    else
    Begin // not Enabled
      ACanvas.Canvas.Brush.Color := RGB (241, 241, 237);
      ACanvas.Canvas.Pen.Color := RGB (214, 211, 211);
      ACanvas.Canvas.RoundRect (0, 0, Width, Height, 3, 3);
      ACanvas.Canvas.Pixels [0, 0] := clBtnFace;
      ACanvas.Canvas.Pixels [Width-1, 0] := clBtnFace;
      ACanvas.Canvas.Pixels [Width-1, Height-1] := clBtnFace;
      ACanvas.Canvas.Pixels [0, Height-1] := clBtnFace;

      ACanvas.Canvas.Brush.Style := bsClear;
      ACanvas.Canvas.Pen.Color := RGB (196, 195, 191);
      ACanvas.Canvas.RoundRect (1, 1, Width-1, Height-1, 5, 5);

      ACanvas.Canvas.Font := FFont;
      ACanvas.Canvas.Font.Color := RGB (161, 161, 146);

      if Assigned (FImageList) then
      begin
        AImageWidth := FImageList.Width;
        AImageHeigth := FImageList.Height;

        FImageList.GetBitmap (FImageIndex, FMonoGlyph);
        ConvertBitmapToGrayscale (FMonoGlyph);
      end
      else
      begin
        AImageWidth := FGlyph.Width;
        AImageHeigth := FGlyph.Height;
        FGlyph.Transparent := true;
      end;

      DrawBitmapTransparent (ACanvas.Canvas, (Width - ACanvas.Canvas.TextWidth (AText) - AImageWidth - 6) div 2 + Integer (FDowned),
        (Height - AImageHeigth) div 2 + Integer (FDowned), FMonoGlyph, FMonoGlyph.Canvas.Pixels [0, 0]);

      ACanvas.Canvas.TextRect (Rect (4, 4, Width-4, Height-4),
        (Width - ACanvas.Canvas.TextWidth (AText) - AImageWidth) div 2 + AImageWidth + 3 + Integer (FDowned),
        (Height - ACanvas.Canvas.TextHeight (AText)) div 2 + Integer (FDowned), AText);

    end;

    if Pos ('&', FCaption) <> 0 then
    begin
      ACanvas.Canvas.Pen.Color := ACanvas.Canvas.Font.Color;
      ACanvas.Canvas.Pen.Width := 1;
      ACanvas.Canvas.MoveTo (((Width - ACanvas.Canvas.TextWidth (AText)) div 2) + ACanvas.Canvas.TextWidth (Copy (AText, 1, Pos ('&', FCaption)-1)) + Integer (FDowned),
                     ((Height - ACanvas.Canvas.TextHeight (AText)) div 2) + ACanvas.Canvas.TextHeight (AText) + Integer (FDowned));
      ACanvas.Canvas.LineTo (((Width - ACanvas.Canvas.TextWidth (AText)) div 2) + ACanvas.Canvas.TextWidth (Copy (AText, 1, Pos ('&', FCaption))) + Integer (FDowned),
                     ((Height - ACanvas.Canvas.TextHeight (AText)) div 2) + ACanvas.Canvas.TextHeight (AText) + Integer (FDowned));
    end;

    BitBlt(Canvas.Handle, 0, 0, ACanvas.Width, ACanvas.Height,
      ACanvas.Canvas.Handle, 0, 0, SRCCOPY);

  finally
    ACanvas.Free;
  end;
end;

procedure TxpBitBtn.MouseEnter (var Message : TMessage);
begin
  if (FActive) or (not FEnabled) then Exit;
  FActive := true;
  Repaint;
end;

procedure TxpBitBtn.MouseLeave (var Message : TMessage);
begin
  if FActive and (FEnabled)  then
  begin
    FActive := False;
    Repaint;
  end;
end;


procedure TxpBitBtn.SetCaption (ACaption : TCaption);
begin
  if FCaption <> ACaption then
  Begin
    FCaption := ACaption;
    if (Pos ('&', FCaption) <> 0) and (Pos ('&', FCaption) < Length (FCaption)) then
      FHotKey := UpperCase (String (Copy (FCaption, Pos ('&', FCaption)+1, 1)))[1]
    else
      FHotKey := #0;
    Repaint;
  end;
end;

function  TxpBitBtn.GetCaption : TCaption;
begin
  Result := FCaption;
end;

procedure TxpBitBtn.SetGradient (Value : Boolean);
begin
  if Value = FGradient then Exit;
  FGradient := Value;
  Repaint; 
end;

function  TxpBitBtn.GetGradient : Boolean;
begin
  Result := FGradient;
end;

procedure TxpBitBtn.SetDowned (ADowned : Boolean);
begin
  if FDowned <> ADowned then
  Begin
    FDowned := ADowned;
    Repaint;
  end;
end;

function  TxpBitBtn.GetDowned : Boolean;
begin
  Result := FDowned;
end;


procedure TxpBitBtn.SetFont (AFont : TFont);
begin
  FFont.Assign (AFont);
  RePaint;
end;

function  TxpBitBtn.GetFont : TFont;
begin
  Result := FFont;
end;

procedure TxpBitBtn.OnFontChange (Sender : TObject);
begin
  Invalidate;
end;


procedure TxpBitBtn.SetGlyph (AGlyph : TBitmap);
begin
  FGlyph.Assign (AGlyph as TBitmap);
  FMonoGlyph.Assign (FGlyph as TBitmap);
  ConvertBitmapToGrayscale (FMonoGlyph);
  FMonoGlyph.Transparent := true;

  if FImageList <> nil then
  begin
    FImageList := nil;
    FImageIndex := -1;
  end;

  Invalidate;
end;

function  TxpBitBtn.GetGlyph : TBitmap;
begin
  Result := FGlyph as TBitmap;
end;

procedure TxpBitBtn.SetImageList (AList : TImageList);
begin
  if FImageList <> AList then
  begin
    FImageList := AList;

    FGlyph.ReleaseHandle;
    
    Invalidate;
  end;
end;

function  TxpBitBtn.GetImageList : TImageList;
begin
  Result := FImageList;
end;


procedure TxpBitBtn.SetImageIndex (AIndex : Integer);
begin
  if FImageIndex <> AIndex then
  begin
    FImageIndex := AIndex;
    Invalidate;
  end;
end;

function  TxpBitBtn.GetImageIndex : Integer;
begin
  Result := FImageIndex;
end;




procedure TxpBitBtn.LMouseDblClick  (var Message : TMessage);
begin
  FOnButtonClick;
end;

procedure TxpBitBtn.LMouseDown  (var Message : TMessage);
begin
  if (not FDowned) and (FEnabled) then
  begin
    FDowned := true;
    if (not Focused) and (Enabled) then SetFocus;
    Repaint;
  end;
end;

procedure TxpBitBtn.RMouseDown  (var Message : TMessage);
begin

end;

procedure TxpBitBtn.LMouseUp  (var Message : TMessage);
begin
  if (FDowned) and (FEnabled)then
  begin
    FDowned := False;
    Repaint;
    FOnButtonClick;
  end;
end;

procedure TxpBitBtn.RMouseUp  (var Message : TMessage);
begin

end;

procedure TxpBitBtn.CMEnter(var Message: TCMGotFocus);
begin
  inherited;
  if Assigned (FOnEnter) then FOnEnter (self);
end;

procedure TxpBitBtn.CMExit(var Message: TCMLostFocus);
begin
  inherited;
  if Assigned (FOnExit) then FOnExit (self);
end;

procedure TxpBitBtn.WMSetFocus(var Message: TMessage);
begin
  if not FFocused then
  begin
    FFocused := true;
    Invalidate;
  end;  
end;

procedure TxpBitBtn.WMKillFocus(var Message: TMessage);
begin
  if FFocused then
  begin
    FFocused := False;
    Invalidate;
  end;  
end;

procedure TxpBitBtn.WMKeyDown (var Message: TMessage);
begin
  if (not FDowned) and ((Message.WParam = VK_RETURN) or (Message.WParam = VK_SPACE)) then
  Begin
    FDowned := true;
    Invalidate;
  end;
  inherited;
end;

procedure TxpBitBtn.WMKeyUp (var Message: TMessage);
Begin
  if FDowned then
  begin
    FDowned := False;
    Invalidate;
    FOnButtonClick;
  end;
  inherited;
end;


procedure TxpBitBtn.SetModalResult (AModalResult : TModalResult);
begin
  FModalResult := AModalResult;
end;

function  TxpBitBtn.GetModalResult : TModalResult;
begin
  Result := FModalResult;
end;

procedure TxpBitBtn.FOnButtonClick;
begin
  if (FEnabled) and (Assigned (FOnClick)) then FOnClick (Self);
  if (FEnabled) and (FModalResult <> mrNone) and (Owner.InheritsFrom (TCustomForm)) then
    (Owner as TCustomForm).ModalResult := FModalResult;
end;

procedure TxpBitBtn.CMDialogChar(var Message : TCMDialogChar);
begin
  if IsAccel (Message.CharCode, FCaption) then
    FOnButtonClick;
end;


procedure TxpBitBtn.SetEnabled (AEnabled : Boolean);
begin
  if FEnabled <> AEnabled then
  begin
    FEnabled := AEnabled;
    Invalidate;
  end;
end;

procedure Register;
begin
  RegisterComponents('XP Controls', [TxpBitBtn]);
end;

end.