//收费系统的发票打印单元
unit UsgSf;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Grids, Math, StdCtrls, Dialogs, Printers, UmyInputQuery;
const
Maxje = 99999.99;
Su = '零壹贰叁肆伍陆柒捌玖';
PageWidth = 18.2;
PageHeight = 9.35;
C_PrintTitle = '财政收费 单据 %d 号';
type
TSfPage = packed record
TopMargin: Real;
end;
TSf = packed record
xmbh: Integer;
xmmc: String[100];
jsdw: String[20];
sfbz: Currency;
sl: Real;
je: Currency;
bm: String[50];
lb: String[50];
xm: String[50];
end;
TSfs = array of TSf;
TDjSf = packed record
SfDj: array[1..3] of TSf;
je: Real;
end;
TDjsfs = array of TDjsf;
TCzDj = packed record
SfDJ: array[1..3] of TSf;
jkr: String[50];
dz: String[50];
sj: TDateTime;
pz: String[50];
kpr: String[12];
skr: String[12];
djh: Integer;
je: Real;
end;
TSgsf = class(TCustomDrawGrid)
private
FPPX: Integer;
FPPY: Integer;
FSFS: TDjsfs;
FDjCount: Integer;
FSfGridWidth: Integer;
FDoSubmit: TNotifyEvent;
FClipSF: TSF;
FCanEdit: Boolean;
procedure SetDjCount(const Value: Integer);
function CmToPixelY(cm: Real): Integer;
function CmToPixelX(cm: Real): Integer;
procedure DrawHJ(ARow: Integer);
procedure DrawXmmc(ARow: Integer);
procedure DrawJsdw(ARow: Integer);
procedure DrawSfbz(ARow: Integer);
procedure ReCalJe(xl: Integer);
procedure ReCalSfJe(xl, xg: Integer);
procedure DrawSl(ARow: Integer);
procedure DrawJe(ARow: Integer);
procedure WMLButtonDown(var Message: TMessage);
message WM_LBUTTONDOWN;
procedure WMChar(var Msg: TWMChar);
message WM_CHAR;
procedure WMKeyDown(var Message: TMessage);
message WM_KEYDOWN;
protected
function SgCellRect(ACol, ARow: Longint): TRect;
procedure DrawCell(ACol, ARow: Longint;
ARect: TRect;
AState: TGridDrawState);
override;
function SelectCell(ACol, ARow: Longint): Boolean;
override;
procedure SetEditText(ACol, ARow: Longint;
const Value: string);
override;
function GetEditText(ACol, ARow: Longint): string;
override;
property ColWidths;
property RowHeights;
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
procedure ChangeSF(xmmc,jsdw: String;
xmbh: Integer;
sfbz: Currency;
bm, lb, xm: String);
procedure ClearSFS;
procedure CopyCSF;
procedure ClearCSF;
procedure CutCSF;
procedure PastCSF;
function ValidateDJ: Integer;
function ValidateSf: Integer;
function SumJe: Currency;
procedure SetSl(ARow:Integer;
SL: Real);
procedure CalCurrXl(dj: Integer);
procedure ModifyBz;
procedure SetSfbz(Value: Currency);
published
property Align;
property PopupMenu;
property DjCount: Integer read FDjCount write SetDjCount;
property SFS: TDjsfs read FSFS;
propertydo
Submit: TNotifyEvent read FDoSubmit write FDoSubmit;
property CanEdit: boolean read FCanEdit write FCanEdit;
property OnKeyPress;
end;
procedure MyRectangle(DC: HDC;
Rect: TRect);
procedure SgDrawCenterText(Canvas: TCanvas;
Rect: TRect;
Text: PChar);
overload;
procedure SgDrawCenterText(DC: HDC;
Rect: TRect;
Text: PChar);
overload;
procedure SGDrawCenterText(DC: HDC;
Rect: TRect;
Text: String);
overload;
procedure SgSetPrinter;
procedure SgOutPage;
procedure SgPrintDJ(CzDj: TCzDJ;
SfPage: TSfPage);
procedure SgPrintDjSf(CzDj: TCzDj;
Canvas: TCanvas;
SfPage: TSfPage);
procedure SgPrintSf(DC: HDC;
aSf: TSF;
T, L: Real;
PPIX, PPIY: Integer);
function IsSfValidate(SF: TSF): Boolean;
function CmToPixelX(cm: Real;
PPIX: Integer):Integer;
function CmToPixelY(Cm: Real;
PPIY: Integer):Integer;
function CmRect(L, T, W, H: Real;
PPIX, PPIY: Integer): TRect;
procedure Register;
implementation
{common procedure}
procedure SgSetPrinter;
var
ADevice : PChar;
ADriver : PChar;
APort : PChar;
DeviceMode : THandle;
DevMode : PDeviceMode;
PPIX, PPIY: Integer;
DC: HDC;
ARect: TRect;
function Supported(Setting : integer) : boolean;
begin
Supported := (DevMode^.dmFields and Setting) = Setting
end;
procedure SetField(aField : integer);
begin
DevMode^.dmFields := DevMode^.dmFields or aField;
end;
begin
GetMem(ADevice, 128);
GetMem(ADriver, 128);
GetMem(APort, 128);
DC := Printer.Handle;
PPIX := GetDeviceCaps(DC,LogPixelsX);
PPIY := GetDeviceCaps(DC,LogPixelsY);
Printer.GetPrinter(ADevice, ADriver, APort, DeviceMode);
DevMode := GlobalLock(DeviceMode);
// if PaperSize = Custom then
// begin
// SetField(dm_PaperSize);
// DevMode^.dmPaperSize := DMPAPER_A3;
SetField(dm_paperlength);
DevMode^.dmPaperLength := Round(PageHeight * 100);
SetField(dm_paperwidth);
DevMode^.dmPaperWidth := Round(PageWidth * 100);
// end;
// if FDuplex then
// begin
// SetField(dm_duplex);
// DevMode^.dmDuplex := dmdup_horizontal;
// end;
// if Supported(dm_PaperSize) and (PaperSize <> Default) then
// begin
// SetField(dm_papersize);
// DevMode^.dmPaperSize := cQRPaperTranslate[PaperSize];
// end;
SetField(dm_copies);
DevMode^.dmCopies := 1;
//FCopies;
SetField(dm_defaultsource);
DevMode^.dmDefaultSource := (DevMode^.dmDefaultSource and 256);// or cQRBinTranslate[OutputBin];
SetField(dm_orientation);
// if Orientation=poPortrait then
DevMode^.dmOrientation := dmorient_portrait;
// else
// DevMode^.dmOrientation := dmorient_landscape;
Printer.SetPrinter(ADevice, ADriver, APort, DeviceMode);
GlobalUnlock(DeviceMode);
with Printer.Canvasdo
begin
Font.Name := '宋体';
Font.Size := 10;
end;
end;
procedure SgOutPage;
begin
Printer.begin
Doc;
Printer.NewPage;
Printer.EndDoc;
end;
procedure SgPrintDJ(CzDj: TCzDJ;
SfPage: TSfPage);
begin
Printer.begin
Doc;
Printer.Title := format(C_PrintTitle,[CzDJ.Djh]);
SgPrintDjsf(CzDj,Printer.Canvas, SfPage);
Printer.EndDoc;
end;
function CmRect(L, T, W, H: Real;
PPIX, PPIY: Integer): TRect;
var
mL, mT, mW, mH: Integer;
begin
mL := CmToPixelX(L,PPIX);
mT := CmToPixelY(T,PPIY);
mW := mL + CmToPixelX(W,PPIX);
mH := mT + CmToPixelY(H,PPIY);
Result := Rect(mL, mT, mW, mH);
end;
function CmToPixelX(cm: Real;
PPIX: Integer):Integer;
begin
Result := Trunc((cm * PPIX) / 2.54);
end;
function CmToPixelY(Cm: Real;
PPIY: Integer):Integer;
begin
Result := Trunc((cm * PPIY) / 2.54);
end;
procedure SgPrintSf(DC: HDC;
aSf: TSF;
T, L: Real;
PPIX, PPIY: Integer);
var
ARect: TRect;
myText, NText: String;
I, Len, mL: Integer;
begin
T := T + 1;
ARect := CmRect(L, T, 5.7, 0.8, PPIX, PPIY);
myText := aSF.xmmc;
SgDrawCenterText(DC,ARect,myText);
L := L + 5.7;
ARect := CmRect(L, T, 2, 0.8, PPIX, PPIY);
myText := aSF.jsdw;
SgDrawCenterText(DC,ARect,PChar(myText));
L := L + 2;
ARect := CmRect(L, T, 2, 0.8, PPIX, PPIY);
myText := format('%f',[aSF.sfbz]);
SgDrawCenterText(DC,ARect,PChar(myText));
L := L + 2;
ARect := CmRect(L, T, 2, 0.8, PPIX, PPIY);
myText := format('%f',[aSf.sl]);
SgDrawCenterText(DC,ARect,PChar(myText));
L := L + 2;
ARect := CmRect(L, T, 2.8, 0.8, PPIX, PPIY);
myText := format('%.0f',[aSF.je*100]);
Len := Length(myText);
mL := CmToPixelX(L + 2.8, PPIX);
for I := Lendo
wnto 1do
begin
NText := format('%s',[myText]);
ARect.Right := mL;
mL := mL - CmToPixelX(0.4, PPIY);
ARect.Left := mL;
SgDrawCenterText(Dc,ARect,PChar(NText));
end;
end;
procedure SgPrintDjSf(CzDj: TCzDj;
Canvas: TCanvas;
SfPage: TSfPage);
var
DC: HDC;
myText: PChar;
sText: String;
PPIX, PPIY, I, mL, mW: Integer;
T, L, W, H: Real;
ARect: TRect;
y, m, d: Word;
begin
DC := Canvas.Handle;
PPIX := GetDeviceCaps(DC,LogPixelsX);
PPIY := GetDeviceCaps(DC,LogPixelsY);
//
ARect := CmRect(0.1, 0.1, 18.1, 9.2, PPIX, PPIY);
Canvas.Pen.Color := clBlack;
// MyRectangle(Dc,ARect);
//以上打印出一个矩形，用来确定收据的位置
//
//单据号
T := 1.4-SfPage.TopMargin;
L := 12.0;
W := 2.5;
H := 0.4;
myText := PChar(format('电脑编号: %d',[CzDj.djh]));
ARect := CmRect(L,T,W,H,PPIX,PPIY);
SgDrawCenterText(DC,ARect,MyText);
//时间
DecodeDate(CzDj.sj,y,m,d);
T := 1.9-SfPage.TopMargin;
L := 12.8;
W := 0.8;
H := 0.4;
myText := PChar(format('%d',[y]));
ARect := CmRect(L,T,W,H,PPIX,PPIY);
SgDrawCenterText(DC,ARect,MyText);
L := L + 0.8 + 0.4;
myText := PChar(format('%d',[m]));
ARect := CmRect(L,T,W,H,PPIX,PPIY);
SgDrawCenterText(DC,ARect,MyText);
L := L + 0.8 + 0.4;
myText := PChar(format('%d',[d]));
ARect := CmRect(L,T,W,H,PPIX,PPIY);
SgDrawCenterText(DC,ARect,MyText);
//缴款单位
T := 1.9-SfPage.TopMargin;
L := 4.0;
W := 3.4;
H := 0.4;
myText := PChar(String(CzDj.jkr));
ARect := CmRect(L,T,W,H,PPIX,PPIY);
ARect.Right := ARect.Left + Canvas.TextWidth(String(CzDj.jkr));
SgDrawCenterText(DC,AREct,MyText);
//地址
T := 1.9-SfPage.TopMargin;
L := 8.3;
W := 4.0;
H := 0.4;
myText := PChar(String(CzDj.dz));
ARect := CmRect(L,T,W,H,PPIX,PPIY);
ARect.Right := ARect.Left + Canvas.TextWidth(String(CzDj.dz));
SgDrawCenterText(DC,AREct,MyText);
//收费项目
T := 2.4-SfPage.TopMargin;
L := 1.7;
for I := 1 to 3do
begin
if IsSfValidate(CzDj.SfDj) then
begin
SgPrintSf(DC,CzDj.SfDj,T,L,PPIX,PPIY);
T := 2.4 + 0.8-SfPage.TopMargin;
end;
end;
//大写金额
sText := format('%7.0f',[CzDj.je * 100]);
for I := 1 to 7do
begin
if sText = ' ' then
begin
sText := '0';
end;
end;
mW := Canvas.TextWidth('万');
ARect.Left := CmToPixelX(5.3 - 0.8, PPIX);
ARect.Top := CmToPixelY(6.2-SfPage.TopMargin, PPIY);
ARect.Bottom := ARect.Top + Canvas.TextHeight('万');
for I := 1 to 7do
begin
ARect.Right := ARect.Left + CmToPixelX(0.8,PPIX);
SGDrawCenterText(DC,ARect,Copy(Su,(Ord(sText)-Ord('0'))*2+1,2));
ARect.Left := ARect.Left + mW + CmToPixelX(0.8,PPIX);
end;
//小写金额
myText := PChar(format('%.2f',[CzDj.je]));
ARect.Left := CmToPixelX(13.0, PPIX);
ARect.Top := CmToPixelY(6.2-SfPage.TopMargin, PPIY);
ARect.Bottom := ARect.Top + Canvas.TextHeight('万');
ARect.Right := ARect.Left + Canvas.TextWidth(format('%.2f',[CzDj.je]));
SgDrawCenterText(DC,ARect,myText);
L := 13.0;
T := 6.2-SfPage.TopMargin;
//备注
T := 7-SfPage.TopMargin;
L := 4;
W := 12.0;
H := 0.4;
myText := PChar(String(CzDj.pz));
ARect := CmRect(L,T,W,H,PPIX,PPIY);
SgDrawCenterText(DC,AREct,MyText);
//开票人
T := 8-SfPage.TopMargin;
L := 9;
W := 2.5;
H := 0.4;
myText := PChar(String(CzDj.kpr));
ARect := CmRect(L,T,W,H,PPIX,PPIY);
SgDrawCenterText(DC,AREct,MyText);
//收款人
T := 8-SfPage.TopMargin;
L := 13.0;
W := 2.5;
H := 0.4;
myText := PChar(String(CzDj.skr));
ARect := CmRect(L,T,W,H,PPIX,PPIY);
SgDrawCenterText(DC,AREct,MyText);
end;
function IsSfValidate(SF: TSF): Boolean;
begin
Result := (SF.xmmc <> '') and
(SF.jsdw <> '') and
(SF.sfbz > 0) and
(SF.sl > 0) and
(SF.je > 0);
end;
procedure MyRectangle(DC: HDC;
Rect: TRect);
begin
Rectangle(DC,Rect.Left,Rect.Top,Rect.Right,Rect.Bottom);
end;
procedure SgDrawCenterText(DC: HDC;
Rect: TRect;
Text: PChar);
var
aRect, vRect: TRect;
h, w: Integer;
myRgn: HRgn;
begin
aRect := Rect;
vRect := Rect;
DrawText(DC,Text,StrLen(Text),vRect,DT_CALCRECT);
h := vRect.Bottom - vRect.Top;
w := vRect.Right - vRect.Left;
aRect.Top := aRect.Top + ((Rect.Bottom - Rect.Top) - h) div 2;
aRect.Left := aRect.Left + ((Rect.Right - Rect.Left) - w) div 2;
aRect.Right := aRect.Left + w;
aRect.Bottom := aRect.Top + h;
DrawText(DC,Text,StrLen(Text),aRect,DT_CENTER + DT_VCENTER);
end;
procedure SgDrawCenterText(Canvas: TCanvas;
Rect: TRect;
Text: PChar);
begin
SgDrawCenterText(Canvas.Handle,Rect,Text);
end;
procedure SgDrawCenterText(DC: HDC;
Rect: TRect;
Text: String);
begin
SgDrawCenterText(DC,Rect,PChar(Text));
end;
procedure Register;
begin
RegisterComponents('Standard', [TSgsf]);
end;
{ TSgsf }
function TSgsf.CmToPixelX(cm: Real): Integer;
begin
Result := Trunc((cm * FPPX) / 2.54);
end;
function TSgsf.CmToPixelY(cm: Real): Integer;
begin
Result := Trunc((cm * FPPY) / 2.54);
end;
constructor TSgsf.Create(AOwner: TComponent);
var
I: Integer;
begin
inherited;
DefaultDrawing := False;
ColCount := 5;
DJCount := 1;
FixedRows := 1;
FixedCols := 0;
SetLength(FSFS,1);
Options := [goFixedVertLine,goFixedHorzLine,goVertLine,goHorzLine,
goEditing,goThumbTracking];
ScrollBars := ssBoth;
BorderStyle := bsNone;
FPPX := Screen.PixelsPerInch;
FPPY := Screen.PixelsPerInch;
DefaultRowHeight := CmToPixelY(0.8);
ColWidths[0] := CmToPixelX(5.7);
ColWidths[4] := CmToPixelX(3.13);
RowHeights[0] := CmToPixelY(1.0);
Canvas.Font.Name := '宋体';
Canvas.Font.Size := 9;
Col := 3;
Row := 1;
RowHeights[4] := CmToPixelY(1.0);
for I := 0 to ColCount - 1do
begin
FSfGridWidth := FSfGridWidth + ColWidths;
end;
Align := alClient;
CanEdit := True;
end;
destructor TSgsf.Destroy;
begin
SetLength(FSFS,0);
inherited;
end;
procedure TSgsf.DrawCell(ACol, ARow: Integer;
ARect: TRect;
AState: TGridDrawState);
var
MyText: PChar;
mR: TRect;
I: Integer;
begin
mR := ARect;
with Canvasdo
begin
Pen.Color := clWindow;
Brush.Style := bsSolid;
Brush.Color := clWindow;
MyRectangle(Canvas.Handle,mR);
end;
mR := ARect;
if ARow = 0 then
begin
case ACol of
0: begin
myText := '收 费 项 目';
end;
1: begin
myText := '单 位';
end;
2: begin
myText := '标 准 '#13'(单价)';
end;
3 : begin
myText := '数 量';
end;
else
begin
myText := '';
end;
end;
Canvas.Font.Color := clBlack;
SgDrawCenterText(Canvas,mR,myText);
if ACol = 4 then
begin
mR.Bottom := mR.Bottom - (mR.Bottom - mR.Top) div 2;
SgDrawCenterText(Canvas,mR,' 金 额 ');
Canvas.MoveTo(mR.Left,mR.Bottom);
Canvas.Pen.Color := clSilver;
LineTo(Canvas.Handle,mR.Right,mR.Bottom);
mR.Top := mR.Bottom;
mR.Bottom := ARect.Bottom;
for I := 1 to 6do
begin
Canvas.Pen.Color := clSilver;
Canvas.MoveTo(mR.Left + I * CmToPixelX(0.45), mR.Top);
Canvas.LineTo(mR.Left + I * CmToPixelX(0.45), mR.Bottom);
end;
// DrawCenterText(Canvas,mR,'万 千 百 十 元 角 分');
myText := '万千百十元角分';
for I := 0 to 6do
begin
//NText := ;
mR.Left := ARect.Left + I * CmToPixelX(0.45)+2;
mR.Right := mR.Left + CmToPixelX(0.4);
Canvas.Font.Color := clBlack;
SgDrawCenterText(Canvas,mR,PChar(Copy(myText,I*2+1,2)));
end;
end;
Canvas.Pen.Color := clSilver;
Canvas.Brush.Style := bsClear;
mR := ARect;
InflateRect(mR,1,1);
MyRectangle(Canvas.Handle,mR);
end else
begin
if (ACol = 4) and (ARow mod 4 <> 0) then
begin
for I := 1 to 6do
begin
Canvas.Pen.Color := clSilver;
Canvas.MoveTo(ARect.Left + I * CmToPixelX(0.45), ARect.Top);
Canvas.LineTo(ARect.Left + I * CmToPixelX(0.45), ARect.Bottom);
end;
end;
if (ARow mod 4 = 0) then
begin
DrawHJ(ARow);
end;
if (ACol = 0) and (ARow mod 4 <> 0) then
begin
DrawXmmc(ARow);
end;
if (ACol = 1) and (ARow mod 4 <> 0) then
begin
DrawJsdw(ARow);
end;
if (ACol = 2) and (ARow mod 4 <> 0) then
begin
DrawSfbz(ARow);
end;
if (ACol = 3) and (ARow mod 4 <> 0) then
begin
DrawSl(ARow);
end;
if (ACol = 4) and (ARow mod 4 <> 0) then
begin
DrawJe(ARow);
end;
end;
end;
procedure TSgsf.DrawHJ(ARow: Integer);
var
vRect: TRect;
I, mL, mW: Integer;
MyText: String;
begin
vRect := SgCellRect(0,ARow);
if vRect.Bottom - vRect.Top <= 0 then
Exit;
vRect.Right := FSfGridWidth;
with Canvasdo
begin
Pen.Color := clWindow;
Brush.Style := bsSolid;
Brush.Color := clWindow;
MyRectangle(Handle,vRect);
vRect.Right := 70;
Pen.Color := clSilver;
MoveTo(vRect.Right,vRect.Top);
LineTo(vRect.Right,vRect.Bottom);
Font.Color := clBlack;
SgDrawCenterText(Handle,vRect,'合计人民币'#13'(大 写)');
vRect.Left := 70;
vRect.Right := FSfGridWidth;
mL := vRect.Left + 50;
mW := Canvas.TextWidth('万');
myText := '万仟佰拾元角分￥';
for I := 1 to 8do
begin
vRect.Left := mL + I * 3* mW;
vRect.Right := vRect.Left + mW;
SgDrawCenterText(Handle,vRect,Copy(myText,(I-1)*2+1,2));
end;
if FSFS[ARow div 4 - 1].je > 0 then
begin
myText := format('%.2f',[FSFS[ARow div 4 - 1].je]);
vRect.Left := vRect.Right - mW + Canvas.TextWidth('￥');
vRect.Right := vRect.Left + Canvas.TextWidth(myText);
SgDrawCenterText(Handle,vRect,myText);
myText := format('%7.0f',[FSFS[ARow div 4 - 1].je * 100]);
for I := 1 to 7do
begin
if myText = ' ' then
begin
myText := '0';
end;
end;
for I := 1 to 7do
begin
vRect.Left := mL + I * 3* mW - Trunc(1.5*mW);
vRect.Right := vRect.Left + mW;
SGDrawCenterText(Handle,vRect,Copy(Su,(Ord(myText)-Ord('0'))*2+1,2));
end;
end;
end;
end;
function TSgsf.GetEditText(ACol, ARow: Integer): string;
begin
if ACol = 3 then
begin
Result := format('%.2f', [FSFS[ARow div 4].SfDj[ARow mod 4].sl]);
end;
end;
function TSgsf.SelectCell(ACol, ARow: Integer): Boolean;
begin
// if not FCanEdit then
begin
// Result := false;
// end else
begin
Result := (ACol = 3) and (ARow mod 4 <> 0);
// end;
end;
procedure TSgsf.SetDjCount(const Value: Integer);
var
I: Integer;
begin
if (Value >= 1) and (FDjCount <> Value) then
begin
FDjCount := Value;
SetLength(FSFS,Value);
RowCount := Value * 4 + 1;
for I := 4 to RowCount - 1do
begin
if I mod 4 = 0 then
begin
RowHeights := CmToPixelY(1.0);
end;
end;
end;
end;
procedure TSgsf.SetEditText(ACol, ARow: Integer;
const Value: string);
begin
inherited;
if ACol = 3 then
begin
if StrToFloatDef(Value,-1) <> -1 then
begin
SetSl(ARow,StrToFloat(Value));
end;
end;
end;
procedure TSgsf.SetSl(ARow: Integer;
SL: Real);
var
xl, xg, I: Integer;
vg, je: Currency;
begin
je := 0;
xl := ARow div 4;
xg := ARow mod 4;
if FSFS[xl].SfDj[xg].xmmc = '' then
begin
Exit;
end;
if FSFS[xl].SfDj[xg].sfbz * SL > MaxJe then
begin
Exit;
end;
if SL <> FSFS[xl].SfDj[xg].sl then
begin
vg := FSFS[xl].SfDj[xg].sl;
for I := 1 to 3do
begin
if I = xg then
begin
je := je + FSFS[xl].SfDj.sfbz * SL
end else
begin
je := je + FSFS[xl].SfDj.sfbz * FSFS[xl].SfDj.SL
end;
end;
if je > MaxJe then
begin
FSFS[xl].SfDj[xg].sl := vg;
Exit;
end;
FSFS[xl].SfDj[xg].sl := SL;
FSFS[xl].SfDj[xg].je := FSFS[xl].SfDj[xg].sfbz * SL;
ReCalJe(xl);
//FSFS[xl].je := je;
DrawCell(4,ARow,SgCellRect(4,ARow),[]);
DrawCell(0,(xl+1)*4,SgCellRect(0,(xl+1)*4),[]);
end;
end;
procedure TSgsf.ChangeSF(xmmc, jsdw: String;
xmbh: Integer;
sfbz: Currency;
bm, lb, xm: String);
var
xl, xg, I: Integer;
ARect: TRect;
begin
xl := (Row div 4);
xg := Row mod 4;
FSFS[xl].SfDj[xg].xmmc := xmmc;
FSFS[xl].SfDj[xg].jsdw := jsdw;
FSFS[xl].SfDj[xg].xmbh := xmbh;
FSFS[xl].SfDj[xg].sfbz := sfbz;
FSFS[xl].SfDj[xg].sl := 0;
FSFS[xl].SfDj[xg].je := 0;
FSFS[xl].SfDj[xg].bm := bm;
FSFS[xl].SfDj[xg].lb := lb;
FSFS[xl].SfDj[xg].xm := xm;
if FSFS[xl].SfDj[xg].xmmc = '' then
begin
FSFS[xl].SfDj[xg].xmbh := 0;
FSFS[xl].SfDj[xg].jsdw := '';
FSFS[xl].SfDj[xg].sfbz := 0;
FSFS[xl].SfDj[xg].sl := 0;
FSFS[xl].SfDj[xg].bm := '';
FSFS[xl].SfDj[xg].lb := '';
FSFS[xl].SfDj[xg].xm := '';
end;
ReCalJe(xl);
for I := 0 to 4do
begin
ARect := SgCellRect(I,Row);
DrawCell(I,Row,ARect,[]);
end;
end;
function TSgsf.SgCellRect(ACol, ARow: Integer): TRect;
begin
Result := CellRect(ACol, ARow);
if ARow mod 4 = 0 then
begin
if Result.Top + Result.Bottom <> 0 then
begin
Result.Bottom := Result.Top + CmToPixelY(1.0);
end;
end else
begin
if Result.Top + Result.Bottom <> 0 then
begin
Result.Bottom := Result.Top + CmToPixelY(0.8);
end;
end;
end;
procedure TSgsf.ReCalJe(xl: Integer);
var
I: Integer;
je: Currency;
begin
je := 0;
for I := 1 to 3do
begin
je := FSFS[xl].SfDj.je + je;
end;
if je <> FSFS[xl].je then
begin
FSFS[xl].je := je;
DrawHj((xl+1)*4);
end;
end;
procedure TSgsf.DrawXmmc(ARow: Integer);
var
myText: String;
begin
myText := FSFS[ARow div 4].SfDj[ARow mod 4].xmmc;
Canvas.Font.Color := clBlack;
SgDrawCenterText(Canvas.Handle,SgCellRect(0,ARow),myText);
end;
procedure TSgsf.DrawJsdw(ARow: Integer);
begin
Canvas.Font.Color := clBlack;
SgDrawCenterText(Canvas.Handle,SgCellRect(1,ARow),FSFS[ARow div 4].SfDj[ARow mod 4].jsdw);
end;
procedure TSgsf.DrawSfbz(ARow: Integer);
begin
Canvas.Font.Color := clBlack;
if FSFS[ARow div 4].SfDj[ARow mod 4].sfbz <> 0 then
SgDrawCenterText(Canvas.Handle,SgCellRect(2,ARow),
FloatToStr(FSFS[ARow div 4].SfDj[ARow mod 4].sfbz));
// format('%f',[FSFS[ARow div 4].SfDj[ARow mod 4].sfbz]));
end;
procedure TSgsf.DrawSl(ARow: Integer);
var
ARect: TRect;
begin
Canvas.Font.Color := clBlack;
ARect := SgCellRect(3,ARow);
if FSFS[ARow div 4].SfDj[ARow mod 4].Sl <> 0 then
begin
SgDrawCenterText(Canvas.Handle,ARect,
format('%.2f',[FSFS[ARow div 4].SfDj[ARow mod 4].sl]));
end;
if (ARow = Row) and FCanEdit then
begin
Canvas.Pen.Color := clBlack;
Canvas.Brush.Style := bsClear;
InflateRect(ARect,-1,-1);
MyRectangle(Canvas.Handle,ARect);
end;
end;
procedure TSgsf.DrawJe(ARow: Integer);
var
I: Integer;
myText: String;
ARect, mR: TRect;
begin
Canvas.Font.Color := clBlack;
Canvas.Brush.Style := bsClear;
if FSFS[ARow div 4].SfDj[ARow mod 4].je <> 0 then
begin
ARect := SgCellRect(4,ARow);
mR := ARect;
for I := 0 to 6do
begin
myText := format('%7.0f',[FSFS[ARow div 4].SfDj[ARow mod 4].je * 100]);
mR.Left := ARect.Left + I * CmToPixelX(0.45)+2;
mR.Right := mR.Left + CmToPixelX(0.4);
Canvas.Font.Color := clBlack;
SgDrawCenterText(Canvas,mR,PChar(Copy(myText,I+1,1)));
end;
end;
end;
procedure TSgsf.WMLButtonDown(var message: TMessage);
var
MC: TGridCoord;
begin
if not FCanEdit then
exit;
inherited;
MC := MouseCoord(LOWORD(message.lParam),HIWORD(message.LParam));
if (MC.X <> -1) and (MC.Y <> -1) then
begin
if MC.Y mod 4 <> 0 then
begin
Row := MC.Y;
Col := 3;
end;
end;
end;
function TSgsf.ValidateDJ: Integer;
var
I, J: Integer;
begin
Result := 0;
for I := Low(FSFS) to High(FSFS)do
begin
for J := 1 to 3do
begin
if (FSFS.SfDj[J].xmmc <> '') and (FSFS.SfDj[J].je > 0) then
begin
Result := Result + 1;
break;
end;
end;
end;
end;
function TSgsf.ValidateSf: Integer;
var
I, J: Integer;
begin
Result := 0;
for I := Low(FSFS) to High(FSFS)do
begin
for J := 1 to 3do
begin
if (FSFS.SfDj[J].xmmc <> '') and (FSFS.SfDj[J].je > 0) then
begin
Result := Result + 1;
end;
end;
end;
end;
function TSgsf.SumJe: Currency;
var
I: Integer;
begin
Result := 0;
for I := Low(FSFS) to High(FSFS)do
begin
Result := FSFS.je + Result;
end;
end;
procedure TSgsf.WMChar(var Msg: TWMChar);
begin
if not FCanEdit then
exit;
if Char(Msg.CharCode) = '*' then
begin
if Assigned(FDoSubmit) then
begin
FDoSubmit(Self);
end;
end else
begin
inherited;
end;
end;
procedure TSgsf.WMKeyDown(var Message: TMessage);
var
mK: Integer;
begin
if not FCanEdit then
exit;
//不要响应按键
mK := Integer(message.WParam);
case mK of
VK_DOWN: begin
if (Row + 1) mod 4 <> 0 then
begin
inherited;
end else
begin
if RowCount - 1 > Row + 2 then
begin
Row := Row + 2;
end;
end;
end;
VK_UP: begin
if (Row - 1) mod 4 <> 0 then
begin
inherited;
end else
begin
if Row - 2 > 0 then
begin
Row := Row - 2;
end;
end;
end;
else
begin
inherited;
end;
end;
end;
procedure TSgsf.ClearCSF;
begin
ChangeSF('','',0,0,'','','');
end;
procedure TSgsf.CopyCSF;
begin
FClipSF := FSFS[Row div 4].SfDj[Row mod 4];
end;
procedure TSgsf.CutCSF;
begin
CopyCSF;
ClearCSF;
end;
procedure TSgsf.PastCSF;
begin
if FCLipSF.xmmc <> '' then
begin
with FClipSFdo
begin
ChangeSF(xmmc,jsdw,xmbh,sfbz,bm,lb,xm);
end;
end;
end;
procedure TSgsf.ClearSFS;
var
ICount: Integer;
begin
ICount := High(FSFS);
SetLength(FSFS,0);
SetLength(FSFS,ICount + 1);
Invalidate;
end;
procedure TSgsf.CalCurrXl(dj: Integer);
begin
ReCalJe(dj);
end;
//修改收费标准----------------------------------------------------------------//
procedure TSgsf.ModifyBz;
var
xl, xg: Integer;
oldStr, Strvalue: String;
Value: Currency;
begin
xl := Row div 4;
xg := Row mod 4;
if FSFS[xl].SfDj[xg].xmmc = '' then
begin
MessageBox(handle,'请指定有效的收费项目！','修改收费标准',mb_IconInformation);
exit;
end;
StrValue := FloatToStr(FSFS[xl].SfDj[xg].sfbz);
//format('%f',[FSFS[xl].SfDj[xg].sfbz]);
oldStr := StrValue;
if myInputquery('修改收费标准','请输入新标准：',StrValue) then
begin
Value := StrToFloatDef(StrValue, 0);
if Value <= 0 then
begin
MessageBox(handle,'无效的收费标准，修改失败！','修改收费标准',mb_IconInformation);
exit;
end else
begin
SetSfbz(Value);
end;
end;
end;
//更新收费标准----------------------------------------------------------------//
procedure TSgsf.SetSfbz(Value: Currency);
var
xl, xg, I: Integer;
je: Currency;
begin
xl := Row div 4;
xg := Row mod 4;
if FSFS[xl].SfDj[xg].sfbz <> Value then
begin
je := 0;
for I := 1 to 3do
begin
if I = xg then
begin
je := je + Value * FSFS[xl].SfDj.SL;
end else
begin
je := je + FSFS[xl].SfDj.sfbz * FSFS[xl].SfDj.SL
end;
end;
if je > MaxJe then
begin
Exit;
end;
FSFs[xl].SfDj[xg].sfbz := Value;
FSFS[xl].SfDj[xg].je := Value * FSFS[xl].SfDj[xg].SL;
ReCalJe(xl);
//DrawSfbz(Row);
Self.DrawCell(2,Row,SgCellRect(2,Row),[]);
DrawCell(4, Row, SgCellRect(4, Row), []);
end;
end;
//更新标准金额----------------------------------------------------------------//
procedure TSgsf.ReCalSfJe(xl, xg: Integer);
begin
FSFS[xl].SfDj[xg].je := FSFS[xl].SfDj[xg].sl * FSFS[xl].Sfdj[xg].sfbz;
end;
end.
