xpbutton.pas

XP_Buttons for delphi7 绝对精典的按钮控件

   with Message do
   begin
      if IsAccel(CharCode, Caption) and Visible and Enabled and (Parent <> nil) and Parent.Showing then
         begin
           FState := bsUp;
           SetFocus ;
           Invalidate;
           Click;
           Result := 1;
         end
      else
         inherited;
   end;
end;

procedure TXPButton.DoDialogKey(var Message: TCMDialogKey);
begin
   with Message do
       if FDefault and (CharCode = VK_RETURN) and Enabled then
          begin
            FState := bsUp;
            Invalidate;
            Click;
            Result := 1;
          end
       else
         if (CharCode = VK_ESCAPE) and FCancel and Visible and Enabled and
            (KeyDataToShiftState(Message.KeyData) = []) and CanFocus then
            begin
              FState := bsUp;
              Invalidate;
              Click;
              Result := 1;
            end
         else
            inherited;
end;

procedure TXPButton.SetCanFocus(Value: Boolean);
begin
  FCanFocus := Value ;
end;

procedure TXPButton.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    WM_KEYDOWN:
      if ((TWMKEYDOWN(Message).CharCode = VK_SPACE) or
         (TWMKEYDOWN(Message).CharCode = VK_RETURN)) and Enabled then
          begin
            if FState = bsUp then begin
               FState := bsDown;
               Invalidate;
               TWMKEYDOWN(Message).CharCode := VK_SPACE;
            end;
          end;
    WM_KEYUP:
      if ((TWMKEYUP(Message).CharCode = VK_SPACE) or
         (TWMKEYUP(Message).CharCode = VK_RETURN)) and Enabled then
         begin
           if FState = bsDown then begin
              FState := bsUp;
              Invalidate;
              Click;
           end;
         end;
  end;
  inherited WndProc(Message);
end;

procedure TXPButton.SetKind(Value: TButtonKind);
begin
  if Value <> FKind then begin
     if Value <> bkCustom then
        if Value in [bkCustom, bkOK, bkCancel, bkHelp, bkYes, bkNo, bkClose, bkAbort, bkRetry, bkIgnore, bkAll] then
           FNumGlyphs := 2
        else
           FNumGlyphs := 1 ;
     case Value of
          bkOK:           begin ModalResult := mrOK;      FGlyph.LoadFromResourceName(hInstance, 'XPBOK');      Caption := '确定';  end;
          bkCancel:       begin ModalResult := mrCancel;  FGlyph.LoadFromResourceName(hInstance, 'XPBCANCEL');  Caption := '取消';  end;
          bkHelp:         begin ModalResult := mrNone;    FGlyph.LoadFromResourceName(hInstance, 'XPBHELP');    Caption := '帮助';  end;
          bkYes:          begin ModalResult := mrYes;     FGlyph.LoadFromResourceName(hInstance, 'XPBYES');     Caption := '是';    end;
          bkNo:           begin ModalResult := mrNo;      FGlyph.LoadFromResourceName(hInstance, 'XPBNO');      Caption := '否';    end;
          bkClose:        begin ModalResult := mrNone;    FGlyph.LoadFromResourceName(hInstance, 'XPBCLOSE');   Caption := '关闭';  end;
          bkAbort:        begin ModalResult := mrAbort;   FGlyph.LoadFromResourceName(hInstance, 'XPBABORT');   Caption := '放弃';  end;
          bkRetry:        begin ModalResult := mrRetry;   FGlyph.LoadFromResourceName(hInstance, 'XPBRETRY');   Caption := '重试';  end;
          bkIgnore:       begin ModalResult := mrIgnore;  FGlyph.LoadFromResourceName(hInstance, 'XPBIGNORE');  Caption := '忽略';  end;
          bkAll:          begin ModalResult := mrAll;     FGlyph.LoadFromResourceName(hInstance, 'XPBALL');     Caption := '全部';  end;

          bkOpen:         begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPOpen');        Caption := '打开';  end;
          bkNew:          begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPNew');         Caption := '新建';  end;
          bkCopy:         begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPCopy');        Caption := '复制';  end;
          bkCut:          begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPCut');         Caption := '剪切';  end;
          bkEdit:         begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPEdit');        Caption := '修改';  end;
          bkDelete:       begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPDelete');      Caption := '删除';  end;
          bkPaste:        begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPPaste');       Caption := '粘贴';  end;
          bkFind:         begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPFind');        Caption := '查找';  end;
          bkUndo:         begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPUndo');        Caption := '撤消';  end;
          bkRedo:         begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPRedo');        Caption := '重做';  end;
          bkSave:         begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPSave');        Caption := '保存';  end;
          bkCheck:        begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPCheck');       Caption := '检查';  end;
          bkPrinter:      begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPPrinter');     Caption := '打印';  end;
          bkExit:         begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPExit');        Caption := '退出';  end;
          bkHelps:        begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPHelp');        Caption := '帮助';  end;
          bkAbout:        begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPAbout');       Caption := '关于';    end;
          bkCalculate:    begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPCalculate');   Caption := '计算';    end;
          bkSearch:       begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPSearch');      Caption := '查找';    end;
          bkInformation:  begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPInformation'); Caption := '信息';    end;
          bkPassWord:     begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPPassWord');    Caption := '口令';    end;
          bkStart:        begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPStart');       Caption := '第一条';  end;
          bkPrevious:     begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPPrevious');    Caption := '前一条';  end;
          bkNext:         begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPNext');        Caption := '后一条';  end;
          bkEnd:          begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPEnd');         Caption := '末一条';  end;
          bkQuestion:     begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPQuestion');    Caption := '问题';    end;
          bkSaveTo:       begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPSaveTo');      Caption := '另存为';  end;
          bkChart:        begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPChart');       Caption := '图表';    end;
          bkDesign:       begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPDesign');      Caption := '设计';    end;
          bkPreview:      begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPPreview');     Caption := '预览';    end;
          bkRefresh:      begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPRefresh');     Caption := '刷新';    end;
          bkPropertiy:    begin ModalResult := mrNone;  FGlyph.LoadFromResourceName(hInstance, 'XPpropertiy');   Caption := '属性';    end;
     end ;
     FKind := Value;
     Invalidate;
  end;
end;

procedure TXPButton.Paint;
var
  FTransColor: TColor;
  FImageList: TImageList;
  SourceRect, DestRect: TRect;
  tempGlyph: TBitmap;
  Offset: TPoint;
begin
  // get the transparent color

  FTransColor := FGlyph.Canvas.Pixels[0, FGlyph.Height - 1];
  Canvas.Font := Self.Font;

  if FState = bsDown then
    Offset := Point(1, 1)
  else
    Offset := Point(0, 0);

  CalcButtonLayout(Canvas, ClientRect, Offset, FLayout, FSpacing,
    FMargin, FGlyph, FNumGlyphs, Caption, TextBounds, GlyphPos);

  if not Enabled then
     begin
       FState := bsDisabled;
       FDragging := False;
     end
  else
    if FState = bsDisabled then FState := bsUp;

  // DrawBackground
  PaintButton(Canvas, ClientRect);

  // DrawGlyph
  if not FGlyph.Empty then  begin
     tempGlyph := TBitmap.Create;
     case FNumGlyphs of
       1: case FState of
           bsUp:        sourceRect := Rect(0, 0, FGlyph.Width, FGlyph.Height);
           bsDisabled:  sourceRect := Rect(0, 0, FGlyph.Width, FGlyph.Height);
           bsDown:      sourceRect := Rect(0, 0, FGlyph.Width, FGlyph.Height);
         end;
       2: case FState of
           bsUp:        sourceRect := Rect(0, 0, FGlyph.Width div FNumGlyphs, FGlyph.Height);
           bsDisabled:  sourceRect := Rect(FGlyph.Width div FNumGlyphs, 0, FGlyph.Width, FGlyph.Height);
           bsDown:      sourceRect := Rect(0, 0, FGlyph.Width div FNumGlyphs, FGlyph.Height);
         end;
       3: case FState of
           bsUp:        SourceRect := Rect(0, 0, FGlyph.Width div FNumGlyphs, FGlyph.Height);
           bsDisabled:  SourceRect := Rect(FGlyph.width div FNumGlyphs, 0, (FGlyph.Width div FNumGlyphs) * 2, FGlyph.Height);
           bsDown:      SourceRect := Rect((FGlyph.Width div FNumGlyphs) * 2, 0, FGlyph.Width, FGlyph.Height);
         end;
       4: case FState of
           bsUp:        SourceRect := Rect(0, 0, FGlyph.Width div FNumGlyphs, FGlyph.Height);
           bsDisabled:  SourceRect := Rect(FGlyph.width div FNumGlyphs, 0, (FGlyph.Width div FNumGlyphs) * 2, FGlyph.Height);
           bsDown:      SourceRect := Rect((FGlyph.Width div FNumGlyphs) * 2, 0, (FGlyph.Width div FNumGlyphs) * 3, FGlyph.Height);
         end;
     end;

     DestRect := Rect(0, 0, FGlyph.Width div FNumGlyphs, FGlyph.Height);
     tempGlyph.Width := FGlyph.Width div FNumGlyphs;
     tempGlyph.Height := FGlyph.Height;
     tempGlyph.Canvas.CopyRect(DestRect, FGlyph.canvas, SourceRect);

     if (FNumGlyphs = 1) and (FState = bsDisabled) then begin
       tempGlyph := CreateDisabledBitmap(tempGlyph, clBlack, clBtnFace, clBtnHighlight, clBtnShadow, True);
       FTransColor := tempGlyph.Canvas.Pixels[0, tempGlyph.Height - 1];
     end;

     FImageList := TImageList.CreateSize(FGlyph.Width div FNumGlyphs, FGlyph.Height);
     try
       FImageList.AddMasked(tempGlyph, FTransColor);
       FImageList.Draw(canvas, glyphpos.x, glyphpos.y, 0);
     finally
       FImageList.Free;
     end;
     tempGlyph.Free;
  end;

  // DrawText
  Canvas.Brush.Style := bsClear;
  if FState = bsDisabled then
  begin
    OffsetRect(TextBounds, 1, 1);
    Canvas.Font.Color := clBtnHighlight;
    DrawText(Canvas.Handle, PChar(Caption), Length(Caption), TextBounds, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
    OffsetRect(TextBounds, -1, -1);
    Canvas.Font.Color := clBtnShadow;
    DrawText(Canvas.Handle, PChar(Caption), Length(Caption), TextBounds, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
  end
  else
    DrawText(Canvas.Handle, PChar(Caption), Length(Caption), TextBounds, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
  if Focused and Enabled and FCanFocus then DrawFocus(Canvas, ClientRect);
end;

procedure TXPButton.DrawFocus(Canvas: TCanvas; ARect: TRect);
var
  BrushColor: TColor;
begin
  if FButtonStyle in [bsStandard, bsGradient] then begin
     BrushColor := Canvas.Brush.Color ;
     Canvas.Brush.Color := clWhite ;
     Canvas.DrawFocusRect(Rect(ClientRect.Left + 3,
                               ClientRect.Top + 3,
                               ClientRect.Right - 3,
                               ClientRect.Bottom - 3));
     Canvas.Brush.Color := BrushColor ;
  end;
  if FButtonStyle in [bsXPBlue, bsXPArgent, bsXPGreen] then begin
     with XPButtonColor do begin
       if not FMouseInControl then
          DrawXPStyleBorder(Canvas, ClientRect, FTBorderColor1, FTBorderColor2, clNone, FBBorderColor1, FBBorderColor2);
     end;
     BrushColor := Canvas.Brush.Color ;
     Canvas.Brush.Color := clWhite ;
     Canvas.DrawFocusRect(Rect(ClientRect.Left + 3,
                               ClientRect.Top + 3,
                               ClientRect.Right - 3,
                               ClientRect.Bottom - 3));
     Canvas.Brush.Color := BrushColor ;
  end;
end;

procedure TXPButton.PaintButton(Canvas: TCanvas; ARect: TRect) ;
var
  FBrushColor : TColor ;
  mRGN : LongInt ;
begin
  if ButtonStyle = bsStandard then begin
     FBrushColor := Canvas.Brush.Color ;
     Canvas.Brush.Color := Color ;
     Canvas.FillRect(ARect) ;
     Canvas.Brush.Color := FBrushColor ;
     case FState of
       bsUp:
         if FMouseInControl then
            Frame3DBorder(Canvas, ARect, clBtnHighlight, clBtnShadow, 1)
         else
            if FBorderDraw then
               Frame3DBorder(Canvas, ARect, FBorderColor, FBorderColor, 1);
       bsDown:
         Frame3DBorder(Canvas, ARect, clBtnShadow, clBtnHighlight, 1);
       bsDisabled:
         Frame3DBorder(Canvas, ARect, FBorderColor, FBorderColor, 1);
     end;
  end;
  if FButtonStyle = bsGradient then begin
     case FState of
       bsUp: if FMouseInControl then
                begin
                  DrawGradientColor(Canvas,ARect,FGradientBeginColor,
                                    RGB(GetRValue(FGradientEndColor) + 20,
                                    GetGValue(FGradientEndColor) + 20,
                                    GetBValue(FGradientEndColor) + 20));
                  Frame3DBorder(Canvas, ARect, clBtnHighlight, clBtnShadow, 1);
                end
              else begin
                 DrawGradientColor(Canvas,ARect,FGradientBeginColor,
                                   FGradientEndColor);
                 if FBorderDraw then
                   Frame3DBorder(Canvas, ARect, FBorderColor, FBorderColor, 1);
              end;
        bsDown: begin
                  DrawGradientColor(Canvas,ARect,FGradientEndColor,
                                    FGradientBeginColor);
                  Frame3DBorder(Canvas, ARect, clBtnShadow, clBtnHighlight, 1);
                end;
        bsDisabled: begin
                      DrawGradientColor(Canvas,ARect,FGradientBeginColor,
                                        FGradientEndColor);
                      Frame3DBorder(Canvas, ARect, FBorderColor, FBorderColor, 1);
                    end;
     end
  end;
  if FButtonStyle in [bsXPBlue, bsXPArgent, bsXPGreen] then begin
     mRGN := CreateRoundRectRgn(ARect.Left, ARect.Top, ARect.Right + 1, ARect.Bottom + 1, 4, 4) ;
     SetWindowRgn(Self.Handle, mRGN, True);
     DeleteObject(mRGN);
     SetXPStyleColors(FButtonStyle);
     case FState of
       bsUp: begin
               DrawXpStyle(Canvas, ARect, FState) ;
               with XPButtonColor do begin
                 if FMouseInControl then
                    DrawXPStyleBorder(Canvas, ARect, STBorderColor1, STBorderColor2, clNone, SBBorderColor1, SBBorderColor2);
               end;
             end;
        bsDown: DrawXpStyle(Canvas, ARect, FState);
        bsDisabled: DrawXpStyle(Canvas, ARect, FState);
     end
  end;
end;

end.