RTFormwork/项目代码/RTBasicsV1/F05染色检验/spmain.pas
“ddf” 61630656e9 1
2024-07-07 09:35:27 +08:00

425 lines
11 KiB
ObjectPascal

unit spmain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ComCtrls, ToolWin, ActnMan, ActnCtrls, ActnMenus, ActnList, DB,
ADODB, Grids, IniFiles, jpeg, ExtCtrls, Buttons, ImgList, StdCtrls, cxControls,
cxSplitter, MovePanel, SyncObjs, System.ImageList;
type
TMyThread = class(TThread)
protected
procedure Execute; override;
end;
const
keys = 'ljb^0122!@#*&^%$';
type
TFormMain = class(TForm)
StatusBar1: TStatusBar;
ADOConnection1: TADOConnection;
ImageList25: TImageList;
ImageList3: TImageList;
ImageList24: TImageList;
ADQ_Temp: TADOQuery;
Image_Tree: TImageList;
ADOQueryTmp: TADOQuery;
Timer2: TTimer;
MovePanel1: TMovePanel;
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
Timer_link: TTimer;
procedure FormCreate(Sender: TObject);
procedure MNCloseClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Timer1Timer(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ToolButton12Click(Sender: TObject);
procedure Panel1Click(Sender: TObject);
procedure Panel2Click(Sender: TObject);
procedure Panel3Click(Sender: TObject);
procedure Timer_linkTimer(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
function intiData(): Boolean;
procedure GetServerDate();
public
ConDateBaseString: string;
V_User, V_UserID, User_Id, User_Name: string;
{ Public declarations }
// server, dtbase, user, pswd: String;
end;
var
FormMain: TFormMain;
gServerDate: TdateTime;
server, dtbase, user, pswd: string; {数据库连接参数}
gConString: string; {全局连接字符串}
gCurHandle: hwnd; //当前窗体句柄
newh: hwnd;
CriticalSection: TCriticalSection; {声明临界}
implementation
uses
logon, U_Link, U_iniParam;
{$R *.dfm}
procedure TMyThread.Execute;
begin
FreeOnTerminate := True;
CriticalSection.Enter;
try
with FormMain.ADOQueryTmp do
begin
close;
sql.Clear;
sql.Add('select getdate()');
open;
end;
except
try
with FormMain.ADOConnection1 do
begin
Connected := false;
ConnectionString := FormMain.ConDateBaseString;
LoginPrompt := false;
Connected := true;
end;
except
end;
end;
CriticalSection.Leave;
end;
function TFormMain.intiData(): Boolean;
var
mProdId: string; //当前产品号
begin
SetLength(server, 255);
SetLength(dtbase, 255);
SetLength(user, 255);
SetLength(pswd, 255);
server := '';
dtbase := '';
user := 'sa';
pswd := 'rightsoft@123';
ADOConnection1.ConnectionString := 'Provider=SQLOLEDB.1;Password=' + pswd + ';Persist Security Info=True;User ID=' + user + ';Initial Catalog=' + dtbase + ';Data Source=' + server;
ConDateBaseString := ADOConnection1.ConnectionString;
try
frmLink := TfrmLink.create(self);
if frmLink.ShowModal = 1 then
begin
ADOConnection1.ConnectionString := frmLink.fADOConnString;
frmLink.hide;
end
else
begin
application.MessageBox('通讯服务器连接错误!', '提示信息', MB_ICONERROR);
PostMessage(Handle, WM_CLOSE, 0, 0);
frmLink.Release;
end;
except
application.MessageBox('通讯服务器连接错误!', '提示信息', MB_ICONERROR);
PostMessage(Handle, WM_CLOSE, 0, 0);
end;
ConDateBaseString := ADOConnection1.ConnectionString;
Left := 0;
Top := 0;
Width := Screen.Width;
Height := Screen.Height;
try
ADOConnection1.Close;
ADOConnection1.Open;
Result := true;
except
result := false;
application.MessageBox('数据库连接失败!', '错误', mb_Ok + MB_ICONERROR);
PostMessage(self.handle, WM_CLOSE, 0, 0);
end;
end;
procedure TFormMain.FormCreate(Sender: TObject);
var
tmpstr: string;
begin
CriticalSection := TCriticalSection.Create;
if IsINIFile() then
ReadINIFile()
else
WriteINIFile;
if intiData() then
begin
GetServerDate();
// P_Tmp.Visible := True;
//P_Tmp.Align := AlClient;
FormLogon := TFormLogon.Create(self);
FormLogon.ShowModal;
end;
end;
procedure TFormMain.FormResize(Sender: TObject);
begin
//P_Tmp.Align := AlClient;
sendmessage(newh, 1034, 1, 0);
end;
procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
var
CanQuit: Boolean;
begin
sendmessage(newh, 1034, 4, 0);
if FormMain.MDICHildCount > 0 then
CanQuit := application.MessageBox('您确定需要退出当前系统吗?', '提示', mb_yesno + mb_IconQuestion) = idyes;
if CanQuit then
begin
Timer2.Enabled := false;
ADOConnection1.Close;
Action := CaFree;
end
else
Action := caNone;
end;
procedure TFormMain.MNCloseClick(Sender: TObject);
begin
close;
end;
procedure TFormMain.Timer1Timer(Sender: TObject);
begin
try
statusbar1.Panels[0].Text := '当前时间:' + datetimetostr(now);
except
end;
end;
procedure TFormMain.N2Click(Sender: TObject);
begin
end;
///////////////////////////////////////////////
//函数:获取系统参数
////////////////////////////////////////////////
procedure TFormMain.GetServerDate();
begin
with ADOQueryTmp do
begin
close;
sql.clear;
sql.Add('select getDate()as dt');
Open;
gServerDate := fieldByName('dt').AsDateTime;
close;
end;
end;
procedure TFormMain.Timer2Timer(Sender: TObject);
begin
FormMain.StatusBar1.Panels[0].Text := '当前时间:' + datetimetostr(now);
end;
procedure TFormMain.FormShow(Sender: TObject);
var
XSStr: string;
begin
try
IniFile := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'DyeInspFile.INI');
Panel1.Caption := IniFile.ReadString('生产车间配置', '模块名称1', '手工检验');
Panel3.Caption := IniFile.ReadString('生产车间配置', '模块名称2', '扫描检验');
XSStr := IniFile.ReadString('生产车间配置', '模块显示1', '1');
if XSStr = '1' then
begin
Panel1.Visible := True;
end
else
begin
Panel1.Visible := False;
end;
XSStr := IniFile.ReadString('生产车间配置', '模块显示2', '1');
if XSStr = '1' then
begin
Panel3.Visible := True;
end
else
begin
Panel3.Visible := False;
end;
finally
IniFile.Free;
end;
Timer2.Enabled := True;
end;
procedure TFormMain.ToolButton12Click(Sender: TObject);
var
CanQuit: Boolean;
begin
sendmessage(newh, 1034, 4, 0);
if application.MessageBox('您确定需要退出当前系统吗?', '提示', mb_yesno + mb_IconQuestion) <> IDYES then
Exit;
ADOConnection1.Close;
Close;
end;
procedure TFormMain.Panel1Click(Sender: TObject);
type
TMyFunc = function(App: Tapplication; FormH: hwnd; FormID: integer; Language: integer; WinStyle: integer; GCode: Pchar; GName: Pchar; DataBase: Pchar; Title: PChar; Parameters1: PChar; Parameters2: PChar; Parameters3: PChar; Parameters4: PChar; Parameters5: PChar; Parameters6: PChar; Parameters7: PChar; Parameters8: PChar; Parameters9: PChar; Parameters10: PChar; DataBaseStr: PChar): hwnd; stdcall;
var
Tf: TMyFunc;
Tp: TFarProc;
Th: Thandle;
DllName, DllInt: string;
IniFile: TIniFile;
xx: string;
begin
//静态加载
//newh:=getForm(Application,1,ADOConnection1,PChar('sa'),PChar('dsa'));
//动态加载
// showMessage(intTostr(application.Handle));
ADOConnection1.Connected := False;
ADOConnection1.Connected := True;
{ with ADOQueryTmp do
begin
Close;
sql.Clear;
sql.Add('select * from SY_User where UserId='''+Trim(User_Id)+'''');
Open;
end;
if Trim(ADOQueryTmp.FieldByName('BanZu').AsString)='' then
begin
Application.MessageBox('当前登录人班组为空!','提示',0);
Exit;
end; }
try
IniFile := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'DyeInspFile.INI');
DllName := IniFile.ReadString('生产车间配置', 'DLL文件1', 'TradeManagePB.dll');
DllInt := IniFile.ReadString('生产车间配置', 'DLL调用号1', '3');
finally
IniFile.Free;
end;
Th := LoadLibrary(PChar(DllName));
if Th > 0 then
begin
try
// Tp := GetProcAddress(Th, 'GetDllForm');
Tp := GetProcAddress(Th, PAnsichar(AnsiString('GetDllForm')));
if Tp <> nil then
begin
Tf := TMyFunc(Tp);
Tf(Application, 0, strtoint(DllInt), 0, 0, PChar(User_Id), PChar(User_Name), PChar(xx), PChar('55'), PChar(xx), PChar(xx), PChar(xx), PChar(xx), PChar(xx), PChar(xx), PChar(xx), PChar(xx), pchar(xx), PChar(xx), PChar(ConDateBaseString));
end
else
begin
ShowMessage('打印执行错误');
end;
finally
// FreeLibrary();
end;
end
else
begin
ShowMessage('找不到' + Trim('dllname'));
end;
end;
procedure TFormMain.Panel2Click(Sender: TObject);
var
CanQuit: Boolean;
begin
sendmessage(newh, 1034, 4, 0);
if application.MessageBox('您确定需要退出当前系统吗?', '提示', mb_yesno + mb_IconQuestion) <> IDYES then
Exit;
ADOConnection1.Close;
Close;
end;
procedure TFormMain.Panel3Click(Sender: TObject);
type
TMyFunc = function(App: Tapplication; FormH: hwnd; FormID: integer; Language: integer; WinStyle: integer; GCode: Pchar; GName: Pchar; DataBase: Pchar; Title: PChar; Parameters1: PChar; Parameters2: PChar; Parameters3: PChar; Parameters4: PChar; Parameters5: PChar; Parameters6: PChar; Parameters7: PChar; Parameters8: PChar; Parameters9: PChar; Parameters10: PChar; DataBaseStr: PChar): hwnd; stdcall;
var
Tf: TMyFunc;
Tp: TFarProc;
Th: Thandle;
DllName, DllInt: string;
IniFile: TIniFile;
begin
//静态加载
//newh:=getForm(Application,1,ADOConnection1,PChar('sa'),PChar('dsa'));
//动态加载
// showMessage(intTostr(application.Handle));
ADOConnection1.Connected := False;
ADOConnection1.Connected := True;
{ with ADOQueryTmp do
begin
Close;
sql.Clear;
sql.Add('select * from SY_User where UserId='''+Trim(User_Id)+'''');
Open;
end;
if Trim(ADOQueryTmp.FieldByName('BanZu').AsString)='' then
begin
Application.MessageBox('当前登录人班组为空!','提示',0);
Exit;
end; }
try
IniFile := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'DyeInspFile.INI');
DllName := IniFile.ReadString('生产车间配置', 'DLL文件2', 'TradeManagePB.dll');
DllInt := IniFile.ReadString('生产车间配置', 'DLL调用号2', '301');
finally
IniFile.Free;
end;
Th := LoadLibrary(PChar(DllName));
if Th > 0 then
begin
try
Tp := GetProcAddress(Th, 'GetDllForm');
if Tp <> nil then
begin
Tf := TMyFunc(Tp);
newh := Tf(Application, 0, strToint(DllInt), 0, 0, PChar(User_Id), PChar(User_Name), PChar(''), PChar(TToolButton(Sender).Caption), PChar(''), PChar(''), '', '', '', '', '', '', '', '', PChar(ConDateBaseString));
end
else
begin
ShowMessage('打印执行错误');
end;
finally
// FreeLibrary();
end;
end
else
begin
ShowMessage('找不到' + Trim('dllname'));
end;
end;
procedure TFormMain.Timer_linkTimer(Sender: TObject);
begin
TMyThread.Create(False);
end;
procedure TFormMain.FormDestroy(Sender: TObject);
begin
CriticalSection.Free;
end;
end.