⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmmain.~pas

📁 地税局发票程序源代码,自己开发的一个程序,最近整理资料的时候看到,放在那也是放着,拿出来供大家
💻 ~PAS
📖 第 1 页 / 共 2 页
字号:
unit FrmMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ImgList, Menus, ComCtrls, Buttons, ToolWin, ExtCtrls, Grids,
  BaseGrid, AdvGrid, StdCtrls, DBGridEh, DB, asgprev, WinSkinData;

type
  TCustomCell = record
    aRow: integer;
    aCol: Integer;
  end;
  TMain = class(TForm)
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    SpeedButton10: TSpeedButton;
    ToolButton2: TToolButton;
    SpeedButton4: TSpeedButton;
    SpeedButton15: TSpeedButton;
    SpeedButton20: TSpeedButton;
    SpeedButton6: TSpeedButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    SpeedButton11: TSpeedButton;
    MainMenu1: TMainMenu;
    F1: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    T1: TMenuItem;
    N11: TMenuItem;
    H1: TMenuItem;
    N30: TMenuItem;
    N31: TMenuItem;
    N33: TMenuItem;
    N32: TMenuItem;
    Timer1: TTimer;
    Bevel1: TBevel;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    Edit2: TEdit;
    Label3: TLabel;
    DateTimePicker1: TDateTimePicker;
    SpeedButton1: TSpeedButton;
    DataSource1: TDataSource;
    AdvPreviewDialog1: TAdvPreviewDialog;
    InVoiceTable: TAdvStringGrid;
    GroupBox1: TGroupBox;
    Label4: TLabel;
    DBGridEh1: TDBGridEh;
    Edit3: TEdit;
    BitBtn1: TBitBtn;
    Button1: TButton;
    SkinData1: TSkinData;
    procedure FormShow(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure InVoiceTableDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure InVoiceTableCanEditCell(Sender: TObject; ARow, ACol: Integer;
      var CanEdit: Boolean);
    procedure InVoiceTableGetEditorType(Sender: TObject; ACol,
      ARow: Integer; var AEditor: TEditorType);
    procedure InVoiceTableKeyPress(Sender: TObject; var Key: Char);
    procedure InVoiceTableClickCell(Sender: TObject; ARow, ACol: Integer);
    procedure SpeedButton15Click(Sender: TObject);
    procedure SpeedButton20Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure SpeedButton1Click(Sender: TObject);
    procedure DBGridEh1DblClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
    procedure SpeedButton10Click(Sender: TObject);
    procedure SpeedButton11Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure N32Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
  private
    procedure DrawFP01;
    function SaveFP01:Boolean;  
    function UpdateFP:Boolean;
    procedure QueryTabel(aSql:string);
    procedure AutoComputer(DxCell, HjCell, BeginCell: TCustomCell; aIndex:Integer);
  public
    PubACol,PubARow:Integer;
    WorksFlags:Integer;      //新建保存修改
    ModeFlags: Boolean;
    { Public declarations }
  end;

var
  Main: TMain;
  PubRect: TRect; //AdvGrid Rect
  PubCanvas: TCanvas; //AdvGrid Canvas
implementation

uses
  FrmLogin, FrmCustom, FrmData, FrmPrint, FrmAdmin, FrmPkGl;

{$R *.dfm}

procedure TMain.DrawFP01;
var
  j, i: integer;
  aTmp: string;
begin
  InVoiceTable.Clear;
  with InVoiceTable do
  begin
    RowCount := 11;
    RowHeights[0] := 17;
    RowHeights[1] := 17;
    GridLineColor := 8684164;
    WordWrap := False;
    MergeCells(0, 0, 2, 3);
    MergeCells(2, 0, 4, 1);
    MergeCells(2, 1, 2, 1);
    MergeCells(2, 2, 2, 1);
    ColWidths[3] := 20;
    MergeCells(4, 1, 1, 1);
    ColWidths[4] := 64;
    MergeCells(5, 1, 1, 2);
    MergeCells(6, 0, 1, 3);
    MergeCells(7, 0, 1, 3);
    ColWidths[7] := 45;
    MergeCells(8, 0, 1, 3);
    ColWidths[8] := 45;
    MergeCells(9, 0, 4, 1);
    MergeCells(9, 1, 4, 2);
    Cells[0, 0] := '租 赁 项 目';
    Cells[2, 0] := '租  赁  日  期';
    Cells[2, 1] := '起';
    Cells[2, 2] := '年 月 日';
    Cells[4, 1] := '止';
    Cells[4, 2] := '年 月 日';
    Cells[5, 1] := '天 数';
    Cells[6, 0] := '单 位';
    Cells[7, 0] := '数 量';
    Cells[8, 0] := #13'收费'#13'标准';
    Cells[9, 0] := '金      额';
    //******************************
    RowHeights[3] := 26;
    MergeCells(0, 3, 2, 1);
    MergeCells(2, 3, 2, 1);
    MergeCells(4, 3, 1, 1);
    MergeCells(5, 3, 1, 1);
    MergeCells(6, 3, 1, 1);
    MergeCells(7, 3, 1, 1);
    MergeCells(8, 3, 1, 1);
    MergeCells(9, 3, 4, 1);
    //******************************
    RowHeights[4] := 26;
    MergeCells(0, 4, 2, 1);
    MergeCells(2, 4, 2, 1);
    MergeCells(4, 4, 1, 1);
    MergeCells(5, 4, 1, 1);
    MergeCells(6, 4, 1, 1);
    MergeCells(7, 4, 1, 1);
    MergeCells(8, 4, 1, 1);
    MergeCells(9, 4, 4, 1);
    //******************************
    RowHeights[5] := 26;
    MergeCells(0, 5, 2, 1);
    MergeCells(2, 5, 2, 1);
    MergeCells(4, 5, 1, 1);
    MergeCells(5, 5, 1, 1);
    MergeCells(6, 5, 1, 1);
    MergeCells(7, 5, 1, 1);
    MergeCells(8, 5, 1, 1);
    MergeCells(9, 5, 4, 1);
    //******************************
    RowHeights[6] := 26;
    MergeCells(0, 6, 2, 1);
    MergeCells(2, 6, 7, 1);
    MergeCells(9, 6, 4, 1);
    Cells[0, 6] := '金额合计(大写)';
    //******************************
    MergeCells(0, 7, 2, 2);
    MergeCells(2, 7, 11, 2);
    Cells[0, 7] := '备    注';
    Alignments[0, 7] := taCenter;
    //******************************
    MergeCells(0, 9, 4, 1);
    MergeCells(4, 9, 2, 1);
    MergeCells(6, 9, 2, 1);
    MergeCells(8, 9, 2, 1);
    MergeCells(10, 9, 3, 1);
    Cells[0, 9] := '出租方(盖章有效)';
    Cells[4, 9] := '开票人:';
    Cells[8, 9] := '收款人:';
    Alignments[0, 9] := taCenter;
    Alignments[4, 9] := taRightJustify;
    Alignments[8, 9] := taRightJustify;
    MergeCells(0, 10, 13, 1);
//    RowColor[0] := 16761798;
//    RowColor[1] := 16761798;
//    RowColor[2] := 16761798;
//    RowColor[3] := 15204327;
//    RowColor[4] := 15204327;
//    RowColor[5] := 15204327;
//    RowColor[6] := 15204327;
//    RowColor[7] := 15204327;
//    RowColor[9] := 16761798;
//    //Colors[9,2]:=4227327;
//    Colors[0, 6] := 16761798;
//    Colors[0, 7] := 16761798;
//    Colors[6, 2] := 15204327;
//    Colors[9, 6] := 16761798;
//    Colors[2, 6] := 13041663;
//    Colors[10, 9] := 15204327;
//    Colors[6, 9] := 15204327;
//    Colors[9, 1] := 13041663;
    //**************************
    for i := 0 to 12 do
      for j := 0 to 6 do
      begin
        Alignments[i, j] := taCenter;
      end;
    VAlignment := vtaCenter;
  end;
end;

procedure TMain.FormShow(Sender: TObject);
begin
  WorksFlags:=1;
  ModeFlags:=True;
  DrawFP01;
end;

procedure TMain.SpeedButton4Click(Sender: TObject);
begin
  WorksFlags:=1;
  ModeFlags:=True;
  Edit1.Clear;
  Edit2.Clear;
  SpeedButton15.Enabled:=True;
  SpeedButton20.Enabled:=False;  
  Edit1.ReadOnly:=False;
  Edit2.ReadOnly:=False;  
  DrawFP01;
end;

procedure TMain.InVoiceTableDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  DrawMoney, DrawOne: string;
  i, CurrentIndex, MoneyDiv: Integer;
  MoneyWidth, MoneyLeft, MoneyTop, aLineTop: Integer;
  DrawMoneyCp: string;
begin
  PubRect := InVoiceTable.ClientRect; ;
  PubCanvas := InVoiceTable.Canvas;
  if (ARow = 1) and (ACol = 9) then
  begin
    with InVoiceTable do
    begin
      MoneyDiv := Length(MoneyCaStr) div 2;
      for i := 1 to MoneyDiv do
      begin
        CurrentIndex := (MoneyDiv - i + 1);
        DrawMoneyCp := Copy(MoneyCaStr, CurrentIndex * 2 - 1, 2);
        MoneyWidth := Canvas.TextWidth('4') + 8;
        if I = 3 then
          Canvas.Pen.Color := 3637448
        else
          Canvas.Pen.Color := 8684164;
        aLineTop := Rect.Right - (MoneyWidth * i) + 12;
        MoneyLeft := aLineTop - (MoneyWidth);
        MoneyTop := Rect.Top + (Rect.Bottom - Rect.Top - MoneyWidth) div 2;
        Canvas.TextOut(MoneyLeft, MoneyTop, DrawMoneyCp);
        if i <> 1 then
        begin
          Canvas.MoveTo(aLineTop - 2, Rect.Top);
          Canvas.LineTo(aLineTop - 2, Rect.Bottom);
        end;
      end;
    end;
  end;
  if (ACol >= 9) and ((ARow >= 3) and (ARow <= 7)) then
  begin
    with InVoiceTable do
    begin
      DrawMoney := InVoiceTable.Cells[ACol, ARow];
      if DrawMoney <> '' then
        DrawMoney := FormatFloat('0.00', StrToFloat(DrawMoney));
      DrawMoney := StringReplace(DrawMoney, '.', '', []);
      Canvas.FillRect(Rect);
      for i := 1 to 12 do
      begin
        case i of
          3:
            Canvas.Pen.Color := clGreen;
          1, 5, 9:
            Canvas.Pen.Color := clGreen;
        else
          Canvas.Pen.Color := 8684164;
        end;
        MoneyWidth := Canvas.TextWidth('4') + 8;
        if i > Length(DrawMoney) then
          DrawOne := ''
        else
          DrawOne := Copy(DrawMoney, Length(DrawMoney) - i + 1, 1);
        if I = 3 then
          Canvas.Pen.Color := 3637448
        else
          Canvas.Pen.Color := 8684164;
        aLineTop := Rect.Right - MoneyWidth * (i - 1);
        MoneyLeft := aLineTop - MoneyWidth + 6;
        MoneyTop := Rect.Top + (Rect.Bottom - Rect.Top - MoneyWidth) div 2;
        Canvas.TextOut(MoneyLeft - 5, MoneyTop, DrawOne);
        if i <> 1 then
        begin
          Canvas.MoveTo(aLineTop - 4, Rect.Top);
          Canvas.LineTo(aLineTop - 4, Rect.Bottom);
        end;
      end;
    end;
  end;
end;
procedure TMain.InVoiceTableCanEditCell(Sender: TObject; ARow,
  ACol: Integer; var CanEdit: Boolean);
begin
  if ModeFlags then
    CanEdit:=True
  else
    CanEdit:=False;
  if (ARow <= 2) and (ACol <= 12) then
  begin
    CanEdit := False;
  end;
  if (ARow = 6) then
    CanEdit := False;
  if (ARow = 7) and (ACol = 0) then
    CanEdit := False;
  if (ARow = 9) and ((ACol = 0) or (ACol = 4) or (ACol = 8)) then
    CanEdit := False;
  if (ARow = 10) then
    CanEdit := False;
end;

procedure TMain.InVoiceTableGetEditorType(Sender: TObject; ACol,
  ARow: Integer; var AEditor: TEditorType);
begin
  if ((ACol = 5) or (ACol = 7) or (ACol = 8)) and ((ARow >= 3) or (ARow <= 6)) then
    AEditor := edNumeric;
  if ((ACol=2) or (ACol=4)) and ((ARow >=3) and (ARow <=5)) then
    AEditor:=edDateEdit;
end;

procedure TMain.AutoComputer(DxCell, HjCell, BeginCell: TCustomCell; aIndex:
Integer);
//自动计算金额
var
  i: Integer;
  aSum: Double;
begin
  for i := BeginCell.aRow to (BeginCell.aRow + aIndex - 1) do
  begin
    if InVoiceTable.Cells[9, i] <> '' then
      aSum := aSum + StrToFloat(InVoiceTable.Cells[9, i]);
  end;
  InVoiceTable.Cells[DxCell.aCol, DxCell.aRow] := NtoC(aSum);
  InVoiceTable.Cells[HjCell.aCol, HjCell.aRow] := FloatToStr(aSum);
end;

procedure TMain.InVoiceTableKeyPress(Sender: TObject; var Key: Char);
var
  aStr: string;
  aPos: Integer;
  aDxCell, aHjCell, aBeginCell: TCustomCell;
begin
    if (PubACol >= 9) and ((PubARow >= 3) and (PubARow <= 5)) then
    begin
      aPos := Pos('.', InVoiceTable.Cells[PubACol, PubARow]);
      if aPos > 0 then
        if not (Key in ['0'..'9', #9, #13]) then Key := #0
        else
          if not (Key in ['0'..'9', #9, #13, '.']) then Key := #0;
    end;
    if (Key = #13) then
    begin
      if (PubACol >= 9) and ((PubARow >= 3) and (PubARow <= 5)) then
      begin
        aDxCell.aRow := 6;
        aDxCell.aCol := 2;
        aHjCell.aRow := 6;
        aHjCell.aCol := 9;
        aBeginCell.aRow := 3;
        aBeginCell.aCol := 9;
        AutoComputer(aDxCell, aHjCell, aBeginCell, 3);
      end;
      SendMessage(InVoiceTable.Handle, VK_RIGHT, VK_TAB, 0);
    end;
end;

procedure TMain.InVoiceTableClickCell(Sender: TObject; ARow,
  ACol: Integer);
begin
  PubACol:=ACol;
  PubARow:=ARow;
//  Main.Caption:='ACol='+IntToStr(ACol)+' ARow='+IntToStr(ARow);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -