📄 main.~pas

📁 一个QQ的界面源码
💻 ~PAS
📖 第 1 页 / 共 4 页
字号:
上一页 1 2 34
end;

procedure TFrmMain_QQ.ItmBeBaddyClick(Sender: TObject);
Var
   NewItem:TdxSideBarItem;
begin
   if ItmBeBaddy.Caption='加入黑名单(&A)' then
   begin
      if MessageBox(GetActiveWindow(),'您确定要将其加入黑名单吗？',
                     '加入黑名单',MB_YESNO+MB_ICONQUESTION)=IDYES then
      begin
         with DMShare.TblFriends do
         begin
            First;
            if Locate('QQNumber',IntToStr(ActiveItem.Tag),[]) then
            begin
               Edit;
               FieldValues['IsBaddy']:=True;
               Post;
            end;
         end;

         NewItem:=SideBar.Groups[2].Items.Add;
         NewItem.Tag:=ActiveItem.Tag;
         NewItem.Caption:=ActiveItem.Caption;
         NewItem.LargeImage:=ActiveItem.LargeImage;
         NewItem.SmallImage:=ActiveItem.SmallImage;
         NewItem.Index:=0;

         ActiveItem.Free;
         ActiveItem:=nil;
      end;
   end
   else
   begin
      if MessageBox(GetActiveWindow(),'您确定要将其加为好友吗？',
                     '加为好友',MB_YESNO+MB_ICONQUESTION)=IDYES then
      begin
         with DMShare.TblFriends do
         begin
            First;
            if Locate('QQNumber',IntToStr(ActiveItem.Tag),[]) then
            begin
               Edit;
               FieldValues['IsBaddy']:=False;
               Post;
            end;
         end;

         NewItem:=SideBar.Groups[0].Items.Add;
         NewItem.Tag:=ActiveItem.Tag;
         NewItem.Caption:=ActiveItem.Caption;
         NewItem.LargeImage:=ActiveItem.LargeImage;
         NewItem.SmallImage:=ActiveItem.SmallImage;
         NewItem.Index:=0;

         ActiveItem.Free;
         ActiveItem:=nil;
      end;
   end;
end;

procedure TFrmMain_QQ.ItmRenameGroupClick(Sender: TObject);
begin
   SideBar.EditGroup(SideBar.ActiveGroup);
end;

procedure TFrmMain_QQ.ItmAddGroupClick(Sender: TObject);
var
   NewGroup:TdxSideGroup;
begin
   NewGroup:=SideBar.Groups.Add;
   NewGroup.Index:=SideBar.GroupCount-1;
   SideBar.EditGroup(NewGroup);
end;

procedure TFrmMain_QQ.ItmDelGroupClick(Sender: TObject);
begin
   if MessageBox(GetActiveWindow,'您确认要将此组删除？',
                  '删除组',MB_YESNO+MB_ICONQUESTION)=IDYES then
   begin
      SideBar.ActiveGroup.Free;
   end;
end;

procedure TFrmMain_QQ.TimHideFormTimer(Sender: TObject);
var
   CursorPos:TPoint;
begin
   GetCursorPos(CursorPos);
   {hide the form FrmMain}
   if (not bHide) and
      (FrmMain_QQ.Top<=5) and
      (
         (CursorPos.X<FrmMain_QQ.Left) or
         (CursorPos.X>(FrmMain_QQ.Left+frmMain_QQ.Width)) or
         (CursorPos.Y<FrmMain_QQ.Top) or
         (CursorPos.Y>(FrmMain_QQ.Top+FrmMain_QQ.Height))
      ) then
   begin
      FrmMain_QQ.Top:=-(FrmMain_QQ.Height-3);
      bHide:=True;
   end;

   {Show the form FrmMain}
   if bHide and
      (CursorPos.X>FrmMain_QQ.Left) and
      (CursorPos.X<(FrmMain_QQ.Left+FrmMain_QQ.Width)) and
      (CursorPos.Y<=5) then
   begin
      FrmMain_QQ.Top:=0;
      bHide:=False;
   end;

end;

procedure TFrmMain_QQ.HotKeySpy1HotKeys0HotKey(Sender: TObject);
var
   MyMouse:TMouse;
   MousePos:TPoint;
begin
if TrayIcon.CycleIcons then
begin
   FrmMain_QQ.TrayIconDblClick(Sender);
end
else
begin


   if bHide then
   begin
      Application.Restore;
      Application.BringToFront;
      FrmMain_QQ.Top:=0;
      bHide:=False; {此句一定要加，否则真假关系就搞乱了，窗体不会隐藏了}
      {定位鼠标位置}
      MyMouse:=TMouse.Create;
      MousePos.X:=FrmMain_QQ.Left+30;
      MousePos.Y:=20;
      MyMouse.CursorPos:=MousePos;
   end
   else
   begin
      Application.Restore;
      Application.BringToFront;
   end;

end;

end;

procedure TFrmMain_QQ.ItmOfflineClick(Sender: TObject);
begin
   FrmMain_QQ.Offline;
   bLeave:=False;   
end;

procedure TFrmMain_QQ.ItmHideClick(Sender: TObject);
begin
   FrmMain_QQ.Offline;
   bLeave:=False;   
end;

procedure TFrmMain_QQ.ItmOnlineClick(Sender: TObject);
begin
   FrmMain_QQ.SendOnlineMessage;
   bLeave:=False;
end;

procedure TFrmMain_QQ.ItmLoginAgainClick(Sender: TObject);
begin
{  with TFrmLogin.Create(Application) do
  begin
    try
      ShowModal;
      Update;
    finally
      Release;
    end;
  end;
}
end;

procedure TFrmMain_QQ.ItmShowMainFormClick(Sender: TObject);
begin
   FrmMain_QQ.HotKeySpy1HotKeys0HotKey(Sender);
end;

procedure TFrmMain_QQ.TrayIconDblClick(Sender: TObject);
var
  i:integer;
  bExistFrmMsg:boolean;
begin
  bExistFrmMsg:=False;

  if TrayIcon.CycleIcons then
  begin
  {显示消息窗体}
    for i := 0 to 254 do
    begin
      if WndRecArr[i].QQNum<>'' then
      begin
        WndRecArr[i].PForm.Show;
        WndRecArr[i].PForm.BtnRevert.SetFocus;
        WndRecArr[i].QQNum:='';{这句不能忘啊，释放此窗体占用的数组空间}
        Break;
      end;
    end;
    {判断是否存在隐藏的消息窗体，有则继续托盘图标的跳动，无则停止跳动}
    for i := 0 to 254 do
    begin
      if WndRecArr[i].QQNum<>'' then
      begin
        bExistFrmMsg:=True;
        Break;
      end;
    end;
    {没有隐藏的消息窗体，则停止跳动}
    if not bExistFrmMsg then
    begin
      TrayIcon.CycleIcons:=False;
      TrayIcon.IconList:=nil;
      DMShare.IconList.GetIcon(1,TrayIcon.Icon);
    end;
  end;
end;

procedure TFrmMain_QQ.TrayIconClick(Sender: TObject);
var
   CursorPos:TPoint;
begin
   GetCursorPos(CursorPos);
   PMOnline.Popup(CursorPos.X,CursorPos.Y);
end;

//自定义的事件，用于收到消息时SideBar上头像的跳动
procedure TFrmMain_QQ.MyTimer(Sender:TObject);
var
   i,j,ImgIdx:integer;
   MyItem:TdxSideBarItem;
   MyTag:integer;
begin
   with Sender as TTimer do
   begin
      MyTag:=Tag;
   end;

   for i := 0 to SideBar.GroupCount-1 do
   begin
      for j := 0 to SideBar.Groups[i].ItemCount-1 do
      begin
         if SideBar.Groups[i].Items[j].Tag=MyTag then
         begin
            MyItem:=SideBar.Groups[i].Items[j];
//            ImgIdx:=MyItem.LargeImage;
            Break;
         end;
      end;
   end;
//showMessage(IntToStr(imgidx));

   if MyItem<>nil then
   begin
      if MyItem.LargeImage<>-1 then
      begin
         MyItem.LargeImage:=-1;
         MyItem.SmallImage:=-1;

      end
      else
      begin
{下面5行实在是不可为而为之啊，这样太……太……不好了，不断地读取数据库
上面的语句中为 iFlag 不知为何？不能起作用啊}
         with DMShare.TblFriends do
         begin
            First;
            Locate('QQNumber',IntToStr(MyItem.Tag),[]);
            ImgIdx:=FieldValues['FaceID'];
         end;

         MyItem.LargeImage:=ImgIdx;
         MyItem.SmallImage:=ImgIdx;
      end;
   end;

end;


procedure TFrmMain_QQ.BtnHomepageClick(Sender: TObject);
begin
   MessageBox(GetActiveWindow(),
               '哈哈!我的网站还没有建呢……',
               '作者网站',
               MB_OK+MB_ICONINFORMATION);
end;

procedure TFrmMain_QQ.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
   //退出时确认
   if bAskClose then
   begin
      if MessageBox(GetActiveWindow(),'您确认要退出吗？','退出',MB_YESNO+MB_ICONQUESTION)=IDNO then
      begin
         CanClose:=False;
      end;
   end;

end;

procedure TFrmMain_QQ.N11Click(Sender: TObject);
begin
   FrmAbout := TFrmAbout.Create(Application);
   try
      FrmAbout.ShowModal;
   finally
      FrmAbout.Release;
   end;

end;

procedure TFrmMain_QQ.ItmLeave1Click(Sender: TObject);
begin
   bLeave:=True;
   sLeaveMsg:=ItmLeave1.Caption;

   ItmLeave1.Checked:=True;
   ItmLeave2.Checked:=False;
   ItmLeave3.Checked:=False;
   ItmLeave4.Checked:=False;
end;

procedure TFrmMain_QQ.ItmLeave2Click(Sender: TObject);
begin
   bLeave:=True;
   sLeaveMsg:=ItmLeave2.Caption;

   ItmLeave1.Checked:=False;
   ItmLeave2.Checked:=True;
   ItmLeave3.Checked:=False;
   ItmLeave4.Checked:=False;
end;

procedure TFrmMain_QQ.ItmLeave3Click(Sender: TObject);
begin
   bLeave:=True;
   sLeaveMsg:=ItmLeave3.Caption;

   ItmLeave1.Checked:=False;
   ItmLeave2.Checked:=False;
   ItmLeave3.Checked:=True;
   ItmLeave4.Checked:=False;
end;

procedure TFrmMain_QQ.ItmLeave4Click(Sender: TObject);
begin
   bLeave:=True;
   sLeaveMsg:=ItmLeave4.Caption;

   ItmLeave1.Checked:=False;
   ItmLeave2.Checked:=False;
   ItmLeave3.Checked:=False;
   ItmLeave4.Checked:=True;
end;

procedure TFrmMain_QQ.ItmByMeClick(Sender: TObject);
begin
   with TFrmSetup.Create(Application) do
   begin
      try
        PageControl1.ActivePage:=TabMsg;
        ShowModal;
        Update;
      finally
        Release;
      end;
   end;

end;

procedure TFrmMain_QQ.N10Click(Sender: TObject);
begin
  MessageBox(GetActiveWindow(),
             '嘻嘻!'+#13+
             '这东东太简单了，'+#13+
             '我想应该不用写帮助了吧？'+#13++#13+
             '唯一要讲地就是默认的热键：ALT+X',
             '帮助……',
             MB_OK+MB_IconInformation);
end;

end.
上一页 1 2 34
💿 文件大小 998 K
👤 上传用户 wzsq12
📂 所属分类 Delphi控件源码
🏷️ 相关标签

#源码
⌨️ 快捷键说明

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