mainform1.pas
来自「思微POS连锁超市管理系统 (商业代码),几年前的东西了」· PAS 代码 · 共 2,254 行 · 第 1/5 页
PAS
2,254 行
unit MainForm1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Registry,
ImgList, Db, ADODB, Menus, ComCtrls, StdCtrls, ExtCtrls, ToolWin, Buttons;
type
TMainForm = class(TForm)
MainMenu1: TMainMenu;
Image1: TImage;
N4: TMenuItem;
N5: TMenuItem;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
ADOConnection1: TADOConnection;
N12: TMenuItem;
N15: TMenuItem;
N16: TMenuItem;
N18: TMenuItem;
N19: TMenuItem;
N20: TMenuItem;
N22: TMenuItem;
N23: TMenuItem;
N24: TMenuItem;
N25: TMenuItem;
N26: TMenuItem;
N27: TMenuItem;
N28: TMenuItem;
N29: TMenuItem;
N31: TMenuItem;
N32: TMenuItem;
N33: TMenuItem;
N35: TMenuItem;
N36: TMenuItem;
N38: TMenuItem;
N40: TMenuItem;
N41: TMenuItem;
N42: TMenuItem;
N43: TMenuItem;
N44: TMenuItem;
N45: TMenuItem;
N46: TMenuItem;
N51: TMenuItem;
N52: TMenuItem;
N53: TMenuItem;
N54: TMenuItem;
N55: TMenuItem;
N56: TMenuItem;
N59: TMenuItem;
N60: TMenuItem;
N61: TMenuItem;
N62: TMenuItem;
N57: TMenuItem;
N58: TMenuItem;
N63: TMenuItem;
N64: TMenuItem;
N65: TMenuItem;
N74: TMenuItem;
N75: TMenuItem;
N47: TMenuItem;
N76: TMenuItem;
N10: TMenuItem;
N14: TMenuItem;
N50: TMenuItem;
N78: TMenuItem;
N79: TMenuItem;
N80: TMenuItem;
N81: TMenuItem;
N82: TMenuItem;
N83: TMenuItem;
N84: TMenuItem;
N85: TMenuItem;
Panel1: TPanel;
Image2: TImage;
Label5: TLabel;
Image3: TImage;
Label6: TLabel;
N86: TMenuItem;
N69: TMenuItem;
Label2: TLabel;
DateTimePicker2: TDateTimePicker;
Label1: TLabel;
DateTimePicker1: TDateTimePicker;
Label3: TLabel;
Label4: TLabel;
N87: TMenuItem;
N88: TMenuItem;
POS1: TMenuItem;
N89: TMenuItem;
N90: TMenuItem;
N91: TMenuItem;
N92: TMenuItem;
N93: TMenuItem;
N94: TMenuItem;
N95: TMenuItem;
N96: TMenuItem;
N98: TMenuItem;
N99: TMenuItem;
N100: TMenuItem;
N101: TMenuItem;
N66: TMenuItem;
N67: TMenuItem;
Query1: TADOQuery;
N68: TMenuItem;
N97: TMenuItem;
N102: TMenuItem;
N105: TMenuItem;
N106: TMenuItem;
N107: TMenuItem;
N109: TMenuItem;
N110: TMenuItem;
N34: TMenuItem;
N103: TMenuItem;
N104: TMenuItem;
N108: TMenuItem;
N111: TMenuItem;
N113: TMenuItem;
N71: TMenuItem;
N72: TMenuItem;
N73: TMenuItem;
N114: TMenuItem;
N115: TMenuItem;
N116: TMenuItem;
N117: TMenuItem;
N118: TMenuItem;
N119: TMenuItem;
N120: TMenuItem;
N121: TMenuItem;
N122: TMenuItem;
N123: TMenuItem;
N124: TMenuItem;
N125: TMenuItem;
N126: TMenuItem;
N127: TMenuItem;
N128: TMenuItem;
N130: TMenuItem;
N131: TMenuItem;
N132: TMenuItem;
N133: TMenuItem;
N134: TMenuItem;
N135: TMenuItem;
N136: TMenuItem;
N137: TMenuItem;
N138: TMenuItem;
N139: TMenuItem;
N140: TMenuItem;
N141: TMenuItem;
C1: TMenuItem;
Z1: TMenuItem;
N142: TMenuItem;
N143: TMenuItem;
ToolBar1: TToolBar;
Timer1: TTimer;
Label7: TLabel;
SpeedButton2: TSpeedButton;
ToolButton1: TToolButton;
SpeedButton3: TSpeedButton;
SpeedButton4: TSpeedButton;
SpeedButton5: TSpeedButton;
SpeedButton6: TSpeedButton;
ToolButton2: TToolButton;
SpeedButton7: TSpeedButton;
SpeedButton8: TSpeedButton;
SpeedButton9: TSpeedButton;
SpeedButton1: TSpeedButton;
SpeedButton10: TSpeedButton;
procedure FormActivate(Sender: TObject);
function ExistForm(FormName: string): boolean;
procedure FormCreate(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure N11Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure N8Click(Sender: TObject);
procedure N12Click(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure N18Click(Sender: TObject);
procedure N19Click(Sender: TObject);
procedure N15Click(Sender: TObject);
procedure N16Click(Sender: TObject);
procedure N22Click(Sender: TObject);
procedure N23Click(Sender: TObject);
procedure N20Click(Sender: TObject);
procedure N38Click(Sender: TObject);
procedure N14Click(Sender: TObject);
procedure N31Click(Sender: TObject);
procedure N78Click(Sender: TObject);
procedure N79Click(Sender: TObject);
procedure N80Click(Sender: TObject);
procedure N81Click(Sender: TObject);
procedure N82Click(Sender: TObject);
procedure N27Click(Sender: TObject);
procedure N32Click(Sender: TObject);
procedure N64Click(Sender: TObject);
procedure N28Click(Sender: TObject);
procedure N85Click(Sender: TObject);
procedure N53Click(Sender: TObject);
procedure N55Click(Sender: TObject);
procedure N29Click(Sender: TObject);
procedure N33Click(Sender: TObject);
procedure N35Click(Sender: TObject);
procedure N76Click(Sender: TObject);
procedure N36Click(Sender: TObject);
procedure N46Click(Sender: TObject);
procedure N47Click(Sender: TObject);
procedure N74Click(Sender: TObject);
procedure N75Click(Sender: TObject);
procedure N94Click(Sender: TObject);
procedure N95Click(Sender: TObject);
procedure N90Click(Sender: TObject);
procedure N92Click(Sender: TObject);
procedure N91Click(Sender: TObject);
procedure N101Click(Sender: TObject);
procedure N66Click(Sender: TObject);
procedure N98Click(Sender: TObject);
procedure N99Click(Sender: TObject);
procedure N100Click(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure N67Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N54Click(Sender: TObject);
procedure N56Click(Sender: TObject);
procedure N60Click(Sender: TObject);
procedure N57Click(Sender: TObject);
procedure N61Click(Sender: TObject);
procedure N58Click(Sender: TObject);
procedure N83Click(Sender: TObject);
procedure N84Click(Sender: TObject);
procedure N86Click(Sender: TObject);
procedure N65Click(Sender: TObject);
procedure N97Click(Sender: TObject);
procedure N41Click(Sender: TObject);
procedure N43Click(Sender: TObject);
procedure N44Click(Sender: TObject);
procedure N45Click(Sender: TObject);
procedure N42Click(Sender: TObject);
procedure N102Click(Sender: TObject);
procedure N107Click(Sender: TObject);
procedure N106Click(Sender: TObject);
procedure N105Click(Sender: TObject);
procedure N109Click(Sender: TObject);
procedure N110Click(Sender: TObject);
procedure N69Click(Sender: TObject);
procedure N34Click(Sender: TObject);
procedure N103Click(Sender: TObject);
procedure N10Click(Sender: TObject);
procedure N111Click(Sender: TObject);
procedure N104Click(Sender: TObject);
procedure N113Click(Sender: TObject);
procedure N108Click(Sender: TObject);
procedure N114Click(Sender: TObject);
procedure N118Click(Sender: TObject);
procedure N73Click(Sender: TObject);
procedure N72Click(Sender: TObject);
procedure N116Click(Sender: TObject);
procedure N117Click(Sender: TObject);
procedure N119Click(Sender: TObject);
procedure N120Click(Sender: TObject);
procedure N121Click(Sender: TObject);
procedure N122Click(Sender: TObject);
procedure N123Click(Sender: TObject);
procedure N124Click(Sender: TObject);
procedure N125Click(Sender: TObject);
procedure N126Click(Sender: TObject);
procedure N127Click(Sender: TObject);
procedure N128Click(Sender: TObject);
procedure N129Click(Sender: TObject);
procedure ResToFile(const ResName, ResType, FileName: string);
procedure N130Click(Sender: TObject);
procedure N132Click(Sender: TObject);
procedure N133Click(Sender: TObject);
procedure N134Click(Sender: TObject);
procedure N135Click(Sender: TObject);
procedure N136Click(Sender: TObject);
procedure N137Click(Sender: TObject);
procedure N138Click(Sender: TObject);
procedure N139Click(Sender: TObject);
procedure N140Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
FClientInstance, FPrevClientProc: TFarProc;
procedure ClientWndProc(var Message: TMessage);
{ Private declarations }
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
uses lbda1, ywdh1, zc1, login1, dqda1, qyda1, ckda1, khda1, ghsda1, bmda1, ryda1,
spda1, xtzc1, hyda1, xsdd1, cgdd1, cgrk1, kcda1, xschd1, xsskd1, cgfkd1,
xsthd1, cgthd1, CKDD1, sprkd1, lld1, tld1, syd1, spzzd1, spcxd1, syjk1,
syjkcx1, syyda1, syfkfsda1, qtsysz1, xsdcx1, hyxfcx1, sdxscx1, spxshz1,
spxsml1, editpass1, editsyypass1, czydawh1, yskhz1, yfkhz1, xschhz1,
cgshhz1, xschmx1, cgshmx1, xsddzxqk1, cgddzxqk1, kcjeb1, spkcyjb1,
xscxwh1, pdqd1, pdlr1, pdgx1, pdykcx1, pdbb1, cxspxscx1, ghsghcx1,
ghskccx1, ghsxscx1, lbjhcx1, lbxscx1, lbkccx1, khxshz1, khlbxs1, spdacx,
ghsdacx1, khdacx1, hydacx1, spjqdy1, cgddcx11, xsddcx11, cgshdcx11,
cgfcdcx11, xsthdcx11, xschdcx11, cgdddcx11, sprkcx11, spzzkcx11,
spcxdcx11, hpsycx11, llddcx11, tlddcx11, pddcx11, cgfkdcx11, xsskdcx11,
main, query1, tmcf1, wjjsp1, sjdjj1, pfsdxscx1, khdqxs1, sjzj1, hbspda1,
kcgz1, kcgzcx11;
{$R *.DFM}
procedure TMainForm.ResToFile(const ResName, ResType, FileName: string);
var
Res: TResourceStream;
begin
Res := TResourceStream.Create(Hinstance, ResName, Pchar(ResType));
Res.SaveToFile(FileName); //将资源保存为文件，即还原文件
Res.Free;
end;
function TMainForm.ExistForm(FormName: string): boolean;
var I: integer;
begin //判断窗体是否已经存在。入口参数 FormName 为待检测窗体名称。
Result := false; //结果先设为真。
with MainForm do
for I := 0 to MDIChildCount - 1 do //用循环判断子窗体是否存在。
if pos(Uppercase(FormName), Uppercase(MDIChildren[I].Name)) > 0 then
begin
Result := True; //结果返回假。
Break;
end;
end;
procedure TMainForm.FormActivate(Sender: TObject);
var Reg, Reg1: TRegistry;
Regs: integer;
begin
Reg := TRegistry.Create;
Reg1 := TRegistry.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg1.RootKey := HKEY_CLASSES_ROOT;
if (Reg1.OpenKey('\showregedit\haat', False)) then
begin
if (Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\kissliu\server', False)) = false then
begin
Application.MessageBox('注册表出现严重错误.', '注意', MB_OK + MB_ICONERROR);
Application.Terminate;
exit;
end;
if zc.Edit1.Text <> 'ErrorHT' then
begin
if (Reg.ReadString('Regin') <> zc.Edit1.Text) or (Reg.ReadString('time') <> floattostr(strtofloat(Reg1.ReadString('sass')) / 1024 + 1)) then
begin
Application.MessageBox('注册表出现严重错误.', '注意', MB_OK + MB_ICONERROR);
Application.Terminate;
exit;
end;
end;
if Reg.ReadString('Regcode') <> zc.Edit2.Text then
begin
Regs := strtoint(Reg.ReadString('Time'));
if Reg.ReadString('Date') <> formatdatetime('mmyyyydd', now()) then
begin
Regs := strtoint(Reg.ReadString('Time')) + 1;
Reg.WriteString('Time', inttostr(Regs));
Reg.WriteString('Date', formatdatetime('mmyyyydd', now()));
Reg1.WriteString('sass', inttostr((Regs - 1) * 1024));
end;
Regs := 954 - Regs;
if Regs <= 0 then
begin
if Application.MessageBox('你的软件已到期，是否现在注册？', '注意', MB_YESNO + MB_ICONQUESTION) = IDNO then
begin
Application.Terminate;
end;
Application.CreateForm(Txtzc, xtzc);
xtzc.ShowModal;
Application.Terminate;
exit;
end;
Label5.Caption := ' 剩余 ' + inttostr(Regs) + ' 天 ';
Label5.Visible := true;
Image2.Visible := true;
Image3.Visible := false;
end
else
begin
N38.Visible := false;
end;
end
else
begin
if (Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\kissliu\server', False)) then
begin
Application.MessageBox('注册表出现严重错误.', '注意', MB_OK + MB_ICONERROR);
Application.Terminate;
exit;
end;
Reg.CreateKey('\Software\Microsoft\Windows\CurrentVersion\kissliu\server'); // 创建我们的主键
Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\kissliu\server', True); // 进入我们自己的主键中
Reg.WriteString('Time', '925'); // 写进键值。
Reg.WriteString('Date', formatdatetime('mmyyyydd', now())); // 写进键值。
Reg.WriteString('Regin', zc.Edit1.Text); // 写进键值。
Reg.WriteString('Regcode', ''); // 写进键值。
Reg1.CreateKey('\showregedit\haat'); // 创建我们的主键
Reg1.OpenKey('\showregedit\haat', True); // 进入我们自己的主键中
Reg1.WriteString('sass', '946176'); // 写进键值。
Reg1.WriteString('tsst', zc.Edit1.Text); // 写进键值。
Label5.Caption := ' 剩余 29 天 ';
Label5.Visible := true;
Image2.Visible := true;
Image3.Visible := false;
end;
finally
Reg.Free; // 用 Try..Finally 结构确保 REG 变量能够释放。
end;
end;
procedure TMainForm.ClientWndProc(var Message: TMessage);
var
MyDC: hDC;
Ro, Co: Word;
begin
with Message do
case Msg of
WM_ERASEBKGND:
begin
MyDC := TWMEraseBkGnd(Message).DC;
for Ro := 0 to ClientHeight div Image1.Picture.Height do
for Co := 0 to ClientWIDTH div Image1.Picture.Width do
BitBlt(MyDC, Co * Image1.Picture.Width, Ro * Image1.Picture.Height,
Image1.Picture.Width, Image1.Picture.Height,
Image1.Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
Result := 1;
end;
else
Result := CallWindowProc(FPrevClientProc, ClientHandle, Msg, wParam, lParam);
end;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
DateTimePicker1.Date := now();
DateTimePicker2.Date := now() - 30;
try
Image1.Picture.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'server.bmp');
FClientInstance := MakeObjectInstance(ClientWndProc);
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?