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

📄 u_otherpublicpack.pas

📁 软件功能:下载一个网站上所有的彩铃! 铃声下载完后
💻 PAS
📖 第 1 页 / 共 2 页
字号:
    End;
    If Sender Is TMemo Then
    Begin
      (Sender As TMemo).Left:=(Sender As TMemo).Left - MouseDownSpot.X + x;
      (Sender As TMemo).Top:=(Sender As TMemo).Top - MouseDownSpot.Y + y;
    End;
    If Sender Is TButton Then
    Begin
      (Sender As TButton).Left:=(Sender As TButton).Left - MouseDownSpot.X + x;
      (Sender As TButton).Top:=(Sender As TButton).Top - MouseDownSpot.Y + y;
    End;
    If Sender Is TBitBtn Then
    Begin
      (Sender As TBitBtn).Left:=(Sender As TBitBtn).Left - MouseDownSpot.X + x;
      (Sender As TBitBtn).Top:=(Sender As TBitBtn).Top - MouseDownSpot.Y + y;
    End;
    If Sender Is TSpeedButton Then
    Begin
      (Sender As TSpeedButton).Left:=(Sender As TSpeedButton).Left - MouseDownSpot.X + x;
      (Sender As TSpeedButton).Top:=(Sender As TSpeedButton).Top - MouseDownSpot.Y + y;
    End;
  End;
End;
{Procedure WMNCHitTest(Var msg:TWMNCHitTest);
Begin
  Inherited;
  If MSG.Result:=HTClient Then
    MSG.Result:=HTCaption;
End;}

{Procedure WndProc(Var Msg:TMessage);
Var
  CursorPoint:TPoint;
  PopMenu:TPopupMenu;
Begin
  Case Msg.Msg Of
    WM_USER+1://在鼠标点击托盘图标时进行处理
    Case Msg.LParam Of
      WM_RBUTTONDOWN:
      Begin
        GetCursorPos(CursorPoint);
        PopMenu.Popup(CursorPoint.X,CursorPoint.Y);
      End;
      WM_LBUTTONDOWN:
      Begin
        GetCursorPos(CursorPoint);
        PopMenu.Popup(CursorPoint.X,CursorPoint.Y);
      End;
    End;
  End;
  Inherited;
End;
}
//进行数据读配制
Procedure WriteConFig(IniSetFileName:String;Section:String;Ident:String;Value:String);
Var
  IniHandle: TIniFile;
Begin
  Try
    IniHandle:=TIniFile.Create(ExtractFilePath(Application.ExeName)+IniSetFileName);
    With IniHandle Do
    Begin
      IniHandle.WriteString(Section,Ident,Value);
      IniHandle.free;
    End;
  Except
    MessageDLG('写配置文件错误!',Mterror,[mbok],0);
  End;
End;
//添加MEMO信息
Procedure AddMemoMsg(Memo:TMemo;Str,FileName:String;MaxLineAmount:Integer);
Begin
  If FileName='' Then
  Begin
    If Memo.Lines.Count>=MaxLineAmount Then
      Memo.Clear;
    Memo.Lines.Add(Str);
  End
  Else
  Begin
    If Memo.Lines.Count>=MaxLineAmount Then
    Begin
      Memo.Lines.SaveToFile(FileName);
      Memo.Clear;
    End;
    Memo.Lines.Add(Str);
  End;
End;
//INI文件读配置
Function ReadConfig(IniSetFileName,SectionName,ValueName:String):String;
Var
  IniHandle:TIniFile;
Begin
  If FileExists(ExtractFilePath(Application.ExeName)+IniSetFileName) Then
  Begin
    IniHandle := TIniFile.Create(ExtractFilePath(Application.ExeName)+IniSetFileName);
    Result:=IniHandle.ReadString(SectionName,ValueName,'');
    IniHandle.free;
  End
  Else
    MessageDLG('读配置文件'+ExtractFilePath(Application.ExeName) + IniSetFileName+'不存在',MtError,[Mbyes],0);
end;

Function ReadConfigInt(IniSetFileName,SectionName,ValueName:String):Integer;
Var
  IniHandle:TIniFile;
Begin
  If FileExists(ExtractFilePath(Application.ExeName)+IniSetFileName) Then
  Begin
    IniHandle := TIniFile.Create(ExtractFilePath(Application.ExeName)+IniSetFileName);
    Result:=IniHandle.ReadInteger(SectionName,ValueName,0);
    IniHandle.free;
  End
  Else
    MessageDLG('读配置文件'+ExtractFilePath(Application.ExeName) + IniSetFileName+'不存在',MtError,[Mbyes],0);
end;

Procedure WriteConfigInt(IniSetFileName:String;Section:String;Ident:String;Value:Integer);
Var
  IniHandle: TIniFile;
Begin
  Try
    IniHandle:=TIniFile.Create(ExtractFilePath(Application.ExeName)+IniSetFileName);
    With IniHandle Do
    Begin
      IniHandle.WriteInteger(Section,Ident,Value);
      IniHandle.free;
    End;
  Except
    MessageDLG('写配置文件错误!',Mterror,[mbok],0);
  End;
End;

//制作定时器
procedure WaitForTimer(StartDateTime,EndDateTime:String;Option:Integer);
Var
  CurrTime:String;
Begin
  If Option=1 Then
    CurrTime:=FormatDateTime('yyyy-mm-dd',Now);//在一定的日期范围内
  If Option=2 Then
    CurrTime:=FormatDateTime('hh:nn:ss',Now);//在一天的范围内
  If Option=3 Then
    CurrTime:=FormatDateTime('yyyy-mm-dd hh:nn:ss',Now);//在一定的时间内
  If (CurrTime>StartDateTime) And (CurrTime<=EndDateTime) Then
  Begin
    //定时操作
  End;
End;
//生成EXCEL文件
Procedure FileMakeProc(Memo:TMemo;SourceFileName,DestectFileName:String;ReportApp,ReportWorkBook:Variant);
Begin
  //构造文件名及复制文件
  If Memo.Lines.Count>2000 Then
    Memo.Clear;
  Try
    If FileExists(SourceFileName+'.xls') Then
      DeleteFile(PChar(DestectFileName+'.xls'));
    CopyFile(pChar(SourceFileName+'.xls'), pChar(DestectFileName+'.xls'),true);
  Except
  End;
  If MessageDLG('确实要生成新文件'+DestectFileName,MtConfirmation,[mbyes,mbno],0)=Mrno Then
    Exit;
  Memo.Lines.Add('正在生成的新文件是 '+DestectFileName+',请稍候。。。');
  Try
    ReportApp:=CreateOleObject('Excel.Application');
    ReportWorkBook:=CreateOleObject('Excel.Sheet');
  Except
    ShowMessage('请检查Microsoft Excel是否有问题!');
    Memo.Lines.Add('该机器可能没有安装Microsoft Excel,请检查。。。!');
    Exit;
  End;
  Try
    ReportWorkBook:=ReportApp.WorkBooks.Add;
    ReportWorkBook:=ReportApp.WorkBooks.Open(DestectFileName);
    {
    ************************
    ******文件处理过程******
    ************************
    }
    //存盘
    ReportWorkBook.Save;
    Memo.Lines.Add('文件 '+DestectFileName+'已经生成!');
    ReportWorkBook.Close;
    ReportApp.Quit;
    ReportApp:=UnAssigned;
  Except
    Memo.Lines.Add('生成文件 '+DestectFileName+'失败!');
    ReportWorkBook.Close;
    ReportApp.Quit;
    ReportApp:=UnAssigned;
  End;
End;
//清空文件内容
Procedure ClearTextFile(FileName:string);
Var
  MakeFile:TextFile;
Begin
  AssignFile(MakeFile,FileName);
  Rewrite(MakeFile);
  CloseFile(MakeFile);
End;
//清空文件内容
Procedure ClearTextFile(Var MakeFile:TextFile);
Begin
  Rewrite(MakeFile);
End;
//添加文本文件内容
Procedure AppendTextFile(FileName,Str:String);
Var
  MakeFile:TextFile;
Begin
  AssignFile(MakeFile,FileName);
  Try
    Append(MakeFile);
  Except
    Rewrite(MakeFile);
  End;
  Writeln(MakeFile,Str);
  CloseFile(MakeFile);
End;
//添加文本文件内容
Procedure AppendTextFile(Var MakeFile:TextFile;Str:String);
Begin
  Try
    Append(MakeFile);
  Except
    Rewrite(MakeFile);
  End;
  Writeln(MakeFile,Str);
End;
//复制文本文件内容
Procedure CopyTextFile(SourceFileName,TargetFileName:String);
var
  SourceFile,DestectFile:TextFile;
  Str:string;
begin
  AssignFile(SourceFile,SourceFileName);
  try
    Reset(SourceFile);
  Except
    ShowMessage('源文件不存在!');
    Exit;
  End;
  AssignFile(DestectFile,TargetFileName);
  Rewrite(DestectFile);
  While Not Eof(SourceFile) Do
  Begin
    Readln(SourceFile,Str);
    Writeln(DestectFile,Str);
  End;
  Close(SourceFile);
  Close(DestectFile);
  //ShowMessage('复制完毕');
End;
//复制文本文件内容
Procedure CopyTextFile(Var SourceFile,DestectFile:TextFile);
var
  Str:string;
begin
  try
    Reset(SourceFile);
  Except
    ShowMessage('源文件不存在!');
    Exit;
  End;
  Rewrite(DestectFile);
  While Not Eof(SourceFile) Do
  Begin
    Readln(SourceFile,Str);
    Writeln(DestectFile,Str);
  End;
  ShowMessage('复制完毕');
End;
//统计文本文件内容
Function CountFileLines(FileName:String): Integer;
Var
  MakeFile:TextFile;
Begin
  Result:=0;
  Assignfile(MakeFile,FileName);
  Reset(MakeFile);
  While Not Eof(MakeFile) Do
  Begin
    Readln(MakeFile);
    Inc(Result);
  End;
  CloseFile(MakeFile);
End;
//统计文本文件内容
Function CountFileLines(Var MakeFile:TextFile):Integer;
Begin
  Result:=0;
  Reset(MakeFile);
  While Not Eof(MakeFile) Do
  Begin
    Readln(MakeFile);
    Inc(Result);
  End;
End;
//判断窗体是否存在
Function FormIsExist(Form:TForm;FormName:String):Boolean;
Var
  FormCount,FormIndex:Integer;
Begin
  Result:=False;
  FormCount:=Form.MDIChildCount;
  For FormIndex:=0 To FormCount-1 Do
  Begin
    If Form.MDIChildren[FormIndex].Name=FormName Then
    Begin
      Result:=True;
      Exit;
    End;
  End;
End;
//判断窗体是否存在
Function FormIsExist(Form:TForm;Var MDIFormIndex:Integer;FormName:String):Boolean;
Var
  FormCount,FormIndex:Integer;
Begin
  Result:=False;
  MDIFormIndex:=0;
  FormCount:=Form.MDIChildCount;
  For FormIndex:=0 To FormCount-1 Do
  Begin
    If Form.MDIChildren[FormIndex].Name=FormName Then
    Begin
      MDIFormIndex:=FormIndex;
      Result:=True;
      Exit;
    End;
  End;
End;
//判断窗体是否存在
Function FormIsExist(Form:TForm;FormName:String;Tag:Integer):Boolean;
Var
  FormCount,FormIndex:Integer;
Begin
  Result:=False;
  FormCount:=Form.MDIChildCount;
  For FormIndex:=0 To FormCount-1 Do
  Begin
    If (Pos(FormName,Form.MDIChildren[FormIndex].Name)=1) And (Form.MDIChildren[FormIndex].Tag=Tag) Then
    Begin
      Result:=True;
      Exit;
    End;
  End;
End;
//判断窗体是否存在
Function FormIsExist(Form:TForm;Var MDIFormIndex:Integer;FormName:String;Tag:Integer):Boolean;
Var
  FormCount,FormIndex:Integer;
Begin
  Result:=False;
  MDIFormIndex:=-1;
  FormCount:=Form.MDIChildCount;
  For FormIndex:=0 To FormCount-1 Do
  Begin
    If (Pos(FormName,Form.MDIChildren[FormIndex].Name)=1) And (Form.MDIChildren[FormIndex].Tag=Tag) Then
    Begin
      MDIFormIndex:=FormIndex;
      Result:=True;
      Exit;
    End;
  End;
End;
//从选择框列表中获取相关的值(FieldType为1字符串为0整形或浮点,ValueType为1是String为2是Name为3是Value
Function GetValuesFromList(FieldName,OperatorSign,LogicSign:String;FieldType:Integer;ValueType:Integer;CheckListBox:TCheckListBox):String;
Var
  ListCount,ListIndex:Integer;
  SqlStr,ListValue:String;
Begin
  With CheckListBox Do
  Begin
    SqlStr:='';
    ListCount:=Items.Count;
    For ListIndex:=0 To ListCount-1 Do
    Begin
      Application.ProcessMessages;
      If Checked[ListIndex] Then
      Begin
        Case ValueType Of//ValueType为1是String为2是Name为3是Value
          1:ListValue:=Items.Strings[ListIndex];
          2:ListValue:=Items.Names[ListIndex];
          3:ListValue:=Items.Values[Items.Names[ListIndex]];
        End;
        If SqlStr='' Then SqlStr:='(' Else SqlStr:=SqlStr+' '+LogicSign+' ';
        Case FieldType Of//1字符串为0整形或浮点
          1:SqlStr:=SqlStr+FieldName+OperatorSign+''''+ListValue+'''';
          2:SqlStr:=SqlStr+FieldName+OperatorSign+ListValue;
        End;
      End;
    End;
    If SqlStr<>'' Then
      SqlStr:=SqlStr+')';
    Result:=SqlStr;
  End;
End;
//全选列表框中所有选项
Procedure SelectAllListItem(ListBox:TCheckListBox);
Var
  ListCount,ListIndex:Integer;
begin
  ListCount:=ListBox.Items.Count;
  For ListIndex:=0 To ListCount-1 Do
    ListBox.Checked[ListIndex]:=True;
End;
//反选列表框中所有选项
Procedure UnSelectListItem(ListBox:TCheckListBox);
Var
  ListCount,ListIndex:Integer;
begin
  ListCount:=ListBox.Items.Count;
  For ListIndex:=0 To ListCount-1 Do
    ListBox.Checked[ListIndex]:=False;
End;

End.

⌨️ 快捷键说明

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