delphi中为自定控件绘制windows按钮

关注

原创最新推荐文章于 2026-07-17 16:41:12 发布 1.5k 阅读 AI 写同款· GEO 优化 ›

若要自定工具拦，但也要保留windows样式的按钮时

下面给出一种实现

procedure TmyButton.defaultdraw;
var arect,R:Trect;
    wpos,hpos:integer;
    Details: TThemedElementDetails;
begin
hpos:=0;
arect:=self.ClientRect;
canvas.Font:=font;
canvas.Brush.Color:=$CCFFFF;
if assigned(fimagelist) then
begin
    if (fimagelist.Count>0) or (fimage>=0) then
    begin
      wpos:=(width-imagelist.Width) div 2;
      if fhot and ( not (csDesigning in ComponentState) ) then
      begin
        R:=rect(wpos-8,0,wpos+fimagelist.width+8,fimagelist.Height+16);
        if ThemeServices.ThemesEnabled then
        begin
          if fdown then
          begin
            Details := ThemeServices.GetElementDetails(themes.ttbButtonPressed);
          end
          else
            Details := ThemeServices.GetElementDetails(themes.ttbButtonHot);
          ThemeServices.DrawElement(Canvas.Handle, Details, R, nil);
        end
        else
        begin
          if fdown then
          begin
            canvas.FillRect(r);
            DrawEdge(Canvas.Handle, R, BDR_SUNKENOUTER, BF_RECT);
          end
          else
            DrawEdge(Canvas.Handle, R, BDR_RAISEDINNER, BF_RECT);
        end;
      end;
      fimagelist.Draw(canvas,wpos,8,fimage);
      hpos:=hpos+fimagelist.Height+20;
    end;
    canvas.Brush.Style:=bsclear;
    wpos:=(width-canvas.textwidth(fcaption)) div 2;
    canvas.TextOut(wpos,hpos,fcaption);
    exit;
end;
wpos:=(width-canvas.textwidth(fcaption)) div 2;
hpos:=4;
canvas.TextOut(wpos,hpos,fcaption);
if fhot and ( not (csDesigning in ComponentState) ) then
begin
    if fdown then
      DrawEdge(canvas.Handle,arect,EDGE_ETCHED,BF_FLAT or BF_RECT)
    else
      DrawEdge(canvas.Handle,arect,EDGE_RAISED,BF_FLAT or BF_RECT);
end;
end;