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

📄 main.~pa

📁 家庭财账管理软件.zip 毕业设计 论文加代码
💻 ~PA
字号:
unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Buttons, FileCtrl, ComCtrls, Db, Halcn6DB, Grids,
  AdvGrid, yyTools, ImgList, dxDBGrid, dxCntner, dxTL, htmlhint;


type
  TfrmMain = class(TForm)
    FileListYY: TFileListBox;
    ListBox1: TListBox;
    ListBox2: TListBox;
    tableMain: THalcyonDataSet;
    StatusBar: TStatusBar;
    tableMid: THalcyonDataSet;
    lstQuery: TListBox;
    tableMainID: TStringField;
    tableMainSZTYPE: TStringField;
    tableMainSZSUB: TStringField;
    tableMainSZFS: TStringField;
    tableMainSZDATE: TStringField;
    tableMainSZMEM: TStringField;
    panToolBar: TPanel;
    pageMain: TPageControl;
    tabMain: TTabSheet;
    tabQuery: TTabSheet;
    grid01: TAdvStringGrid;
    gridQuery: TAdvStringGrid;
    tableQuery: THalcyonDataSet;
    ImageList1: TImageList;
    tabExpress: TTabSheet;
    DataSource1: TDataSource;
    tableExpress: THalcyonDataSet;
    tableExpressID: TStringField;
    tableExpressSZTYPE: TStringField;
    tableExpressSZSUB: TStringField;
    tableExpressSZFS: TStringField;
    tableExpressSZDATE: TStringField;
    tableExpressSZMEM: TStringField;
    dxDBGrid1: TdxDBGrid;
    tableMainSZMONEY: TFloatField;
    tableExpressSZMONEY: TFloatField;
    dxDBGrid1SZTYPE: TdxDBGridMaskColumn;
    dxDBGrid1SZSUB: TdxDBGridMaskColumn;
    dxDBGrid1SZFS: TdxDBGridMaskColumn;
    dxDBGrid1SZDATE: TdxDBGridMaskColumn;
    dxDBGrid1SZMEM: TdxDBGridMaskColumn;
    dxDBGrid1SZMONEY: TdxDBGridMaskColumn;
    procedure FormCreate(Sender: TObject);
    procedure grid01GetCellColor(Sender: TObject; ARow, ACol: Integer;
      AState: TGridDrawState; ABrush: TBrush; AFont: TFont);
    procedure grid01GetAlignment(Sender: TObject; ARow, ACol: Integer;
      var AAlignment: TAlignment);
    procedure pageMainChange(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure YYBtnClick(Sender: TObject);
    procedure GenObject(n: integer; Sender: TObject);
    procedure LoadYoYo(n: integer);


  end;

var
  frmMain: TfrmMain;


implementation

{$R *.DFM}

uses Tools, JBStr;



//1999.9.17. 9.21. 9.24. 11.2
//根据yy1文件生成的按钮的事件

procedure TfrmMain.YYBtnClick(Sender: TObject);
var
  sCommand, sSource: string;
  i: integer;
  ln1: integer;
begin
  ln1 := (Sender as TBitBtn).tag; //获得现在是第几个按钮

  //开始解码循环

  i := 0;
  while i < gaYYBtn[ln1].YYSourceLine do
    begin

      gnYPoint := i + 1; //记录当前执行到第几行的指针

      sSource := gaYYBtn[ln1].YYSource[gnYPoint]; //临时记录一行yy语言

      sCommand := GetFirstWord(sSource, [' ']);

      if sCommand = 'ysCloseApp' then
        begin
          ysCloseApp;
        end;

      //1999.10.16.
      if sCommand = 'ysShowAbout' then
        begin
          ysShowAbout;
        end;

      //1999.10.16.
      if sCommand = 'ysShowHelp' then
        begin
          ysShowHelp;
        end;

      if sCommand = 'ysCopyFile' then
        begin
          ysCopyFile(sSource);
        end;


      if sCommand = 'ydAppendRecord' then
        begin
          ydAppendRecord;
        end;

      if sCommand = 'yiShowDB' then
        begin
          yiShowDB(sSource);
        end;

      if sCommand = 'yiShowInputWindow' then
        begin
          yiShowInputWindow(sSource);
        end;

      //1999.11.2. 显示query窗口
      if sCommand = 'yiShowQueryWindow' then
        begin
          yiShowQueryWindow;
        end;

      if sCommand = 'yiShowStatus' then
        begin
          yiShowStatus(sSource);
        end;

      if sCommand = 'ydEditRecord' then
        begin
          ydEditRecord;
        end;

      if sCommand = 'ydSaveRecord' then
        begin
          ydSaveRecord;
        end;

      if sCommand = 'ydDelRecord' then
        begin
          ydDelRecord;
        end;

      //1999.10.16.
      if sCommand = 'ydGenMid' then
        begin
          ydGenMid(sSource);
        end;

      //1999.11.2.
      if sCommand = 'ydQueryProcess' then
        begin
          ydQueryProcess;
        end;

		//1999.11.16.
		if sCommand = 'yiShowSetupWindow' then
		  begin
			 yiShowSetupWindow;
		  end;
		  
      i := i + 1;
    end;

end;


//1999.9.17. 9.21. 9.23.
//读入yy1文件,分析对象

procedure TfrmMain.LoadYoYo(n: integer);
var
  i: integer;
begin
  try
    gsList := TStringList.Create;
    gsList.LoadFromFile(ButPath + FileListYY.Items[n - 1]);

    gsButCaption := gsList.Strings[0];
    gsButBMPFile := gsList.Strings[1];
    gsButHint := gsList.Strings[2];

    //第几个tab
    gnButTab := StrToInt(ExtractWord(1, gsList.Strings[3], [' ']));
    //tab上第几个按钮
    gnButTabOrder := StrToInt(ExtractWord(2, gsList.Strings[3], [' ']));

    //读入每个yy1脚本语言的源代码
    for i := 6 to gsList.Count - 1 do
      begin
        gaYYBtn[n].YYSource[i - 5] := gsList.Strings[i];
      end;
    gaYYBtn[n].YYSourceLine := gsList.Count - 6; //yy脚本语言的行数


    AppendLog('读入对象:' + gsButCaption);
  finally
    gsList.Free;
  end;
end;


//1999.9.17. 9.24. 11.8.
//生成按钮对象

procedure TfrmMain.GenObject(n: integer; Sender: TObject);
begin
  gBut := TBitBtn.Create(self);
  gBut.Left := gnPanXOff + (gnButTabOrder - 1) * 65;
  gBut.Top := gnPanYOff;
  gBut.caption := gsButCaption;
  gBut.NumGlyphs := 2;
  gBut.Glyph.LoadFromFile(ButBMPPath + gsButBMPFile);
  gBut.Tag := n;
  gBut.Hint := gsButHint;
  gBut.Width := 60;
  gBut.Parent := panToolBar;

  //  if gnButTab = 0 then gBut.Parent := tabDB;
  //  if gnButTab = 1 then gBut.Parent := tabSystem;

  gBut.OnClick := YYBtnClick; //事件挂钩

  AppendLog('生成对象:' + gsButCaption);
end;


//窗口初始化事件
//1999.9.25. 10.16. 10.17. 11.10.  11.13. 11.15.

procedure TfrmMain.FormCreate(Sender: TObject);
var
  i: integer;
begin
  InitYoYo; //初始化

  if FileExists(GetAppPath + 'money.ebf') = false then
    copyfile(GetAppPath + 'moneybak.ebf', GetAppPath + 'money.ebf');
  if FileExists(GetAppPath + 'moneymid.ebf') = false then
    copyfile(GetAppPath + 'moneybak.ebf', GetAppPath + 'moneymid.ebf');
  if FileExists(GetAppPath + 'moneyq.ebf') = false then
    copyfile(GetAppPath + 'moneybak.ebf', GetAppPath + 'moneyq.ebf');



  FileListYY.Directory := ButPath; //制定yy1文件的路径
  gnYYCount := FileListYY.Items.Count; //计算yy1文件的数量

  tableMain.DatabaseName := GetAppPath;
  tableMid.DatabaseName := GetAppPath;
  tableQuery.DatabaseName := GetAppPath;
  tableExpress.DatabaseName := GetAppPath;

  ydGetBottomID;

  //按照yy1文件的数量进行循环
  for i := 1 to gnYYCount do
    begin
      gnYYCurrent := i; //当前的yy1对象是第几个
      LoadYoYo(i); //读入对象申明文件
      GenObject(i, Sender); //生成对象
    end;

  gbCanEdit := true; //允许编辑

  //初始化显示
  ydGenMid('ydGenMoney MONEY');
  yiShowDB('yiShowDB MAIN');
  yiShowStatus('yiShowStatus 2 SHOURUZHICHU');

end;


//在显示表格时做的处理。
//1999.10.12. 1999.11.13.   11.15.
procedure TfrmMain.grid01GetCellColor(Sender: TObject; ARow, ACol: Integer;
  AState: TGridDrawState; ABrush: TBrush; AFont: TFont);
begin

  if pageMain.ActivePage = tabMain then
    begin

      with grid01 do
        begin
          if AROW <> 0 then begin
              if grid01.cells[1, AROW] = '支出' then
                begin
                  afont.color := clWhite;
                  Abrush.color := $00FF8080;
                end;
              if grid01.cells[1, AROW] = '收入' then
                begin
                  afont.color := clBlack;
                  Abrush.color := $009CE250
                end;
            end;
        end;
    end;

  if pageMain.ActivePage = tabQuery then
    begin

      with gridQuery do
        begin
          if AROW <> 0 then begin
              if gridQuery.cells[1, AROW] = '支出' then
                begin
                  afont.color := clWhite;
                  Abrush.color := $00FF8080;
                end;
              if gridQuery.cells[1, AROW] = '收入' then
                begin
                  afont.color := clBlack;
                Abrush.color := $009CE250
                end;
            end;
        end;
    end;

end;

//1999.10.12.
procedure TfrmMain.grid01GetAlignment(Sender: TObject; ARow, ACol: Integer;
  var AAlignment: TAlignment);
begin
  if (ACol = 4) and (ARow <> 0) then
    begin
      AAlignment := taRightJustify;
    end;

  if (ACol = 2) and (ARow <> 0) then
    begin
      AAlignment := taCenter;
    end;

  if (ACol = 3) and (ARow <> 0) then
    begin
      AAlignment := taCenter;
    end;
end;

//1999.11.13. 11.15.
procedure TfrmMain.pageMainChange(Sender: TObject);
var
  m: integer;
  Temp: Tcomponent;
  b: boolean;
begin
  if pageMain.ActivePage = tabMain then b := true;
  if pageMain.ActivePage = tabQuery then b := false;

  for m := ComponentCount - 1 downto 0 do
    begin
      Temp := Components[m];
      if (Temp is TBitbtn) then
        begin
          if (Temp as TBitbtn).tag = 2 then (Temp as TBitbtn).enabled := b;
          if (Temp as TBitbtn).tag = 3 then (Temp as TBitbtn).enabled := b;
          if (Temp as TBitbtn).tag = 4 then (Temp as TBitbtn).enabled := b;
        end;
    end;


  if pageMain.ActivePage = tabExpress then
    begin
      ysDeCrypt(GetAppPath + 'money.ebf', GetAppPath + 'money.dbf');
      tableExpress.Open
    end
  else
    begin
      if FileExists(GetAppPath + 'money.dbf') then
        begin
          tableExpress.close;
          ysEnCrypt(GetAppPath + 'money.dbf', GetAppPath + 'money.ebf');
        end;
    end;


end;

end.

⌨️ 快捷键说明

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