转至繁体中文版     | 网站首页 | 图文教程 | 资源下载 | 站长博客 | 图片素材 | 武汉seo | 武汉网站优化 | 
最新公告:     敏韬网|教学资源学习资料永久免费分享站!  [mintao  2008年9月2日]        
您现在的位置: 学习笔记 >> 图文教程 >> 软件开发 >> Delphi程序 >> 正文
平滑SpeedButton         ★★★★

平滑SpeedButton

作者:闵涛 文章来源:闵涛的学习笔记 点击数:2576 更新时间:2009/4/23 18:42:48
sp; FState := bsUp;

    // DrawBorder
    case FState of
      bsUp:
        if FMouseInControl then
          Frame3D(memoryBitmap.canvas, buttonRect, FColorHighlight, FColorShadow, 1)
        else
          Frame3D(memoryBitmap.canvas, buttonRect, FBorderColor, FBorderColor, 1);
      bsDown, bsExclusive:
        Frame3D(memoryBitmap.canvas, buttonRect, FColorShadow, FColorHighlight, 1);
      bsDisabled:
        Frame3D(memoryBitmap.canvas, buttonRect, FBorderColor, FBorderColor, 1);
    end;

    // DrawBackground
    case FState of
      bsUp:
        if FMouseInControl then
          memoryBitmap.Canvas.Brush.Color := FFocusedColor
        else
          memoryBitmap.Canvas.Brush.Color := Self.Color;
      bsDown:
        memoryBitmap.Canvas.Brush.Color := FDownColor;
      bsExclusive:
        if FMouseInControl then
          memoryBitmap.Canvas.Brush.Color := FFocusedColor
        else
          memoryBitmap.Canvas.Brush.Color := FDownColor;
      bsDisabled:
        memoryBitmap.Canvas.Brush.Color := Self.Color;
    end;
    memoryBitmap.Canvas.FillRect(buttonRect);

    // 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);
             bsExclusive: 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);
             bsExclusive: 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);
             bsExclusive: 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);
             bsExclusive: SourceRect := Rect((FGlyph.width div FNumGlyphs) * 3, 0, FGlyph.Width, 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(memoryBitmap.canvas, glyphpos.x, glyphpos.y, 0);
      finally
        FImageList.Free;
      end;
      tempGlyph.free;
    end;

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

    // Copy memoryBitmap to screen
    canvas.CopyRect(ClientRect, memoryBitmap.canvas, ClientRect);
  finally
    memoryBitmap.free; // delete the bitmap
  end;
end;

procedure TFlatSpeedButton.UpdateTracking;
var
  P: TPoint;
begin
  if Enabled then
  begin
    GetCursorPos(P);
    FMouseInControl := not (FindDragTarget(P, True) = Self);
    if FMouseInControl then
      MouseLeave
    else
      MouseEnter;
  end;
end;

procedure TFlatSpeedButton.Loaded;
begin
  inherited Loaded;
  Invalidate;
end;

procedure TFlatSpeedButton.MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if (Button = mbLeft) and Enabled then
  begin
    if not FDown then
    begin
      FState := bsDown;
      Invalidate;
    end;
    FDragging := True;
  end;
end;

procedure TFlatSpeedButton.MouseMove (Shift: TShiftState; X, Y: Integer);
var
  NewState: TButtonState;
  P: TPoint;
begin
  inherited;

  // mouse is in control ?
  P := ClientToScreen(Point(X, Y));
  if (MouseInControl <> Self) and (FindDragTarget(P, True) = Self) then
  begin
    if Assigned(MouseInControl) then
      MouseInControl.MouseLeave;
    // the application is active ?
    if (GetActi

上一页  [1] [2] [3] [4]  下一页


没有相关教程
教程录入:mintao    责任编辑:mintao 
  • 上一篇教程:

  • 下一篇教程:
  • 【字体: 】【发表评论】【加入收藏】【告诉好友】【打印此文】【关闭窗口
      注:本站部分文章源于互联网,版权归原作者所有!如有侵权,请原作者与本站联系,本站将立即删除! 本站文章除特别注明外均可转载,但需注明出处! [MinTao学以致用网]
      网友评论:(只显示最新10条。评论内容只代表网友观点,与本站立场无关!)

    同类栏目
    · C语言系列  · VB.NET程序
    · JAVA开发  · Delphi程序
    · 脚本语言
    更多内容
    热门推荐 更多内容
  • 没有教程
  • 赞助链接
    更多内容
    闵涛博文 更多关于武汉SEO的内容
    500 - 内部服务器错误。

    500 - 内部服务器错误。

    您查找的资源存在问题,因而无法显示。

    | 设为首页 |加入收藏 | 联系站长 | 友情链接 | 版权申明 | 广告服务
    MinTao学以致用网

    Copyright @ 2007-2012 敏韬网(敏而好学,文韬武略--MinTao.Net)(学习笔记) Inc All Rights Reserved.
    闵涛 投放广告、内容合作请Q我! E_mail:admin@mintao.net(欢迎提供学习资源)

    站长:MinTao ICP备案号:鄂ICP备11006601号-18

    闵涛站盟:医药大全-武穴网A打造BCD……
    咸宁网络警察报警平台