subprg.~pas

这是一个用来控制windows状态栏右下角的程序开发例子.

unit subprg;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type Tbuf = array[1..1024] of char;
type Tstr = array[1..100] of string;
type
  TForm_sub = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
    function getamount(amount:string): string;
    function space(len:integer): string;
    function rightspace(src_str:string;len:integer): string;
    function leftzero(src_str:string;len:integer): string;
    function delete_point(amount:string): string;
    function leftspace(src_str:string;len:integer): string;
    function subst(buf :Tbuf;index:integer;len:integer): string;
    function mconvert(l_money:double): string;
    procedure writelog(logstr:string);
    function finds(source:string;index:integer): string;
end;

var
  Form_sub: TForm_sub;

implementation

{$R *.DFM}

//将金额中","去掉
function TForm_sub.getamount(amount:string): string;
var
  i,len:integer;
  back:string;
begin
        len:=length(amount);
	i:=1;
	back:='';
	while len>0 do
            begin
		if copy(amount,i,1)<>',' then
			back:=back+copy(amount,i,1);
		i:=i+1;
		len:=len-1;

	    end;
	getamount:=back;
end;

//将金额中"."去掉
function TForm_sub.delete_point(amount:string): string;
var
  i,len:integer;
  back:string;
begin
        len:=length(amount);
	i:=1;
	back:='';
	while len>0 do
            begin
		if copy(amount,i,1)<>'.' then
			back:=back+copy(amount,i,1);
		i:=i+1;
		len:=len-1;
	    end;
	delete_point:=back;
end;

//生成空格
function TForm_sub.space(len:integer): string;
var
  back:string;
begin
back:='';
    while len>0 do
       begin
         back:=' '+back;
         len:=len-1;
       end;
    space:=back;
end;

//右补空格
function TForm_sub.rightspace(src_str:string;len:integer): string;
var
  back:string;
begin
    back:=trim(src_str);
    len:=len-length(trim(src_str));
    while len>0 do
       begin
         back:=back+' ';
         len:=len-1;
       end;
    rightspace:=back;
end;

//左补0
function TForm_sub.leftzero(src_str:string;len:integer): string;
var
  back:string;
begin
    back:=trim(src_str);
    len:=len-length(trim(src_str));
    while len>0 do
       begin
         back:='0'+back;
         len:=len-1;
       end;
    leftzero:=back;
end;

//左补空
function TForm_sub.leftspace(src_str:string;len:integer): string;
var
  back:string;
begin
    back:=trim(src_str);
    len:=len-length(trim(src_str));
    while len>0 do
       begin
         back:=' '+back;
         len:=len-1;
       end;
    leftspace:=back;
end;

//取子串
function TForm_sub.subst(buf:Tbuf;index:integer;len:integer): string;
var
  i:integer;
  back:string;
begin
        for i := 0 to len-1 do
          begin
            if ord(buf[index+i])<>0 then
                    back:=back+buf[index+i]
            else
                    break;
          end;
	subst:=back;
end;

//生成数字大写
function TForm_sub.mconvert(l_money:double): string;
var
l_numstr ,l_tenstr ,l_str,l_mstr:string;
l_tens,l_ord:integer;
l_hppp:string;
l_bg:bool;
begin
IF l_money<=0 then
   IF l_money=0  then
      l_hppp:='零'
   ELSE
     begin
      l_hppp:='负';
      l_money:=ABS(l_money);
     end
ELSE
l_hppp:='零'+space(6);
l_numstr:='零壹贰叁肆伍陆柒捌玖';
l_tenstr:='分角元拾佰仟万拾佰仟亿拾佰仟万';
l_str:='';
l_tens:=0;
l_mstr:=trim(formatfloat('0.00',l_money));
//若为整数后加“整”字
IF copy(l_mstr,length(l_mstr)-1,1)='0'  then
   l_str:='整';
l_bg:=false;
WHILE length(l_mstr)>0 do
  begin
   IF copy(l_mstr,length(l_mstr),1)='.' then
      l_mstr:=copy(l_mstr,1,length(l_mstr)-1);
   l_ord:=strtoint(copy(l_mstr,length(l_mstr),1));
   l_mstr:=copy(l_mstr,1,length(l_mstr)-1);

   IF l_ord=0 then
    begin
         l_str:=TRIM(copy(l_numstr,l_ord,2))+TRIM(copy(l_tenstr,l_tens*2+1,2))+l_str;
//         l_str:=TRIM(copy(l_numstr,l_ord,2))+space(6)+l_str;
         l_tens:=l_tens+1;
         continue;
    end
   ELSE
     begin
      l_ord:=l_ord*2+1;
//      l_str:=TRIM(copy(l_numstr,l_ord,2))+space(6)+l_str;
      l_str:=TRIM(copy(l_numstr,l_ord,2))+TRIM(copy(l_tenstr,l_tens*2+1,2))+l_str;
      l_bg:=true;
      l_tens:=l_tens+1;
     end;
  end;
l_str:=l_hppp+TRIM(l_str);
//l_str:=SPACE(l_length-length(l_str))+l_str;
mconvert:=l_str;
end;

//*************
//写日志文件
procedure TForm_sub.writelog(logstr:string);
var
f: TextFile;
FileHandle: Integer;
filename:string;
begin
   filename:='.\log\log'+FormatDateTime('yyyymmdd',date)+'.txt';
   if not FileExists(filename) then
     begin
       FileHandle:=FileCreate(filename);
        if FileHandle<0 then
          exit
        else
          FileClose(FileHandle);
      end;
    AssignFile(f,filename);
    Append(f);
    Writeln(f, logstr);
    Flush(f);
    CloseFile(f);
end;

//查找“|”分隔符字符串
function TForm_sub.finds(source:string;index:integer): string;
var
i,len,count:integer;
tmpbuf:string;
begin
i:=1;
count:=0;
len:=length(trim(source));
finds:='';
tmpbuf:='';
while i<=len do
  begin
    if copy(source,i,1)='|' then
      begin
       count:=count+1;
       if count=index  then
         begin
            finds:=tmpbuf;
            break;
         end
       else
         tmpbuf:='';
      end
    else
      begin
        tmpbuf:=tmpbuf+copy(source,i,1);
      end;
    i:=i+1;
  end;
if count=index-1 then
  begin
   finds:=tmpbuf;
  end;
end;
end.