DELPHI盒子
!实时搜索: 盒子论坛 | 注册用户 | 修改信息 | 退出
检举帖 | 全文检索 | 关闭广告 | 捐赠
技术论坛
 用户名
 密  码
自动登陆(30天有效)
忘了密码
≡技术区≡
DELPHI技术
lazarus/fpc/Free Pascal
移动应用开发
Web应用开发
数据库专区
报表专区
网络通讯
开源项目
论坛精华贴
≡发布区≡
发布代码
发布控件
文档资料
经典工具
≡事务区≡
网站意见
盒子之家
招聘应聘
信息交换
论坛信息
最新加入: szliyu112358
今日帖子: 50
在线用户: 8
导航: 论坛 -> 文档资料 斑竹:liumazi,ruralboy  
作者:
男 hjandy (andy) ★☆☆☆☆ -
普通会员
2015/8/1 20:00:44
标题:
求凭证中文帐簿金额栏(或DBGrid中文帐簿金额栏) for xe2 and xe8 浏览:5635
加入我的收藏
楼主: 求凭证中文帐簿金额栏(或DBGrid中文帐簿金额栏)

Ehlib中文帐簿金额栏 for xe2 and xe8
----------------------------------------------
andy
作者:
男 olddelphier (oldDelphier) ▲▲▲▲△ -
普通会员
2015/8/1 20:17:24
1楼: 都是自己画
----------------------------------------------
-
作者:
男 kenliaoliao (ben) ★☆☆☆☆ -
普通会员
2015/8/2 16:47:51
2楼: 我是自己画的,公司电脑里截图和原代码你要明天给你
----------------------------------------------
-
作者:
男 kenliaoliao (ben) ★☆☆☆☆ -
普通会员
2015/8/3 7:44:45
3楼: 你要到的是这个效果吗?我用的是TMS AdvColumnGrid做的。
此帖子包含附件:
JPEG 图像
大小:105.9K
----------------------------------------------
-
作者:
男 www12345 (风云) ★☆☆☆☆ -
盒子活跃会员
2015/8/3 13:09:08
4楼: 很好
----------------------------------------------
一卡通专家的中专家www.cnduh.com
作者:
男 hjandy (andy) ★☆☆☆☆ -
普通会员
2015/8/3 19:40:23
5楼: kenliaoliao (ben) 可以上传下载吗或请Email 79762617@qq.com, 谢了!! 如果有就差中文帐簿了
----------------------------------------------
andy
作者:
男 grjs_2004 (grjsITname) ★☆☆☆☆ -
盒子活跃会员
2015/8/3 20:20:38
6楼: 这种中文金额格式,自己画就可以啦!简单地很
----------------------------------------------
Everyone will to do best!
作者:
男 kenliaoliao (ben) ★☆☆☆☆ -
普通会员
2015/8/4 9:45:54
7楼:  hjandy (andy)  代码如下:
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.
----------------------------------------------
-
作者:
男 hwkjzyh (汉卿) ★☆☆☆☆ -
盒子活跃会员
2015/8/4 10:45:57
8楼: 谢谢!到时用一下。
----------------------------------------------
作者:
男 hjandy (andy) ★☆☆☆☆ -
普通会员
2015/8/5 20:27:45
9楼: kenliaoliao (ben) ,  谢了,找个时间试下;
----------------------------------------------
andy
信息
登陆以后才能回复
Copyright © 2CCC.Com 盒子论坛 v3.0.1 版权所有 页面执行117.1875毫秒 RSS