Board logo

标题: 控件:实现虚线的StringGrid [打印本页]

作者: 网事如风    时间: 2005-5-2 21:33     标题: 控件:实现虚线的StringGrid

{**
* 单元:DotLineGrid
* 作者:网事如风
* 作用:实现虚线的StringGrid
* 使用:
**}
unit DotLineGrid;

interface

uses
  SysUtils, Classes, Controls, Grids, Types, Graphics;

type
  tDotLineGrid = class(TStringGrid)
  private
    { Private declarations }
  protected
    { Protected declarations }
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
      AState: TGridDrawState); override;
  public
    { Public declarations }
  published
    { Published declarations }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [tDotLineGrid]);
end;

procedure tDotLineGridGrid.DrawCell(ACol, ARow: Longint; ARect: TRect;
  AState: TGridDrawState);
Var
    I, TmpWidth : Integer;
begin
    Canvas.Pen.Color := clblack;
    Canvas.Pen.Style := psSolid;
    inherited DrawCell(ACol, ARow, ARect, AState);

    TmpWidth := 0;
    for I := 1 to RowCount do
    begin
        if ( (I > 0) and (not odd( I ) ) ) then
        begin
            //Canvas.Pen.Color := clblack;
            Canvas.Pen.Style := psDot;
        end
        else
        begin
            //Canvas.Pen.Color := clblack;
            Canvas.Pen.Style := psSolid;
        end;

        Inc(TmpWidth, RowHeights[I - 1]+1);
        Canvas.MoveTo( 0,     TmpWidth - 1 );
        Canvas.LineTo( Width, TmpWidth - 1 );
    end;

    TmpWidth := 0;
    for I := 1 to ColCount do
    begin
        Inc(TmpWidth, ColWidths[I - 1]+1);
        Canvas.MoveTo( TmpWidth - 1,       0 );
        Canvas.LineTo( TmpWidth - 1,   Width );
    end;
end;

end.
作者: Nothing    时间: 2005-5-10 19:18

不错




欢迎光临 编程开发论坛 (http://bbs.lihuasoft.net/) Powered by Discuz! 6.0.0