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

📄 main.pas

📁 DBchart的高级使用
💻 PAS
字号:
unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ExtCtrls, AHMTOfficeButton, AHMControls, AHMTFillBackground,
  AHMClasses, AHMTBackground, StdCtrls, AHMTLabel, Db, DBTables, AHMTHint;

type
  Tf_main = class(TForm)
    Image1: TImage;
    tmpTable: TTable;
    Query1: TQuery;
    DBServer: TDatabase;
    procedure FormShow(Sender: TObject);
    procedure Image1DblClick(Sender: TObject);
    procedure AHMOfficeButton5Click(Sender: TObject);
    procedure DelTable(STName: String);
    procedure CreateSysTable(STName:String);
    procedure CreateRYTable(STName : String);
    procedure CreateLDTable(STName : String);
    procedure CreateCWTable(STName : String);
    procedure CreateLXTable(STName : String);
    
    procedure AHMOfficeButton1Click(Sender: TObject);
    procedure AHMOfficeButton2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  f_main: Tf_main;

implementation

{$R *.DFM}
uses global,about,basic,vote;

procedure Tf_main.DelTable(STName: String);
begin
     TmpTable.Active := False;
     TmpTable.DatabaseName := 'stdelect';
     TmpTable.TableName := STName;
     try TmpTable.DeleteTable;
     except
       on EDBEngineError  do;
     end;
     TmpTable.Close;
end;

procedure Tf_main.CreateSysTable(STName:String);
begin
     DelTable(STName);
     with TmpTable do
     begin
          Active := False;
          DataBaseName := 'stdelect';
          TableName := STName;
          with FieldDefs do
          begin
               Clear;
               Add('mc',ftString,10,true);
               Add('val',ftString,200,False);
          end;
          IndexDefs.Clear;
          IndexDefs.Add('Id_sys', 'mc', [ixPrimary, ixUnique]);
          CreateTable;
     end;
     TmpTable.Close;
end;

procedure Tf_main.CreateRYTable(STName : String);
begin
     DelTable(STName);
     with TmpTable do
     begin
          Active := False;
          DataBaseName := 'stdelect';
          TableName := STName;
          with FieldDefs do
          begin
               Clear;
               Add('序号',ftString,3,true);
               Add('姓名',ftString,15,false);
               Add('政协任职',ftString,16,false);
               Add('参加委员会',ftString,8,false);
               Add('所属委员会',ftString,8,false);
               Add('其他兼职',ftString,20,false);
               Add('界别',ftString,8,false);
               Add('性别',ftString,2,false);
               Add('民族',ftString,6,false);
               Add('出生年月',ftString,8,false);
               Add('工作时间',ftString,8,false);
               Add('党派',ftString,8,false);
               Add('籍贯',ftString,12,false);
               Add('职称',ftString,14,false);
               Add('文化程度',ftString,6,false);
               Add('毕业院校',ftString,20,false);
               Add('单位及职务',ftString,138,false);
          end;
          IndexDefs.Clear;
          IndexDefs.Add('I_'+STName, '序号', [ixPrimary, ixUnique]);
          CreateTable;
     end;
     TmpTable.Close;
end;

procedure Tf_main.CreateLDTable(STName : String);
var
   i:Integer;
begin
     DelTable(STName);
     with TmpTable do
     begin
          Active := False;
          DataBaseName := 'stdelect';
          TableName := STName;
          with FieldDefs do
          begin
               Clear;
               for i:=1 to 10 do begin
                   Add('a'+IntToStr(i),ftInteger,0,false); //同意
                   Add('f'+IntTostr(i),ftInteger,0,false); //反对
                   Add('q'+IntToStr(i),ftInteger,0,false); //弃权
               end;
          end;
          IndexDefs.Clear;
          //IndexDefs.Add('Id_ydtx', 'xh', [ixPrimary, ixUnique]);
          CreateTable;
     end;
     TmpTable.Close;
end;

procedure Tf_main.CreateCWTable(STName : String);
begin
     DelTable(STName);
     with TmpTable do
     begin
          Active := False;
          DataBaseName := 'stdelect';
          TableName := STName;
          with FieldDefs do
          begin
               Clear;
               Add('ryxh', ftString, 3, True); //人员代码
               Add('a',ftInteger,0,False); //同意
               Add('f',ftInteger,0,False); //反对
               Add('q',ftInteger,0,False); //弃权
          end;
          IndexDefs.Clear;
  //        IndexDefs.Add('I_'+STName, 'jcgxxh', [ixPrimary, ixUnique]);
          CreateTable;
     end;
     TmpTable.Close;
end;

procedure Tf_main.CreateLXTable(STName : String);
begin
     DelTable(STName);
     with TmpTable do
     begin
          Active := False;
          DataBaseName := 'stdelect';
          TableName := STName;
          with FieldDefs do
          begin
               Clear;
               Add('xm', ftString, 15, True);
               Add('ps',ftInteger,0,False); 
          end;
          IndexDefs.Clear;
  //        IndexDefs.Add('I_'+STName, 'jcgxxh', [ixPrimary, ixUnique]);
          CreateTable;
     end;
     TmpTable.Close;
end;

procedure Tf_main.FormShow(Sender: TObject);
begin
     Try
        DBServer.connected:=false;
        DBServer.Connected:=True;
        Except on EDBEngineError do begin
             InfoMessage('数据库连接不上!');
             DBServer.Connected:=false;
             Application.Terminate;
             exit;
        end;
     end;

     if Not TableExist('sys') then begin
        CreateSysTable('sys');
        CreateRYTable('ryld');
        CreateRYTable('rycw');
        CreateLDTable('ld');
        CreateCwTable('cw');
     end;

end;

procedure Tf_main.Image1DblClick(Sender: TObject);
var
   f_about:Tf_about;
begin
     f_about:=Tf_about.Create(nil);
     f_about.showModal;
     f_about.Free;
end;

procedure Tf_main.AHMOfficeButton5Click(Sender: TObject);
begin
     if Application.MessageBox('确认要退出系统吗?','提示',MB_YESNO)=IDNO then exit;
     DBServer.Connected:=false;
     Application.Terminate;
     exit;
end;


procedure Tf_main.AHMOfficeButton1Click(Sender: TObject);
begin
     f_basic.ShowModal;
end;

procedure Tf_main.AHMOfficeButton2Click(Sender: TObject);
begin
     f_vote.showModal;
end;

procedure Tf_main.FormClose(Sender: TObject; var Action: TCloseAction);
begin
     if Application.MessageBox('确认要退出系统吗?','提示',MB_YESNO)=IDNO then begin
        Action:=caNone;
        exit;
     end;
     DBServer.Connected:=false;
     Application.Terminate;
     exit;
end;

end.


⌨️ 快捷键说明

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