printadounit.pas

来自「这是为工商所开发的工商收费簿套打软件,借初学者学习」· PAS 代码 · 共 525 行 · 第 1/2 页

unit PrintAdoUnit;

interface

uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, ComCtrls, DB, ADODB, LbSpeedButton, StdCtrls,StrUtils ,
    Mask, DBCtrls, OleCtnrs, DBCtrlsEh, Gauges,IniFiles,Printers   ;

    procedure PrintPage2;
    procedure printpage3;
    procedure printpage4;
    procedure printpage5;
    procedure PrintPage6;

    function PrinterPos(iMM:double;XorY:String):integer;
    function GetPX(X:Double):Integer ;
    function GetPY(Y:Double):Integer ;
    procedure splitPrint(s:String;len,len2,x,y,x2:Integer ) ;
    procedure SetDefPrinter(lPrinterIndex:Integer);
    function GetDefPrinter:string ;
  Function DXZH(f : String) : String;     //人民币转换
  Function my_strtoyear(yy :tdatetime):String;
  Function my_strtomonth(yy:tdatetime):String;
  Function my_strtodday(yy:tdatetime):String;
implementation
 uses UnitPreview ;
var x :integer  ;
var y :integer  ;

///////////大写转换//////////////////////
Function DXZH(f : String) : String;
var dx,d2,zs,xs,s1,s2,h,jg:string;
   i,ws,l,w,j,lx:integer;
begin
  f := Trim(f);
  if copy(f,1,1)='0' then begin
    Delete(f,1,1);end
  else ;
  dx:='零壹贰叁肆伍陆柒捌玖';
  d2:='拾佰仟万亿';
  i := AnsiPos('.',f);   //小数点位置
  If i = 0 Then
     zs := f     //整数
  Else begin
     zs:=copy(f,1,i - 1);  //整数部分
     xs:=copy(f,i + 1,200);
  End;
  ws:= 0; l := 0;
  For i :=Length(zs) downTo 1 do begin
    ws := ws + 1; h := '';
    w:=strtoint(copy(zs, i, 1));
    if (w=0) and (i=1) then jg:='零';
    If w > 0 Then
       Case ws of
         2..5:h:=copy(d2,(ws-1)*2-1,2);
         6..8:begin
           h:=copy(d2,(ws-5)*2-1,2);
           If AnsiPos('万',jg)=0 Then h:=h+'万';
           end;
         10..13:h :=copy(d2,(ws-9)*2-1, 2);
       End;
    jg:=copy(dx,(w+1)*2-1,2) + h + jg;
    If ws=9 Then jg :=copy(jg,1,2)+'亿'+copy(jg,3,200);
  end;
  j:=AnsiPos('零零',jg);
  While j>0 do begin
    jg :=copy(jg, 1, j - 1)+copy(jg,j+2,200);
    j :=AnsiPos('零零',jg);
  end;
  If (Length(jg)>1)And(copy(jg,length(jg)-1,2)='零')Then jg :=copy(jg,1,Length(jg)-2);
  j := AnsiPos('零亿',jg);
  If j > 0 Then jg:=copy(jg,1, j - 1)+copy(jg, j + 2,200);
  //转换小数部分
  If (Length(jg)>1) then    //定义元
     jg :=jg+'元'
  else
     jg:=jg;    
  lx := Length(xs);
  If lx=0Then begin          //如果小数为零
    jg :=jg + '整' ;
  End;
  If lx=1Then begin         //如果小数为一位
    s1:=copy(dx, strtoint(copy(xs,1,1))*2 + 1, 2);
    if s1<>'零' then
      jg := jg+s1+'角'+'整' ;
    if s1='零' then
      jg := jg+'整' ;
  End;
  If lx>=2Then begin        //小数为两位
    s1:=copy(dx, strtoint(copy(xs,1,1))*2 + 1, 2);
    s2:=copy(dx, strtoint(copy(xs,2,1))*2 + 1, 2) ;
    if (s1='零')and (s2='零') then
       jg := jg +'整' ;
    if (s1<>'零')and (s2<>'零') then
       jg := jg +s1+'角'+s2+'分' ;
    if (s1<>'零')and (s2='零') then
       jg := jg +s1+'角'+'整' ;
    if (s1='零')and (s2<>'零') then
       jg := jg +s1+s2+'分' ;
  End;
  DXZH:=jg;
End;
///////////时间转换//////////////////////
Function my_strtoyear(yy :tdatetime):String;       //时间转转换
var
   DX,dn,y:string;
   n,nn:integer;
begin
  DX:='零壹贰叁肆伍陆柒捌玖';
  Y:=formatdatetime('yyyy',yy);
  nn:=Length(Y)  ;
  For n := 1 To nn do begin
     dn:=dn+copy(DX, strtoint(copy(Y,n,1))*2+1, 2);
  end;
   result:=dn;
end;


Function my_strtomonth(yy:tdatetime):String;      //时间转转换
var
   DX1,dy,yf:string;
   n1,nn1,x:integer;
begin
  DX1:='零壹贰叁肆伍陆柒捌玖';
  yf:=formatdatetime('m',yy);
  nn1:=Length(Yf)  ;
  For n1 := 1 To nn1 do begin
     dy:=dy+copy(dx1, strtoint(copy(yf,n1,1))*2+1, 2);
  end;
  if length(dy)=2 then
       dy:=dy
  else
      dy:=copy(dy,1, 2)+'拾'+copy(dy,3, 2) ;
  if strtoint(yf)<10 then
      dy:='零'+copy(dy,1, 2)  ;
  x:=AnsiPos('零',dy);
  If x>4 then
    dy:='零'+copy(dy,1, 4)  ;
   result:=dy;
end;

Function my_strtodday(yy:tdatetime):String;     //时间转转换
var
   DX2,dr,df:string;
   r,rr,z:integer;
begin
  DX2:='零壹贰叁肆伍陆柒捌玖';
  df:=formatdatetime('d',yy);
  rr:=Length(df)  ;
  For r := 1 To rr do begin
     dr:=dr+copy(DX2, strtoint(copy(df,r,1))*2+1, 2);
  end;
  if length(dr)=2 then
     dr:='零'+dr
  else
     dr:=copy(dr,1, 2)+'拾'+copy(dr,3, 2) ;
  z:=AnsiPos('零',dr);
  If z>4 then
    dr:='零'+copy(dr,1, 4);
  result:=dr;
end;



function GetDefPrinter:string ;
var
 pDevice , pDriver ,pPort   :  pChar;
 hDMode : THandle;
begin

   GetMem(pDevice,cchDeviceName);
   GetMem(pDriver,MAX_PATH);
   GetMem(pPort,MAX_PATH);
   Printer.GetPrinter(pDevice,pDriver,pPort,hDMode);
   if lStrLen(pDriver) = 0 then begin
             GetProfileString('Devices',pDevice,'',pDriver,MAX_PATH);
       pDriver[pos(',',pDriver) - 1] := #0;
   end;
   if lStrLen(pPort) = 0 then begin
       GetProfileString('Devices',pDevice,'',pPort,MAX_PATH);
       lStrCpy(pPort,@pPort[lStrLen(pPort) + 2]);
   end;
   result:=string(pdevice);
   FreeMem(pDevice,cchDeviceName);
   FreeMem(pDriver,MAX_PATH);
   FreeMem(pPort,MAX_PATH);


end;

procedure SetDefPrinter(lPrinterIndex:Integer);
 var
  MyHandle  : THandle; 
  MyDevice, 
  MyDriver, 
  MyPort: array [0..255] of Char; 
begin 
  { set printer to the selected according to the
    combobox itemendex } 
  Printer.PrinterIndex := lPrinterIndex;

  { get our printer properties } 
  Printer.GetPrinter(MyDevice, 
                     MyDriver, 
                     MyPort, 
                     MyHandle); 

  { create string of exactly what WriteProfileString() 
    wants to see by concat each of the above received 
    character arrays } 
  StrCat( MyDevice, ',');
  StrCat( MyDevice, MyDriver ); 
  StrCat( MyDevice, ','); 
  StrCat( MyDevice, MyPort ); 

  { copy our new default printer into our windows ini file 
    to the [WINDOWS] section under DEVICE= } 
  WriteProfileString('WINDOWS', 
                     'DEVICE', 
                     MyDevice ); 

  { tell all applications that the windows ini file has 
    changed, this will cause them all to recheck default 
    printer } 
  SendMessage(HWND_BROADCAST, 
              WM_WININICHANGE, 
              0, 
              LongInt(pChar('windows')));

 end;
 procedure splitPrint(s:String;len,len2,x,y,x2:Integer ) ;
 var
   str:string;
   slen,slen2,slen3, i,rows,vlen,vx:integer;
 begin
      str:=s;
      slen:=length(str);
      slen2:=length(LeftStr(str,len)); //第一行长度；
      slen3:=Length(LeftStr(str,len2));  //第二行长度
      if slen>slen2 then begin
         rows:= (slen-slen2) div slen3+1;
         if (slen-slen2) mod slen3>0 then rows:=rows+1;
         with Printer.Canvas do begin
           for i :=0 to rows-1 do begin
             if i=0 then begin
               vx:=x;vlen:=len;
             end else begin
               vx:=x2;vlen:=len2;
             end;
             TextOut(GetPX(vx),GetPy(y)+TextHeight(str)*i+1,LeftStr(str,vlen));
             str:= AnsiReplaceStr(str,LeftStr(Str,vlen),'');
           end;
         end;
       end else
           Printer.Canvas.TextOut(GetPX(x),GetPy(y),str);
  end;

  function GetPX(X:Double):Integer ;
  begin
   RESULT:= PrinterPos(X,'X');
  END;
  function GetPY(Y:Double):Integer ;