unit1.pas

同学录第二版(源代码)

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DBActns, StdActns, ActnList, Menus, ComCtrls, ToolWin, Grids, DBGrids,
  Db, DBTables, StdCtrls, Mask, DBCtrls, ExtCtrls, ImgList, Buttons,Variants;

type
  TForm1 = class(TForm)
    Table1: TTable;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    ActionList1: TActionList;
    MainMenu1: TMainMenu;
    ToolBar1: TToolBar;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N1: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    EditCopy1: TEditCopy;
    EditCut1: TEditCut;
    EditPaste1: TEditPaste;
    DataSetFirst1: TDataSetFirst;
    DataSetCancel1: TDataSetCancel;
    DataSetDelete1: TDataSetDelete;
    DataSetEdit1: TDataSetEdit;
    DataSetInsert1: TDataSetInsert;
    DataSetLast1: TDataSetLast;
    DataSetPost1: TDataSetPost;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    Panel1: TPanel;
    Panel2: TPanel;
    Table1BDEDesigner: TStringField;
    Table1BDEDesigner2: TStringField;
    Table1BDEDesigner4: TStringField;
    Table1BDEDesigner5: TStringField;
    Table1BDEDesigner6: TStringField;
    Table1Email: TStringField;
    Table1OICQ: TStringField;
    Table1OICQ2: TStringField;
    Table1BDEDesigner7: TStringField;
    Table1BDEDesigner8: TStringField;
    Table1BDEDesigner9: TStringField;
    Table1BDEDesigner10: TStringField;
    Label1: TLabel;
    DBEdit1: TDBEdit;
    Label2: TLabel;
    DBEdit2: TDBEdit;
    Label3: TLabel;
    DBEdit3: TDBEdit;
    Label4: TLabel;
    DBEdit4: TDBEdit;
    Label5: TLabel;
    DBEdit5: TDBEdit;
    Label6: TLabel;
    DBEdit6: TDBEdit;
    Label7: TLabel;
    DBEdit7: TDBEdit;
    Label8: TLabel;
    DBEdit8: TDBEdit;
    Label9: TLabel;
    DBEdit9: TDBEdit;
    Label10: TLabel;
    DBEdit10: TDBEdit;
    Label11: TLabel;
    DBEdit11: TDBEdit;
    Label12: TLabel;
    DBEdit12: TDBEdit;
    Label13: TLabel;
    DBEdit13: TDBEdit;
    Bevel1: TBevel;
    RadioGroup1: TRadioGroup;
    Label14: TLabel;
    Edit1: TEdit;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Bevel2: TBevel;
    acclose: TAction;
    acquery: TAction;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ImageList1: TImageList;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    ToolButton12: TToolButton;
    ToolButton13: TToolButton;
    ToolButton14: TToolButton;
    ToolButton15: TToolButton;
    ToolButton16: TToolButton;
    ToolButton17: TToolButton;
    acabout: TAction;
    achelp: TAction;
    accopyright: TAction;
    N17: TMenuItem;
    N18: TMenuItem;
    acnew: TAction;
    Table2: TTable;
    DataSource2: TDataSource;
    DBLookupComboBox1: TDBLookupComboBox;
    Table1BDEDesigner11: TSmallintField;
    ToolButton18: TToolButton;
    ToolButton19: TToolButton;
    ToolButton20: TToolButton;
    DBImage1: TDBImage;
    BitBtn3: TBitBtn;
    acload: TAction;
    Table1Tp: TGraphicField;
    Table1BDEDesigner3: TDateField;
    procedure accloseExecute(Sender: TObject);
    procedure DataSetFirst1Execute(Sender: TObject);
    procedure DataSetCancel1Execute(Sender: TObject);
    procedure DataSetDelete1Execute(Sender: TObject);
    procedure DataSetEdit1Execute(Sender: TObject);
    procedure DataSetInsert1Execute(Sender: TObject);
    procedure DataSetLast1Execute(Sender: TObject);
    procedure DataSetPost1Execute(Sender: TObject);
    procedure accopyrightExecute(Sender: TObject);
    procedure acaboutExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure DBGrid1TitleClick(Column: TColumn);
    procedure FormShow(Sender: TObject);
    procedure acqueryExecute(Sender: TObject);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure achelpExecute(Sender: TObject);
    procedure acseltypeExecute(Sender: TObject);
    procedure acnewExecute(Sender: TObject);
    procedure acloadExecute(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    procedure MySort(DBGrid0: TDBGrid; Column: TColumn);
    procedure getfield;
    procedure findbirthday(days: integer);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  psindexname:string;
  plAscend:boolean;
  s1:string;

  implementation
 uses unit2,unit3, Unit4, Unit5;

{$R *.DFM}

procedure tform1.getfield();//本模块得到查询字段名
begin
s1:=radiogroup1.Items.Strings[radiogroup1.itemindex];
end;

procedure TForm1.MySort(DBGrid0:TDBGrid; Column: TColumn);
var
//本模块使用到的psIndexName, plAscend两个变量见上定义
mode:char; //记录是“升序”还是“降序”
ColName:string; //记录当前字段名
iCol:Integer; //记录当前列号
begin
with DBGrid0.DataSource.DataSet as TTable do //Table0
begin
//检测当前工作表是否已打开
if not Active
then begin
MessageBeep(0);
Application.MessageBox('工作表尚未打开！','停止',MB_OK+MB_ICONSTOP);
Abort
end;
//检测当前字段是否“能排序”。以下字段类型不能排序
case Column.Field.DataType of
ftBoolean,
ftBytes,
ftBlob, //Binary
ftMemo,
ftGraphic,
ftFmtMemo, //Formatted memo
ftParadoxOle: //OLE
begin
MessageBeep(0);
Application.MessageBox(Pchar('项目'''+Column.FieldName+''''+'不能排序！'),'停止',MB_OK+MB_ICONSTOP);
Abort
end;
end; //case
mode:='0';
iCol:=Column.Field.FieldNo-1;
try
ColName:=Column.fieldname;
if psIndexName=Column.fieldname
then begin //与原来同列
if plAscend //升序
then begin
mode:='2';
IndexName:=ColName+'2'; //应“降序”
end
else begin
mode:='1';
IndexName:=ColName+'1'; //应“升序”
end;
plAscend:=not plAscend;
end
else begin //新列
IndexName:=ColName+'2';
plAscend:=false;
psIndexName:=ColName;
end;
except
on EDatabaseError do //若未有索引，则重新建立
begin
Messagebeep(0);
//以下新建索引
IndexName:='';
Close;
Exclusive:=true;
if mode='1'
then AddIndex(ColName+'1',ColName,[ixCaseInsensitive],'')//
else //包括'0'
AddIndex(ColName+'2',ColName,[ixDescending,ixCaseInsensitive],'');
Exclusive:=false;
Open;
try //try 1
if mode<>'1'
then begin
mode:='2';//转换
plAscend:=false;
end
else plAscend:=true;
IndexName:=ColName+mode;
psIndexName:=ColName;
except
on EDBEngineError do
IndexName:='';
end //try 2
end
end;
First;
end; //with
DBGrid0.SelectedIndex:=iCol;
end;

procedure TForm1.accloseExecute(Sender: TObject);
begin
close;
end;

procedure TForm1.DataSetFirst1Execute(Sender: TObject);
begin
table1.First;
end;

procedure TForm1.DataSetCancel1Execute(Sender: TObject);
begin
panel2.Enabled:=false;
table1.Cancel;
end;

procedure TForm1.DataSetDelete1Execute(Sender: TObject);
begin
if application.MessageBox('确认要删除吗？','提示',mb_okcancel)=idok then
table1.delete;
end;


procedure TForm1.DataSetEdit1Execute(Sender: TObject);
begin
panel2.Enabled:=true;
dbedit1.SetFocus;
table1.edit;
end;

procedure TForm1.DataSetInsert1Execute(Sender: TObject);
begin
panel2.Enabled:=true;
dbedit1.SetFocus;
table1.insert;
end;

procedure TForm1.DataSetLast1Execute(Sender: TObject);
begin
table1.Last;
end;

procedure TForm1.DataSetPost1Execute(Sender: TObject);
begin
table1.Post;
panel2.Enabled:=false;
end;


procedure TForm1.accopyrightExecute(Sender: TObject);
begin
 aboutbox.ShowModal;
end;

procedure TForm1.acaboutExecute(Sender: TObject);
begin
form3.showmodal;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 with Session do
  begin
    ConfigMode := cmSession;
  try
    AddStandardAlias('tempdb', ExtractFilePath(ParamStr(0)), 'PARADOX');
  finally
      ConfigMode := cmAll;
  end;
table1.Open;
table2.open;
end;
end;

procedure TForm1.DBGrid1TitleClick(Column: TColumn);
begin
table1.MasterSource:=nil;
mysort(dbgrid1,column);
table1.MasterSource:=DataSource2;
table1.open;
table1.Refresh;
end;

procedure TForm1.FormShow(Sender: TObject);
var i:integer;
begin
findbirthday(100);
panel2.Enabled:=false;
for i:=0 to datasource1.DataSet.FieldCount-1 do
if (Table1.Fields[I].FieldName<>'通讯录类型') and (Table1.Fields[I].FieldName<>'生日') and (Table1.Fields[I].FieldName<>'Tp') then
RadioGroup1.Items.Add(Table1.Fields[I].FieldName);
radiogroup1.ItemIndex:=0;
//dblookupcombobox1.
end;

procedure tform1.findbirthday(days:integer);
var y,m,d,y1,m1,d1:word;
    changeddate,changeddate1:tdatetime;
    ss:string;
    day1:integer;
begin
table1.First;
while not table1.eof do
begin
if table1.fieldbyname('生日').value=null then
begin
table1.next;
continue;
end;
decodedate(date,y,m,d);
decodedate(table1.fieldbyname('生日').value,y1,m1,d1);
changeddate:=encodedate(2000,m,d);
changeddate1:=encodedate(2000,m1,d1);
if changeddate>changeddate1 then
changeddate1:=encodedate(2000+1,m1,d1);
if ((changeddate1-changeddate)<=days)  then
begin
if (changeddate1-changeddate)=0 then
ss:='今天是'+table1.fieldbyname('姓名').value+'的生日！'
else
begin
day1:=trunc(changeddate1-changeddate);
ss:='还有'+inttostr(day1)+'天就是'+table1.fieldbyname('姓名').value+'的生日！';
end;
application.MessageBox(pchar(ss),'注意',0);
end;
table1.Next;
end;
table1.first;
end;

procedure TForm1.acqueryExecute(Sender: TObject);
begin
if (table1.State=dsedit) or (table1.State=dsinsert) then
DataSetPost1Execute(Sender);
getfield;
if edit1.Text='' then
table1.Filter:=''
else
table1.Filter:=s1+'='''+edit1.text+'*''';
end;

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if key=vk_return then
acqueryExecute(Sender);
end;

procedure TForm1.achelpExecute(Sender: TObject);
begin
application.MessageBox('1.输入：先单击插入按钮，输入完成后再单击插入可输下一条。'+#13+'2.修改：单击修改即可。'+#13+'3.删除：单击删除即可。'+#13+'4.查找：先选择要查询字段，然后输入值，单击查询。'+#13+'5.加照片：先单击“编辑”按钮，然后单击“加载图片”或双击图片框即可。'+#13+'6.注意：日期用-号分隔，例如：2001-01-01','帮助',
mb_ok);
end;

procedure TForm1.acseltypeExecute(Sender: TObject);
begin
form4.showmodal;
end;

procedure TForm1.acnewExecute(Sender: TObject);
begin
form5.showmodal;
end;

procedure TForm1.acloadExecute(Sender: TObject);
begin
form4.ShowModal;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
table1.Close;
table1.Exclusive:=true;
table1.Open;
table1.EmptyTable;
end;

end.