main.pas

自己做的通讯录程序

  Update();
  GetDataFromDB();
  MakeAllEnabled(self, True);
end;

procedure TForm1.btShowLevelClick(Sender: TObject);
var
  i, level: Integer;
begin
  i := NameList.Items.Count-1;
  while i >= 0 do
  begin
    level := pTItem(NameList.Items[i].Data).UseLevel;
    if ( (level < StrToInt(cbMin.Text)) or (level > StrToInt(cbMax.Text)) )
       AND not(ItemModified(NameList.Items[i])) then  //没有被修改的记录才可以隐藏起来
      NameList.Items.Delete(i);
    i := i-1;
  end;
  NameListChange(nil, NameList.Selected, ctState);
end;

procedure TForm1.btShowGroupClick(Sender: TObject);
var
  i: Integer;
begin
  i := NameList.Items.Count-1;
  while i >= 0 do
  begin
    if not(PersonInGroups(NameList.Items[i].Data)) 
       AND not(ItemModified(NameList.Items[i])) then  //没有被修改的记录才可以隐藏起来
      NameList.Items.Delete(i);
      
    i := i-1;
  end;
  NameListChange(nil, NameList.Selected, ctState);
end;

function TForm1.PersonInGroups(p: pTItem):Boolean;
var
  i,j: Integer;
begin
  result := false;
  for i:=0 to Length(p.GroupIDs)-1 do
    for j:=0 to clbShowGroup.Items.Count-1 do
      if clbShowGroup.Checked[j] and (p.GroupIDs[i] = GroupIDs[j]) then
      begin
        result := true;
        exit;
      end;
end;

procedure TForm1.btQueryNameClick(Sender: TObject);
var
  i: Integer;
begin
  i := NameList.Items.Count-1;
  while i >= 0 do
  begin
    if ( Pos(editQueryName.Text, pTItem(NameList.Items[i].Data).Name)=0 )
       AND not(ItemModified(NameList.Items[i])) then  //没有被修改的记录才可以隐藏起来
    begin
      NameList.Items.Delete(i);
    end;
    i := i-1;
  end;
  NameListChange(nil, NameList.Selected, ctState);
end;

procedure TForm1.NDataFileClick(Sender: TObject);
var
  Reg: TRegistry;
  strDriver, strFile: String;
begin
  if ifModify() then
  begin
    if MessageBox(Handle, PChar('有记录被修改，如果更换数据文件，将丢失这些修改'+#13+#10+'要继续吗？'),
                  '要继续吗', MB_YESNO or MB_ICONQUESTION) = IDNO then
       exit;
  end;


  Timer1.Enabled := False;

  if OpenDialogODBC.Execute then
    strFile := OpenDialogODBC.FileName
  else
    Exit;

  Reg := TRegistry.Create;
  try
    //删除原有的ODBC数据源
    //用户DSN
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.OpenKey('\Software\ODBC\ODBC.INI\ODBC Data Sources', false) then
    begin
      Reg.DeleteValue('AddressList');
      Reg.CloseKey;
    end;
    if Reg.OpenKey('\Software\ODBC\ODBC.INI', True) then
    begin
      Reg.DeleteKey('AddressList');
      Reg.CloseKey;
    end;
    //系统DSN
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKey('\SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources', false) then
    begin
      Reg.DeleteValue('AddressList');
      Reg.CloseKey;
    end;
    if Reg.OpenKey('\Software\ODBC\ODBC.INI', True) then
    begin
      Reg.DeleteKey('AddressList');
      Reg.CloseKey;
    end;

    //判断有没有安装Access数据库
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKey('\SOFTWARE\ODBC\ODBCINST.INI\Microsoft Access Driver (*.mdb)', False) then
    begin
      strDriver := Reg.ReadString('Driver');
      Reg.CloseKey;
      if strDriver = '' then
      begin
        MessageBox(Handle, '没有安装Access数据库', '错误', MB_OK or MB_ICONERROR);
        Reg.Free;
        Exit;
      end;
    end;

    //写入用户DSN
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.OpenKey('\SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources', True) then
    begin
      Reg.WriteString('AddressList', 'Microsoft Access Driver (*.mdb)');
      Reg.CloseKey;
    end;
    //写入详细信息
    if Reg.OpenKey('\Software\ODBC\ODBC.INI\AddressList', True) then
    begin
      Reg.WriteString( 'DBQ',               strFile);
      Reg.WriteString( 'Description',       '通讯录（周敏龙制作）');
      Reg.WriteString( 'Driver',            strDriver);
      Reg.WriteString( 'FIL',               'MS Access;');
      Reg.WriteString( 'UID',               '');
      Reg.WriteInteger('DriverId',          19);
      Reg.WriteInteger('SafeTransactions',  0);
      Reg.CloseKey;
    end;
    if Reg.OpenKey('\Software\ODBC\ODBC.INI\AddressList\Engines\Jet', True) then
    begin
      Reg.WriteString( 'ImplicitCommitSync', '');
      Reg.WriteString( 'UserCommitSync',     'Yes');
      Reg.WriteInteger('MaxBufferSize',      2048);
      Reg.WriteInteger('PageTimeout',        5);
      Reg.WriteInteger('Threads',            3);
      Reg.CloseKey;
    end;
  finally
    Reg.Free;
  end;

    try
      ADOConnection1.Close;
      ADOConnection1.Open;
    except
      Raise Exception.Create('数据库连接失败！请重新配置ODBC数据源“AddressList”！');
      Application.Terminate();
      Exit;
    end;

  //选择用户
  NSelectUserClick(nil);
  //Timer1.Enabled := true;
end;


function  TForm1.ifExistODBC():Boolean;   //判断是否存在ODBC数据源
var
  Reg: TRegistry;
  dsn: String;
begin
  result := false;
  Reg := TRegistry.Create;
  try
    //判断有没有用户DSN
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.OpenKey('\Software\ODBC\ODBC.INI\ODBC Data Sources', false) then
    begin
      dsn := Reg.ReadString('AddressList');
      if dsn <> '' then
        result := true;
      Reg.CloseKey;
    end;
    //判断有没有系统DSN
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKey('\SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources', false) then
    begin
      dsn := Reg.ReadString('AddressList');
      if dsn <> '' then
        result := true;
      Reg.CloseKey;
    end;
  finally
    Reg.Free;
  end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  NShowClick(nil);
  MakeAllEnabled(self, False);
  Update();

  if not(ifExistODBC()) then
  begin
    ShowMessage('没有发现ODBC数据源"AddressList"，请配置！');
    NDataFileClick(nil);
  end else begin
    //Timer1.Enabled := true;
    try
      ADOConnection1.Close;
      ADOConnection1.Open;
    except
      Raise Exception.Create('数据库连接失败！请重新配置ODBC数据源“AddressList”！');
      Application.Terminate();
      Exit;
    end;
    //选择用户
    NSelectUserClick(nil);
  end;

  if ifExistODBC() then
  begin
    //找当前最大的ID值，新插入的记录的ID为 maxID+1
    with AQuery do
    begin
      SQL.Clear;
      SQL.Add('Select max(id) as maxid From AddressList');
      Open;
      maxid := FieldByName('maxid').AsInteger;
      Close;
    end;
  end;
end;

procedure TForm1.NAboutClick(Sender: TObject);
var
  AboutBox: TAboutBox;
begin
  AboutBox := TAboutBox.Create(Application);
  AboutBox.Show();
end;

procedure TForm1.NSelectUserClick(Sender: TObject);
begin
  if ifModify() then
  begin
    if MessageBox(Handle, PChar('有记录被修改，如果更换用户，将丢失这些修改'+#13+#10+'要继续吗？'),
                  '要继续吗', MB_YESNO or MB_ICONQUESTION) = IDNO then
       exit;
  end;

  if frmSelectUser.ShowModal = mrOK then
    if (frmSelectUser.m_CurUser <> '')
       AND (frmSelectUser.m_CurUser <> m_CurUser) then
    begin
      m_CurUser := frmSelectUser.m_CurUser;
      Timer1.Enabled := true;
    end;
end;

procedure TForm1.NUserClick(Sender: TObject);
var
  i: Integer;
  bFind: Boolean;
begin
  frmUserMaintain.ShowModal();
  //如果当前用户已经被删除了，则要选择其他的用户为当前用户了
  bFind := false;
  for i:=0 to frmUserMaintain.m_UserList.Count - 1 do
    if m_CurUser = pTUserItem(frmUserMaintain.m_UserList[i]).UserName then
    begin
      bFind := true;
      break;
    end;
  if not(bFind) then
  begin
    ShowMessage('当前用户已被删除，请使用其他的用户');
    m_CurUser := '';
    Timer1.Enabled := true;
  end;
end;

function  TForm1.GetBirthday():String;   //根据年月日得到生日
begin
  if (Year.Value = 0) AND (Month.Value = 0) AND (Day.Value = 0) then
    result := ''
  else
    result := Format('%s年%s月%s日', [Year.Text, Month.Text, Day.Text]);
end;

//根据birthday拆分得到年月日
procedure TForm1.SplitBirthday(birthday:String);
var
  nPos: Integer;
  str: String;
begin
  if Length(birthday) = 0 then
  begin
    Year.Value := 0;
    Month.Value := 0;
    Day.Value := 0;
    exit;
  end;

  try
    //年
    nPos := Pos('年', birthday);
    str := Copy(birthday, 1, nPos-1);
    Year.Value := StrToInt(str);
    Delete(birthday, 1, nPos-1+Length('年'));
    //月
    nPos := Pos('月', birthday);
    str := Copy(birthday, 1, nPos-1);
    Month.Value := StrToInt(str);
    Delete(birthday, 1, nPos-1+Length('月'));
    //日
    nPos := Pos('日', birthday);
    str := Copy(birthday, 1, nPos-1);
    Day.Value := StrToInt(str);
  except
  end;
end;

function  TForm1.ifModify():Boolean;     //判断是否有更改
var
  i: Integer;
begin
  result := false;
  for i:=0 to NameList.Items.Count - 1 do
    if pTItem(NameList.Items[i].Data).ItemState in [isNew, isUpdated] then
      result := true;
  if m_Deleted.Count > 0 then
    result := true;
end;

function  TForm1.ItemModified(ListItem: TListItem):Boolean;
begin
  result := false;
  if pTItem(ListItem.Data).ItemState in [isNew, isUpdated] then
     result := true;
end;

function  TForm1.GetBirthShow(Birthday: String):String; //根据完整的生日获取应该显示的生日
var
  nPos, nYear, nMonth, nDay: Integer;
  str, strMonth, strDay: String;
begin
  result := '';
  if Length(Birthday)=0 then
    exit;

  try
      //年
      nPos := Pos('年', birthday);
      str := Copy(birthday, 1, nPos-1);
      nYear := StrToInt(str);
      Delete(birthday, 1, nPos-1+Length('年'));
      //月
      nPos := Pos('月', birthday);
      str := Copy(birthday, 1, nPos-1);
      nMonth := StrToInt(str);
      Delete(birthday, 1, nPos-1+Length('月'));
      if nMonth<10 then
        strMonth := '0'+IntToStr(nMonth)
      else
        strMonth := IntToStr(nMonth);
      //日
      nPos := Pos('日', birthday);
      str := Copy(birthday, 1, nPos-1);
      nDay := StrToInt(str);
      if nDay<10 then
        strDay := '0'+IntToStr(nDay)
      else
        strDay := IntToStr(nDay);

    if NShowYear.Checked then
      result := Format('%d年%s月%s日', [nYear, strMonth, strDay])
    else
      result := Format('%s月%s日', [strMonth, strDay]);
    begin
    end;
  except
  end;

end;

procedure TForm1.NShowYearClick(Sender: TObject);
var
  i, j, count: Integer;
  p: pTItem;
begin
  NShowYear.Checked := not(NShowYear.Checked);

  count := NameList.Items.Count;
  NameList.Items.BeginUpdate;
  for i:=0 to count-1 do
  begin
    p := NameList.Items[i].Data;
    p.BirthShow := GetBirthShow(p.Birthday);
    if Length(p.BirthShow)>0 then
      //找到“生日”列，改变该列的值
      for j:=1 to NameList.Columns.Count-1 do
        if NameList.Columns[j].Caption='生日' then
           NameList.Items[i].SubItems[j-1] := p.BirthShow;
  end;
  NameList.Items.EndUpdate;

  ToolButtonShowYear.Down := NShowYear.Checked;
end;

end.