📄 u_otherpublicpack.pas
字号:
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 + -