lbbuttons.pas

LBBottun for delphi7 按钮控件

unit LbButtons;

interface

uses Windows, Graphics, Classes;

type
  TLbColorStyle = (lcsCustom, lcsGold, lcsChrome, lcsBlue, lcsRed, lcsUltraFlat1, lcsUltraFlat2, lcsAqua);
  TLbButtonKind = (bkCustom, bkOK, bkCancel, bkHelp, bkYes, bkNo, bkClose, bkAbort, bkRetry, bkIgnore, bkAll);
  TLbButtonLayout = (blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom);
  TLbButtonStyle = (bsNormal, bsEncarta, bsModern);

//##############################################################################

procedure GetPreDefinedColors(ColorStyle: TLbColorStyle; var Color, LightColor, ShadowColor, ColorWhenDown, HotTrackColor: TColor; var Flat, Modern: boolean);
procedure LbPaintButton(Canvas: TCanvas; Width, Height, NumGlyphs: integer; Glyph: TBitmap; Down, CursorOnButton, Transparent, Enabled, Flat, PopupArrow: boolean; Style: TLbButtonStyle; Color, ColorWhenDown, HotTrackColor, LightColor, ShadowColor: TColor; Font: TFont; Layout: TLbButtonLayout; Caption: string; Alignment: TAlignment);

//##############################################################################

implementation

{$R LBBUTTONS.RES}

//##############################################################################

procedure GetPreDefinedColors(ColorStyle: TLbColorStyle; var Color, LightColor, ShadowColor, ColorWhenDown, HotTrackColor: TColor; var Flat, Modern: boolean);
begin
   case ColorStyle of
      lcsGold:       begin Color := $0000C0C0;  LightColor := clYellow;    ShadowColor := clOlive;    ColorWhenDown := clNone;     HotTrackColor := $0000DFDF;  Flat := False; Modern := true; end;
      lcsChrome:     begin Color := clSilver;   LightColor := clWhite;     ShadowColor := clGray;     ColorWhenDown := clNone;     HotTrackColor := clNone;     Flat := False; Modern := true; end;
      lcsBlue:       begin Color := $00FF8000;  LightColor := clAqua;      ShadowColor := clBlue;     ColorWhenDown := clNone;     HotTrackColor := clNone;     Flat := False; Modern := true; end;
      lcsRed:        begin Color := clRed;      LightColor := $00C0C0FF;   ShadowColor := $000000C0;  ColorWhenDown := clNone;     HotTrackColor := clNone;     Flat := False; Modern := true; end;
      lcsAqua:       begin Color := $00ECCE94;  LightColor := $00FCE6D4;   ShadowColor := clBlack;    ColorWhenDown := clNone;     HotTrackColor := clNone;     Flat := False; Modern := true; end;
      lcsUltraFlat1: begin Color := clBtnFace;  LightColor := $00B59284;   ShadowColor := $00B59284;  ColorWhenDown := $00B59284;  HotTrackColor := $00DED3D6;  Flat := True;  Modern := false; end;
      lcsUltraFlat2: begin Color := clBtnFace;  LightColor := clBlack;     ShadowColor := clBlack;    ColorWhenDown := $0024DABC;  HotTrackColor := $008CF6E4;  Flat := True;  Modern := false; end;
   end;
end;

//##############################################################################

procedure LbPaintButton(Canvas: TCanvas; Width, Height, NumGlyphs: integer; Glyph: TBitmap; Down, CursorOnButton, Transparent, Enabled, Flat, PopupArrow: boolean; Style: TLbButtonStyle; Color, ColorWhenDown, HotTrackColor, LightColor, ShadowColor: TColor; Font: TFont; Layout: TLbButtonLayout; Caption: string; Alignment: TAlignment);
var
   iCaptionHeight, iCaptionWidth, iGlyphHeight, iGlyphWidth: integer;
   iGlyphIndex: integer;
   iOffset: integer;
   sDrawCaption: string;
   clBackColor: TColor;
   iCapX, iCapY, iGlX, iGlY: integer;
   wR, wG, wB: word;
   aRect: TRect;
   FArrowGlyph: TPicture;

   procedure DrawColorFade(StartColor, StopColor: TColor; iLeft, iTop, iRight, iBottom: integer);
   var
      iCounter, iBuffer, iFillStep: integer;
      bR1, bG1, bB1, bR2, bG2, bB2: byte;
      aColor1, aColor2: LongInt;
      dCurrentR, dCurrentG, dCurrentB, dRStep, dGStep, dBStep: double;
      aOldStyle: TPenStyle;
      iHeight, iDrawBottom: integer;

   begin
      iHeight := (iBottom - iTop);
      aOldStyle := Canvas.Pen.Style; Canvas.Pen.Style := psClear;
      aColor1 := ColorToRGB(StartColor); bR1 := GetRValue(aColor1); bG1 := GetGValue(aColor1); bB1 := GetBValue(aColor1);
      aColor2 := ColorToRGB(StopColor);  bR2 := GetRValue(aColor2); bG2 := GetGValue(aColor2); bB2 := GetBValue(aColor2);
      dCurrentR := bR1; dCurrentG := bG1; dCurrentB := bB1;
      dRStep := (bR2-bR1) / 31; dGStep := (bG2-bG1) / 31; dBStep := (bB2-bB1) / 31;

      iFillStep := (iHeight div 31) + 1;
      for iCounter := 0 to 31 do
      begin
         iBuffer := iCounter * iHeight div 31;
         Canvas.Brush.Color := rgb(trunc(dCurrentR), trunc(dCurrentG), trunc(dCurrentB));
         dCurrentR := dCurrentR + dRStep; dCurrentG := dCurrentG + dGStep; dCurrentB := dCurrentB + dBStep;
         iDrawBottom := iTop + iBuffer + iFillStep; if iDrawBottom > iBottom then iDrawBottom := iBottom;
         Canvas.FillRect(Rect(iLeft, iTop + iBuffer, iRight, iDrawBottom));
      end;
      Canvas.Pen.Style := aOldStyle;
   end;

   procedure DrawGlyph(iDestLeft, iDestTop, iSrcLeft, iSrcTop, iWidth, iHeight: integer);  // transparent draw
   var
      aPicture: TPicture;

   begin
      aPicture := TPicture.Create;
      try aPicture.Bitmap.Assign(Glyph); except end;
      aPicture.Bitmap.Width := iWidth;
      aPicture.Bitmap.Height := iHeight;
      aPicture.Bitmap.Canvas.Draw(-iSrcLeft, -iSrcTop, Glyph);
      aPicture.Graphic.Transparent := true;
      Canvas.Draw(iDestLeft, iDestTop, aPicture.Graphic);
      aPicture.Free;
   end;

begin
   if not Enabled then Down := false;
   iOffset := 0; if Down then if Style in [bsNormal, bsModern] then iOffset := 1;

   // Background
   clBackColor := colortorgb(Color);
   if CursorOnButton then if HotTrackColor <> clNone then clBackColor := HotTrackColor;
   if Down then if ColorWhenDown <> clNone then clBackColor := ColorWhenDown;

   if not Transparent then
   begin
      Canvas.Brush.Color := clBackColor;
      if Style <> bsModern then Canvas.Rectangle(-1, -1, Width+1, Height+1)
      else
      begin
         DrawColorFade(LightColor, clBackColor, 2, 2, Width - 2, Height div 4 + iOffset);
         DrawColorFade(clBackColor, LightColor, 2, Height div 4 + iOffset, Width - 2, Height - 1);
      end;
   end;

   Canvas.Brush.Style := bsclear;

   // Border
   if Style <> bsModern then
   begin
      if {Enabled and} (not Flat or CursorOnButton or Down) then
      begin                   
         with Canvas do
         begin
            if Down then Pen.Color := ShadowColor else Pen.Color := LightColor;
            MoveTo(0, Height-1);
            LineTo(0, 0);
            LineTo(Width-1, 0);
            if Down then Pen.Color := LightColor else Pen.Color := ShadowColor;
            LineTo(Width-1, Height-1);
            LineTo(0, Height-1);
         end;
      end;
   end
   else
   begin
      with Canvas do
      begin
         Pen.Color := clBackColor; if Down then Pen.Color := ShadowColor;
         Rectangle(1, 1, Width-1, Height-1);
         Pen.Color := ShadowColor;
         RoundRect(0, 0, Width, Height, 6, 6);
      end;
   end;

   // Prepare layout
   Canvas.Font := Font;
   if Down then if Style = bsEncarta then Canvas.Font.Style := Canvas.Font.Style + [fsBold];

   if not Glyph.Empty then
   begin
      if Layout = blGlyphLeft then sDrawCaption := ' ' + Caption else sDrawCaption := Caption + ' ';
      if sDrawCaption = ' ' then sDrawCaption := '';
   end
   else sDrawCaption := Caption;

   iCaptionHeight := Canvas.TextHeight(sDrawCaption);
   iCaptionWidth := Canvas.TextWidth(sDrawCaption);
   iGlyphHeight := Glyph.Height;
   if NumGlyphs <> 0 then iGlyphWidth := Glyph.Width div NumGlyphs else iGlyphWidth := 0;
   iGlyphIndex := 0;
   if not Enabled then iGlyphIndex := iGlyphWidth
   else
   begin
      if CursorOnButton and (NumGlyphs > 3) then iGlyphIndex := 3 * iGlyphWidth;
      if Down and (NumGlyphs > 2) then iGlyphIndex := 2 * iGlyphWidth;
   end;

   // Text + Glyph
   iCapX := 0; iCapY := 0; iGlX := 0; iGlY := 0; // Just to get rid of these warnings...

   if Layout = blGlyphLeft then
   begin
      iCapY := (Height - iCaptionHeight) div 2 + iOffset; iGlY := (Height - iGlyphHeight) div 2 + iOffset;
      case Alignment of
         taLeftJustify:    begin iCapX := 4 + iGlyphWidth + iOffset; iGlX := 4 + iOffset; end;
         taRightJustify:   begin iCapX := Width - 4 - iCaptionWidth + iOffset; iGlX := Width - 4 - iCaptionWidth - iGlyphWidth + iOffset; end;
         taCenter:         begin iCapX := (Width - iCaptionWidth - iGlyphWidth) div 2 + iGlyphWidth + iOffset; iGlX := (Width - iCaptionWidth - iGlyphWidth) div 2 + iOffset; end;
      end;
   end
   else
   if Layout = blGlyphRight then
   begin
      iCapY := (Height - iCaptionHeight) div 2 + iOffset; iGlY := (Height - iGlyphHeight) div 2 + iOffset;
      case Alignment of
         taLeftJustify:    begin iCapX := 4 + iOffset; iGlX := 4 + iCaptionWidth + iOffset; end;
         taRightJustify:   begin iCapX := Width - 4 - iCaptionWidth - iGlyphWidth + iOffset; iGlX := Width - 4 - iGlyphWidth + iOffset; end;
         taCenter:         begin iCapX := (Width - iCaptionWidth - iGlyphWidth) div 2 + iOffset; iGlX := (Width - iCaptionWidth - iGlyphWidth) div 2 + iCaptionWidth + iOffset; end;
      end;
   end
   else
   if Layout = blGlyphTop then
   begin
      iCapY := (Height - iCaptionHeight - iGlyphHeight) div 2 + iGlyphHeight + iOffset; iGlY := (Height - iCaptionHeight - iGlyphHeight) div 2 + iOffset;
      case Alignment of
         taLeftJustify:    begin iCapX := 4 + iOffset; iGlX := 4 + iOffset; end;
         taRightJustify:   begin iCapX := Width - 4 - iCaptionWidth + iOffset; iGlX := Width - 4 - iGlyphWidth + iOffset; end;
         taCenter:         begin iCapX := (Width - iCaptionWidth) div 2 + iOffset; iGlX := (Width - iGlyphWidth) div 2 + iOffset; end;
      end;
   end
   else
   if Layout = blGlyphBottom then
   begin
      iCapY := (Height - iCaptionHeight - iGlyphHeight) div 2 + iOffset; iGlY := (Height - iCaptionHeight - iGlyphHeight) div 2 + iCaptionHeight + iOffset;
      case Alignment of
         taLeftJustify:    begin iCapX := 4 + iOffset; iGlX := 4 + iOffset; end;
         taRightJustify:   begin iCapX := Width - 4 - iCaptionWidth + iOffset; iGlX := Width - 4 - iGlyphWidth + iOffset; end;
         taCenter:         begin iCapX := (Width - iCaptionWidth) div 2 + iOffset; iGlX := (Width - iGlyphWidth) div 2 + iOffset; end;
      end;
   end;

   if not Enabled then Canvas.Font.Color := clGray;
   aRect := Rect(iCapX, iCapY, iCapX + iCaptionWidth, iCapY + iCaptionHeight);
   DrawText(Canvas.Handle, pChar(sDrawCaption), Length(sDrawCaption), aRect, DT_CENTER or DT_VCENTER);
   DrawGlyph(iGlX, iGlY, iGlyphIndex, 0, iGlyphWidth, iGlyphHeight);

   if PopupArrow then
   begin
      FArrowGlyph := TPicture.Create;
      FArrowGlyph.Bitmap.LoadFromResourceName(hInstance, 'LBARROW');
      FArrowGlyph.Graphic.Transparent := true;
      Canvas.Draw(Width - 11, Height div 2 - 1, FArrowGlyph.Graphic);
      FArrowGlyph.Free;
   end;
end;

end.