Delphi 如何用TMS AdvStringGrid做财务会计记账凭证的多表头网格表格？

最新推荐文章于 2025-06-12 15:35:15 发布
最新推荐文章于 2025-06-12 15:35:15 发布
阅读量1.1k 收藏 6
点赞数 1
CC 4.0 BY-SA版权
分类专栏： Delphi 文章标签： Delphi TAdvStringGrid 财务会计记账凭证 多表头表格 多表头网格
泰山老父神枕传承人战小东
本文链接：https://blog.youkuaiyun.com/xyzhan/article/details/109708470
Delphi多表头财务会计记账凭证

郑重提示：本文代码来自Delphi盒子中的用户：kenliaoliao (ben)  感谢kenliaoliao (ben)对Delphi社区的贡献！欢迎加入Delphi开发局QQ群:32422310  Delphi控件源码下载网站 

{郑重提示：本文代码来自Delphi盒子中的用户：kenliaoliao (ben)  感谢kenliaoliao (ben)对Delphi社区的贡献！}
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, AdvObj, BaseGrid, AdvGrid, AdvCGrid, Buttons;

type
  TForm1 = class(TForm)
    Grid: TAdvColumnGrid;
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    procedure GridGetCellBorder(Sender: TObject; ARow, ACol: Integer;
      APen: TPen; var Borders: TCellBorders);
    procedure FormCreate(Sender: TObject);
    procedure GridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
      State: TGridDrawState);
    procedure GridCellsChanged(Sender: TObject; R: TRect);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    CommitFlag :Boolean;
    procedure InitGrid;

  public
    { Public declarations }
  end;

var
  Form1: TForm1;
const
  MaxDigit =15;
  UnitList :Array[0..14] of string=('万亿','仟亿','佰亿','拾亿','亿','仟万','佰万','拾万','万','仟','佰','拾','元','角','分');
var
   DefLineWidth :Integer;
function Lpad(const Str :string;Len :Integer;FillStr :Char) :string;
function RoundtoExStr(const Value:Double;Digit:word=2; Format :Boolean= False):string;
procedure ReplaceEx(var s:string;const SourceChar,RChar:PChar);

procedure DrawLine(const Canvas :TCanvas; const ASource,ATrage :TPoint; PenColor :TColor=clBlack;PenWidth:Integer=1);
procedure DrawMoneyHeader(const Canvas :TCanvas;ARect :TRect;AWidth :Integer);
procedure DrawMoneyValue(const Canvas :TCanvas;ARect :TRect;AValue :double;AWidth :Integer;CurrencyFlag :Boolean=False);
implementation


{$R *.dfm}

procedure DrawLine(const Canvas :TCanvas; const ASource,ATrage :TPoint; PenColor :TColor=clBlack;PenWidth:Integer=1);
var
  APen :TPen;
  AOldPen :TPen;
  Pt :TPoint;
begin
  APen :=TPen.Create;
  APen.Width :=PenWidth;
  APen.Color :=PenColor;
  AOldPen :=Canvas.Pen;
  Canvas.Pen :=APen;
  Canvas.MoveTo(ASource.X,ASource.Y);
  Canvas.LineTo(ATrage.X,ATrage.Y);
  Canvas.Pen :=AOldPen;
end;

procedure DrawMoneyHeader(const Canvas :TCanvas;ARect :TRect;AWidth :Integer);
  var
    I,J :Integer;
    iStart :Integer;
    sText,S :string;
    rcText :TRect;
    OldBrushStyle :TBrushStyle;
    APt,BPt :TPoint;
  begin
    J :=0;
    iStart :=Length(UnitList)-MaxDigit;
    for I := iStart to High(UnitList) do
      begin
        sText :=UnitList[I];
        S :=sText;

        case Length(sText) of
        1:
          begin
          rcText.Top := ARect.Top+2;
          rcText.Bottom := ARect.Bottom;
          rcText.Left := ARect.Left+J*AWidth+2;
          rcText.Right := rcText.Left + AWidth-1 ;
          Canvas.Brush.Style :=bsClear;
          Canvas.TextRect(rcText,S,[tfSingleLine,tfCenter,tfVerticalCenter]);
          Canvas.Brush.Style :=OldBrushStyle;
          end;
        2:
          begin

          rcText.Top := ARect.Top+2;
          rcText.Bottom := ARect.Top + (ARect.Bottom - ARect.Top) div 2;
          rcText.Left := ARect.Left + J*AWidth +2;
          rcText.Right := rcText.Left + AWidth-1;
          S :=Copy(sText,1,1);
          Canvas.Brush.Style :=bsClear;
          Canvas.TextRect(rcText,S,[tfSingleLine,tfCenter,tfBottom]);
          Canvas.Brush.Style :=OldBrushStyle;

          rcText.Top := ARect.Top + (ARect.Bottom - ARect.Top) div 2;
          rcText.Bottom := ARect.Bottom;
          S :=Copy(sText,2,1);
          Canvas.Brush.Style :=bsClear;
          Canvas.TextRect(rcText,S,[tfSingleLine,tfCenter,tfTop]);
          Canvas.Brush.Style :=OldBrushStyle;
          end;
        end;
        Inc(J);
      end;

    //画框线
    for I := 1 to MaxDigit-1 do
      begin
        APt.X :=ARect.Left+I*AWidth+1;
        APt.Y :=ARect.Top;
        BPt.X :=ARect.Left+I*AWidth+1;
        BPt.Y :=ARect.Bottom;
        DrawLine(Canvas,APt,BPt);
      end
  end;

procedure DrawMoneyValue(const Canvas :TCanvas;ARect :TRect;AValue :double;AWidth :Integer;CurrencyFlag :Boolean=False);
var
  S,sText :string;
  I,intLen :Integer;
  rcText :TRect;
  iFlag :Boolean;
  OldBrushStyle :TBrushStyle;
  AFont,OldFont :TFont;
  APt,BPt :TPoint;
begin

  S :=FloatToStr(Abs(AValue));
  if S='0' then
    S :='';
  intLen := Length(S);

  if intLen<> 0 Then
    begin
      if Pos('.',S)>0 then
        begin
          if intLen>MaxDigit then
          begin
          //Application.MessageBox('数值超出范围！','错误',MB_ICONERROR+MB_OK);
          Exit;
          end;
        end;
      S :=RoundtoExStr(StrToFloat(S),2,True);
      if S='0.00' then
        S :=''
      else
        ReplaceEx(S,'.','');


      S :=Lpad(S,-MaxDigit,'0');
      intLen := Length(S);
      if IntLen>MaxDigit then
        begin
          //Application.MessageBox('数值超出范围！','错误',MB_ICONERROR+MB_OK);
          Exit
        end;

      rcText :=ARect;
      rcText.Left :=rcText.Left+DefLineWidth;
      rcText.Top :=rcText.Top+DefLineWidth;
      rcText.Right :=rcText.Right-DefLineWidth;
      rcText.Bottom :=rcText.Bottom-DefLineWidth;

      Canvas.FillRect(rcText);

      rcText :=ARect;
      iFlag :=True;


      AFont :=TFont.Create;
      try

        if AValue<0 then
          AFont.Color :=clRed
        else
          AFont.Color :=clBlue;
        OldFont :=Canvas.Font;
        Canvas.Font :=AFont;


        for I := 1 to Length(S) do
          begin
          rcText.Left := ARect.Left + (MaxDigit-1 - intLen + i) * AWidth+1;
          rcText.Right := rcText.Left + AWidth-1;
          if rcText.Right>=ARect.Right-1 then
          rcText.Right :=rcText.Right-DefLineWidth;
          rcText.Bottom :=ARect.Bottom+DefLineWidth;

          sText :=Copy(S,I,1);


          if sText='0' then
          begin
          if iFlag then
          begin
          if Copy(S,I+1,1)<>'0' then
          begin
          if CurrencyFlag then
          begin
          sText :='￥';
          Canvas.TextRect(rcText,sText,[tfSingleLine,tfCenter,tfVerticalCenter]);
          end;
          end;

          end
          else
          begin
          Canvas.Brush.Style :=bsClear;
          Canvas.TextRect(rcText,sText,[tfSingleLine,tfCenter,tfVerticalCenter]);
          Canvas.Brush.Style :=OldBrushStyle;
          end;
          end
          else
          begin
          iFlag :=False;
          Canvas.Brush.Style :=bsClear;
          Canvas.TextRect(rcText,sText,[tfSingleLine,tfCenter,tfVerticalCenter]);
          Canvas.Brush.Style :=OldBrushStyle;
          end;
          end;
      finally
        Canvas.Font :=OldFont;
        Canvas.Brush.Style :=OldBrushStyle;
      end;
    end;
  for I := 1 to MaxDigit-1 do
    begin
      APt.X :=ARect.Left+I*AWidth;
      APt.Y :=ARect.Top-1;
      BPt.X :=ARect.Left+I*AWidth;
      BPt.Y :=ARect.Bottom;
      if I =MaxDigit-2 then
        DrawLine(Canvas,APt,BPt,clred,2)
      else
      if ((MaxDigit-2-I) mod 3)=0  then
        DrawLine(Canvas,APt,BPt,clBlue,2)
      else
        DrawLine(Canvas,APt,BPt,clGreen)
    end;
  APt.X :=ARect.Right;
  APt.Y :=ARect.Top-1;
  BPt.X :=ARect.Right;
  BPt.Y :=ARect.Bottom;
  DrawLine(Canvas,APt,BPt,clWhite,1);
  APt.X :=ARect.Right-1;
  BPt.X :=ARect.Right-1;
  DrawLine(Canvas,APt,BPt,clBlack,2);
  APt.X :=ARect.Right+3;
  BPt.X :=ARect.Right+3;
  DrawLine(Canvas,APt,BPt,clBlack,1);
end;

procedure ReplaceEx(var s:string;const SourceChar,RChar:PChar);
//第一个参数是原串，第二个是模式串，第三个是替换串
var
 ta,i,j:integer;
 m,n,pn,sn:integer;
 SLen,SCLen,RCLen:integer;//SLen表示原串的长度，SCLen表示模式传的长度，RCLen表示替换串的长度
 IsSame:integer;
 newp:array of char;//用来保存替换后的字符数组

begin
  SLen:=strlen(pchar(s));SCLen:=strlen(SourceChar);RCLen:=strlen(RChar);
  j:=pos(string(SourceChar),s);
  s:=s+chr(0);ta:=0;i:=j;
  while s[i]<>chr(0) do   //这个循环用ta统计模式串在原串中出现的次数
    begin
     n:=0;IsSame:=1;
     for m:=i to i+SCLen-1 do
       begin
        if m>SLen then
          begin
          IsSame:=0;
          break;
          end;
        if s[m]<>sourceChar[n] then
          begin
          IsSame:=0;
          break;
          end;
        n:=n+1;
       end;
     if IsSame=1 then
       begin
        ta:=ta+1;
        i:=m;
       end
     else
       i:=i+1;
    end;
  if j>0 then
    begin
      pn:=0;sn:=1;
      SetLength(newp,SLen-ta*SCLen+ta*RCLen+1);//分配newp的长度，+1表示后面还有一个#0结束符
      while s[sn]<>chr(0) do //主要循环，开始替换
        begin
         n:=0;IsSame:=1;
         for m:=sn to sn+SCLen-1 do //比较子串是否和模式串相同
          begin
          if m>SLen then
          begin
          IsSame:=0;
          break;
          end;
          if s[m]<>sourceChar[n] then
          begin
          IsSame:=0;break;
          end;
          n:=n+1;
          end;
         if IsSame=1 then//相同
          begin
          for m:=0 to RCLen-1 do
          begin
          newp[pn]:=RChar[m];
          pn:=pn+1;
          end;
          sn:=sn+SCLen;
          end
         else
          begin //不同
          newp[pn]:=s[sn];
          pn:=pn+1;sn:=sn+1;
          end;
        end;

      s:=string(newp); //重置s，替换完成！
      sLen :=Length(s);
      S :=Copy(S,1,sLen-1);
    end;
end;

function Lpad(const Str :string;Len :Integer;FillStr :Char) :string;
var
  Str1 :string;
  Str2 :string;
  I  :Integer;
begin
  if Len=0 then
    begin
      Result :='';
      Exit;
    end
  else
    if Length(Str)>=Abs(Len) then
      begin
        if Len>0 then
          begin
          Result :=Copy(Str,1,Abs(Len));
          Exit;
          end
        else
          begin
          I :=Length(Str)-Abs(Len)+1;
          Result :=Copy(Str,I,Abs(Len));
          Exit;
          end;
      end;
    if Len>0 then
      begin
        Str1 :=stringOfChar(FillStr,Abs(Len));

        Str1 :=Str+Str1;
        Result :=Copy(Str1,1,Abs(Len));
        Exit;
      end
    else
      begin
        Str1 :=stringOfChar(FillStr,Abs(Len));
        Str1 :=Str1+Str;
        I :=Length(Str1)-Abs(Len)+1;
        Result :=Copy(Str1,I,Abs(Len));
        Exit;
      end;

end;

function RoundtoExStr(const Value:Double;Digit:word=2; Format :Boolean= False):string;
var
  Str :string;
  Ex :Extended;
  I :Integer;
begin
  Str :='0.'+StringOfChar('0',Digit);
  Result :=Str;

  Str :='#0.'+StringOfChar('0',Digit);
  Ex :=StrToFloat(FloatToStr(Value));
  Str :=FloatToStr(StrToFloat(FormatFloat(Str,Ex)));
  if not Format then
    begin
      Result :=Str;
      Exit;
    end
  else
    begin
      I :=Pos('.',Str);
      if I=0 then
        Str :=Str+'.0';
      Str :=Lpad(Str,20,'0');
      I :=Pos('.',Str);
      Result :=Copy(Str,1,I+Digit);
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  I,J :Integer;
  sValue:string;
  rcRect :TRect;
  APt,BPt :TPoint;
begin
  CommitFlag :=True;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  InitGrid;
  DefLineWidth :=Grid.GridLineWidth;

end;

procedure TForm1.GridCellsChanged(Sender: TObject; R: TRect);
var
  I :Integer;
  sValue1,sValue2 :double;
begin
  sValue1 :=0;
  sValue2 :=0;
  with Grid do
    begin
      for I :=FixedRows  to RowCount-2 do
        begin
          sValue1 :=sValue1+Floats[3,I];
          sValue2 :=sValue2+Floats[4,I];
        end;
      if sValue1<>0 then
        Floats[3,Grid.RowCount-1] :=sValue1;
      if sValue2<>0 then
        Floats[4,Grid.RowCount-1] :=sValue2;
    end;
end;

procedure TForm1.GridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
  State: TGridDrawState);
var
  I,J :Integer;
  SngWidth,iHeigth :Integer;
  rcText : TRect;
  S,sText :string;
  sValue,sValue1,sValue2 :Double;
  APt,BPt :TPoint;
  OldBrushStyle :TBrushStyle;
begin
  with Grid do
    begin
      OldBrushStyle :=Canvas.Brush.Style;
      case ACol of
      0:
        begin
          if ARow=0 then
          begin
          sText :='摘    要';
          rcText :=Rect;
          rcText.Left :=rcText.Left;
          rcText.Top :=rcText.Top;
          rcText.Right :=Grid.Columns[Acol].Width;
          rcText.Bottom :=Grid.RowHeights[0]+Grid.RowHeights[1]-2*DefLineWidth;

          Canvas.Brush.Style :=bsClear;
          Canvas.FillRect(rcText);
          Canvas.TextRect(rcText,sText,[tfSingleLine,tfCenter,tfVerticalCenter]);
          Canvas.Brush.Style :=OldBrushStyle;
          end;
          if ARow=RowCount-1 then
          begin
          sValue :=Ints[ACol,ARow];
          if sValue =0 then
          S :='   '
          else
          S :=IntToStr(Ints[ACol,ARow]);
          sText :='附件        '+S+'        张';
          rcText :=Rect;
          rcText.Left :=rcText.Left;
          rcText.Top :=rcText.Top;
          rcText.Right :=rcText.Left+Grid.Columns[Acol].Width-2*DefLineWidth;
          rcText.Bottom :=rcText.Top+Grid.RowHeights[ARow]-2*DefLineWidth;


          Canvas.FillRect(rcText);
          Canvas.Brush.Style :=bsClear;
          Canvas.TextRect(rcText,sText,[tfSingleLine,tfCenter,tfVerticalCenter]);
          Canvas.Brush.Style :=OldBrushStyle;
          end;

        end;
      1,2:
        begin
          if ARow=RowCount-1 then
          begin
          if ACol=1 then
          begin
          sText :='合          计';
          rcText :=Rect;
          rcText.Left :=rcText.Left;
          rcText.Top :=rcText.Top;
          rcText.Right :=rcText.Left+Grid.Columns[1].Width+Grid.Columns[2].Width-2;
          rcText.Bottom :=rcText.Top+Grid.RowHeights[ARow]-2;

          //Canvas.Brush.Style :=bsClear;
          Canvas.FillRect(rcText);
          Canvas.TextRect(rcText,sText,[tfSingleLine,tfCenter,tfVerticalCenter]);
          Canvas.Brush.Style :=OldBrushStyle;
          end;
          end
          else
          if ARow=0 then
          begin
          if ACol=1 then
          begin
          sText :='会计科目';
          rcText :=Rect;
          rcText.Left :=rcText.Left;
          rcText.Top :=rcText.Top;
          rcText.Right :=rcText.Left+Grid.Columns[1].Width+Grid.Columns[2].Width;
          rcText.Bottom :=Grid.RowHeights[ARow];

          Canvas.Brush.Style :=bsClear;
          Canvas.FillRect(rcText);
          Canvas.TextRect(rcText,sText,[tfSingleLine,tfCenter,tfVerticalCenter]);
          Canvas.Brush.Style :=OldBrushStyle;
          end;
          end
          else
          if ARow=1 then
          begin
          case ACol of
          1:  begin
          sText :='总帐科目';
          rcText :=Rect;
          rcText.Left :=rcText.Left;
          rcText.Top :=rcText.Top;
          rcText.Right :=rcText.Left+Grid.Columns[ACol].Width;
          rcText.Bottom :=rcText.Top+Grid.RowHeights[ARow];

          Canvas.Brush.Style :=bsClear;
          Canvas.FillRect(rcText);
          Canvas.TextRect(rcText,sText,[tfSingleLine,tfCenter,tfVerticalCenter]);
          Canvas.Brush.Style :=OldBrushStyle;
          end;
          2:
          begin
          sText :='明细科目';
          rcText :=Rect;
          rcText.Left :=rcText.Left;
          rcText.Top :=rcText.Top;
          rcText.Right :=rcText.Left+Grid.Columns[ACol].Width;
          rcText.Bottom :=rcText.Top+Grid.RowHeights[ARow];

          Canvas.Brush.Style :=bsClear;
          Canvas.FillRect(rcText);
          Canvas.TextRect(rcText,sText,[tfSingleLine,tfCenter,tfVerticalCenter]);
          Canvas.Brush.Style :=OldBrushStyle;

          end;
          end;
          end
        end;
      3,4:
        begin
          if ARow=0 then
          begin
          case ACol of
          3:
          begin
          sText :='借方金额';
          rcText :=Rect;
          rcText.Left :=rcText.Left;
          rcText.Top :=rcText.Top;
          rcText.Right :=rcText.Left+Grid.Columns[ACol].Width;
          rcText.Bottom :=rcText.Top+Grid.RowHeights[ARow];

          Canvas.Brush.Style :=bsClear;
          Canvas.FillRect(rcText);
          Canvas.TextRect(rcText,sText,[tfSingleLine,tfCenter,tfVerticalCenter]);
          Canvas.Brush.Style :=OldBrushStyle;
          end;
          4:
          begin
          sText :='贷方金额';
          rcText :=Rect;
          rcText.Left :=rcText.Left;
          rcText.Top :=rcText.Top;
          rcText.Right :=rcText.Left+Grid.Columns[ACol].Width;
          rcText.Bottom :=rcText.Top+Grid.RowHeights[ARow];

          Canvas.Brush.Style :=bsClear;
          Canvas.FillRect(rcText);
          Canvas.TextRect(rcText,sText,[tfSingleLine,tfCenter,tfVerticalCenter]);
          Canvas.Brush.Style :=OldBrushStyle;
          end;
          end;
          end
          else
          if ARow=1 then
          begin
          sngWidth := Grid.Columns[ACol].Width div MaxDigit;
          DrawMoneyHeader(Canvas,Rect,sngWidth);
          end
          else
          if ARow=RowCount-1 then
          begin
          sngWidth := Grid.Columns[ACol].Width div MaxDigit;
          sValue1 :=0;
          sValue2 :=0;
          for I := FixedRows to RowCount-2 do
          begin
          sValue1 :=sValue1+Floats[3,I];
          sValue2 :=sValue2+Floats[4,I];
          end;
          case ACol of
          3:
          begin
          DrawMoneyValue(Canvas,Rect,sValue1,SngWidth,True);
          end;
          4:
          begin
          DrawMoneyValue(Canvas,Rect,sValue2,SngWidth,True);
          end;
          end;

          end
          else
          begin
          sngWidth := Grid.Columns[ACol].Width div MaxDigit;
          if ARow>=Grid.FixedRows then
          begin
          //S :=Grid.Cells[ACol,ARow];
          sValue :=Grid.Floats[ACol,ARow];
          DrawMoneyValue(Canvas,Rect,sValue,SngWidth);
          end;
          end;
          //==========提交==========
          if CommitFlag then
          begin
          J :=FixedRows;
          for I :=RowCount-2 downto FixedRows do
          begin
          sText :=Trim(Cells[3,I]+Cells[4,I]);
          if sText<>'' then
          begin
          J :=I+1;
          Break;
          end;
          end;

          if J<>(Grid.RowCount-2) then
          begin
          rcText :=Grid.CellRect(3,Grid.RowCount-2);
          APt.X := rcText.Left;
          APt.Y := rcText.Bottom;

          rcText :=Grid.CellRect(3,J);
          BPt.X :=rcText.Right-3;
          BPt.Y :=rcText.Top;
          DrawLine(Canvas,APt,BPt,clBlack,3);
          end;
          end;

        end;
      5:
        begin
          if ARow=0 then
          begin
          rcText :=Rect;
          rcText.Left :=rcText.Left;
          rcText.Top :=rcText.Top;
          rcText.Right :=rcText.Left+Grid.Columns[Acol].Width-DefLineWidth;
          rcText.Bottom :=rcText.Top+Grid.RowHeights[0]+Grid.RowHeights[1]-2*DefLineWidth;
          iHeigth :=rcText.Bottom-rcText.Top;
          Canvas.Brush.Style :=bsClear;
          Canvas.FillRect(rcText);
          Canvas.Brush.Style :=OldBrushStyle;
          rcText :=Rect;

          sText :='记账√';
          for I := 1 to Length(sText) do
          begin
          S :=Copy(sText,I,1);
          rcText.Top :=Rect.Top;
          rcText.Top := rcText.Top+(I-1)*(iHeigth div 3);
          rcText.Bottom := rcText.Top + iHeigth div 3;

          Canvas.Brush.Style :=bsClear;
          Canvas.TextRect(rcText,S,[tfSingleLine,tfCenter,tfVerticalCenter]);
          Canvas.Brush.Style :=OldBrushStyle;
          end;
          end
          else
          if ARow>=FixedRows then
          begin
          S :='√';
          sValue :=Grid.Floats[ACol,ARow];
          if sValue<>1 then
          begin
          S :='';
          end;
          sText :=S;
          rcText :=Rect;
          rcText.Left :=rcText.Left+DefLineWidth;
          rcText.Top :=rcText.Top+DefLineWidth;
          rcText.Right :=rcText.Right-DefLineWidth;
          rcText.Bottom :=rcText.Bottom-DefLineWidth;
          Canvas.FillRect(rcText);
          Canvas.Brush.Style :=bsClear;
          Canvas.TextRect(rcText,sText,[tfSingleLine,tfCenter,tfVerticalCenter]);
          Canvas.Brush.Style :=OldBrushStyle;
          end;
        end;
      end;
    end;
end;

procedure TForm1.GridGetCellBorder(Sender: TObject; ARow, ACol: Integer;
  APen: TPen; var Borders: TCellBorders);
begin
{  if (ARow>=Grid.FixedRows) and (ACol>=Grid.FixedCols) then
    begin
      Borders := [cbLeft,cbRight];
      APen.Width := 1;
      APen.Color := Grid.GridLineColor;
    end; }
end;

procedure TForm1.InitGrid;
var
  I :Integer;
begin
  CommitFlag :=False;
  Grid.RowHeights[0] :=35;
  Grid.RowHeights[1] :=44;
  Grid.MergeCells(0,0,1,2);
  Grid.MergeCells(1,0,2,1);
  Grid.MergeCells(5,0,1,2);
  Grid.MergeCells(1,Grid.RowCount-1,2,1);
  Grid.Cells[0,0] :='';
  for I := 1 to Grid.ColCount-1 do
  Grid.ReadOnly[I,Grid.RowCount-1] :=True;
 { Grid.Cells[1,0] :='会计科目';

  Grid.Cells[3,0] :='借方金额';
  Grid.Cells[4,0] :='贷方金额';


  Grid.Cells[1,1] :='总账科目';
  Grid.Cells[2,1] :='明细科目';  }
end;

end.

 

delphi html 表格控件,Delphi之TMS开发组件包-TAdvStringGrid表格控件
weixin_42135073的博客
06-09 2235
最近项目涉及一些复杂表格显示的实现，尝试使用Dev Express的cxGrid控件多次还是没法实现想要的效果，后来发现，TMS开发组件包的TAdvStringGrid可以实现效果。这里举例来说明一下，例如，需要实现如下效果: 如上所示是一个3行4列的表格，其中，第一行的1、2列合并，第2行的2、3列合并，下面使用TAdvStringGrid来实现，步骤如下：1. 新建一个VCL窗口项目，布局界面...
Delphi-财务控件
09-01
一个很好用的财务控件，中国式记账凭证，界面漂亮。
Delphi 7用TAdvStringGrid控件提升表格交互与展示
weixin_34456923的博客
06-12 870
TAdvStringGrid-v4.0.8.1是业界领先的网格控件之一，以其强大功能和高度定制性在应用程序开发中扮演着重要角色。它提供了丰富的API接口，以及高度可配置的选项，支持开发者实现复杂的数据展示和交互功能。对于需要处理大量数据和提供良好用户体验的应用程序，TAdvStringGrid能够通过其灵活的布局和样式定制来满足不同项目需求。TAdvStringGrid不仅包括基本的网格功能，如列宽调整、行高设置和数据绑定，还支持更高级的特性，比如自定义单元格绘制、内置数据编辑器和丰富的事件系统。
TMS AdvStringGrid
马东成
11-04 1180
 一、标题   1、列标：ColumnHeards   2、行标：RowHeards
会计凭证控件
11-30
可以在c++builder6 delphi6等开发工具上使用的会计凭证开发控件 可以做出完全仿真的会计凭证
v8.3.4.0 TMS advstringgrid控件
08-13
v8.3.4.0 TMS advstringgrid控件 XE10.2 亲测可用 ，分数少，毕竟大家好才是真的好。安装方法 打开 TMSDXE10startergroup.groupproj 挨个安装 再加入路径
Delphi TMS控件包：AdvStringGrid等高级组件介绍
标题中提到的“Delphi TMS控件”指的是由TMS Software公司为Delphi开发环境开发的一系列高级控件。Delphi是一个由Embarcadero公司开发的集成开发环境（IDE），用于快速开发各种应用程序，包括桌面、移动和Web应用...
TMS VCL UI Pack (原TMS Component Pack) 组件 10.8.2.1 Delphi 7 - 11
12-07
4. 网格组件：TMS Grid Pack是该组件库的一大特色，包含多款网格控件，如FlexGrid、AdvGrid等，它们拥有强大的数据处理能力，支持自定义单元格样式、多级表头、嵌套网格等高级功能，能应对各种复杂的数据展示需求。...
Delphi7中DBGridEh多表头控件的使用技巧
在深入介绍Delphi 7中的多表头控件DBGridEh之前，首先需要了解Delphi这个编程环境，以及DBGrid控件本身。Delphi，是由Embarcadero Technologies公司开发的一款快速应用程序开发(RAD)工具，主要面向对象的可视化编程...
delphi7修改AdvStringGrid选中行字体的颜色
最新发布
07-25
我们正在使用Delphi 7中的AdvStringGrid控件，并希望设置选中行时的字体颜色。 根据引用[2]中提到的信息，AdvStringGrid是一个功能丰富的控件，支持多种自定义设置。但是，引用中并没有直接提到如何设置选中行的...
TMS ADVStringGrid For Delphi XE8
02-02
根据TMSPACK 8.0.4抽取所需要文件,只含ADVStringGrid相关文件,只编译XE8的Release的Win32和Win64
支持多表头及单元格合并的StringGrid
01-13
StringGrid的扩展控件, 在StringGrid的基础上增加了: 分别定义每列属性; 支持多层表头、表头斜线 单元格合并、拆分; 每个单元格可单独设置字体、颜色、对齐等格式 随意行、列锁定 指定表格背景图片，格线顔色 对每行数据提供状态管理(Modified,Inserted,Deleted,Unmodified) 动态插入、删除行列 支持下拉框，按纽等内嵌编辑器，并能自由扩充 支持列头点击排序, 记录Filter过滤显示 并增加OnEnterCell与OnLeaveCell事件，可得知鼠标光标是否经过某格 支持在设计期间进行编辑，支持直接打印、预览,对于超宽部分能够自动分页。以上有部份功能暂时还未完成。axcom@163.com2005.7.15
delphi 记账软件
01-23
因为花钱不知真么花出去了,所以自己做了小东东用来记账.源代码就不用发了,那都是非常幼稚的代码,而且现在我自己都看不懂了!!希望能赚点分^_^
TMS_TAdvStringGrid_v5.5_Developers_Guide.pdf
08-05
TMS_TAdvStringGrid_v5.5_Developers_Guide.pdf Delphi TMS控件使用介绍 详细介绍TMS AdvStringGrid控件使用，属性，方法等
Delphi记帐财务管理软件源码.rar
07-10
Delphi记帐财务管理软件源码，Access数据库，窗体图标式布局，可展开式菜单，表格式列表，另外程序利用sui的numberEdit做得金额输入框，屏蔽一切非数字输入，保证数据的有效性，这个小功能你可以应用到你现有的Delphi项目中，我觉得挺不错。
DELPHI 表格控件DBGridEh史上最全使用资料(101页)
06-03
DELPHI表格控件DBGridEh是应用在Delphi开发环境中的一款增强型表格组件，它提供了丰富多样的数据操作和显示功能，能够极大地简化开发人员在表格操作方面的编码工作。接下来，将从DBGridEh的功能、应用实例以及与之...
Delphi打造日常生活支出记账本『罗斌原创』
weixin_33690367的博客
10-16 125
前段时间，放假有那么点时间，闲着了，索性就用Delphi写了个记账本小程序，为了方便跟我蜗居在一起的哥们生活日常开支记录，彻底丢弃原始的记账方式，现在流行无纸化办公嘛。呵呵，到现在已经也用了好长一段时间了，还不错，感觉挺好的，而今，这么好的东西我不能写给自己独自享用嘛，好东西应该分给大家都去用，呵呵，不过，不是每个人都能派上用场哦，俺这个东西只适用于跟我一样再...
DELPHI 画报表 画表头 stringgrid控件
潇湘博客
07-09 4983
DELPHI 画报表 画表头 stringgrid控件procedure   TForm1.StringGrid1DrawCell(Sender:   TObject;   ACol,   ARow:       Integer;         Rect:   TRect;   State:   TGridDrawState);     var      
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值