myfun.pas

西门子Prodave6.0 的Delphi 版本, 需要安装 Prodave60软件,支持以太网通讯

  for i:=1 to Y do  dsum:=dsum*X;
  result:=dsum
end;
//______________________________________________________________________________


//_______________________________________________________________________________
{-------------------------}
{让程序开机时自动运行     }
{写注册表的run            }
{-------------------------}
procedure TFun.AutoRunByReg(FileName:string);
var
   reg:Tregistry;
   fP:string;
begin
  if FileName='' then fp:=application.Title;
   reg:=TRegistry.Create;
   reg.RootKey:=HKEY_LOCAL_MACHINE;
   if reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Run',true) then
   begin
      reg.WriteString(fp,application.exeName);
   end;
   reg.CloseKey;
   reg.Free;
end;
//-------------------------------------------------------------------------------
//删除regKey===>Autorun
procedure TFun.DelAutoRunByReg(KeyName: string);
var
   reg:Tregistry;
   sKey:string;
begin
  if KeyName='' then sKey:=application.Title;
   reg:=TRegistry.Create;
   reg.RootKey:=HKEY_LOCAL_MACHINE;
   if reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Run',false) then
   begin
      reg.DeleteValue(sKey)
   end;
   reg.CloseKey;
   reg.Free;
end;
//______________________________________________________________________________
{------------------------}
{最小化系统所有的窗体    }
{------------------------}
procedure TFun.MinWinAll;
var 
  h:HWnd; 
begin 
  h:=application.Handle; 
  while h > 0 do 
  begin 
  if isWindowVisible(h) then 
     postmessage(h,WM_SYSCOMMAND,SC_MINIMIZE,0);
     h:=getnextwindow(h,GW_HWNDNEXT); 
  end;
end;
//______________________________________________________________________________

{---------------------}
{       关闭所有窗体  }
{---------------------}
procedure TFun.CloseWinAll;
var 
  h:HWnd; 
begin 
  h:=application.Handle;
  while h > 0 do
  begin 
    if isWindowVisible(h) and (H<>application.Handle)
                          and (H<>FindWindow('Progman', nil))
    then postmessage(h,WM_Close,0,0);
    h:=getnextwindow(h,GW_HWNDNEXT);
  end;
end;
//_______________________________________________________________________________
{----------------------}
{给窗体加个边框        }
{----------------------}
procedure TFun.DrawWindowRect(handle: Thandle;wColor:Tcolor;PenWidth:integer);
var
  dc : hDc;
  Pen : hPen;
  OldPen : hPen;
  OldBrush : hBrush;
  WinR:TwinRect;
begin
  GetWinRect(handle,WinR);
  dc := GetWindowDC(Handle);
  Pen := CreatePen(PS_SOLID,PenWidth,wColor);
  OldPen := SelectObject(dc,Pen);
  OldBrush := SelectObject(dc, GetStockObject(NULL_BRUSH));
  Rectangle(dc, 0,0, WinR.Width, WinR.Height);
  SelectObject(dc, OldBrush);
  SelectObject(dc, OldPen);
  DeleteObject(Pen);
  ReleaseDC(Handle,0);
end;
//_______________________________________________________________________________
{----------------------------------------------------}
{         InI文件操作函数集                          }
{可利用fun1.GetAppPath('mytest.ini')得到完整的ini目录}
{----------------------------------------------------}
{------------read Integer------------}
function TFun.ReadIniFile(const FileName, Section, Ident: string;
  Default: integer): integer;
begin
  myIniFile:=TiniFile.Create(FileName);
  result:=myIniFile.ReadInteger(Section,Ident,Default);
  myIniFile.FreeInstance;
end;
{------------read string------------}
function TFun.ReadIniFile(const FileName, Section, Ident: string;
  Default: string): string;
begin
  myIniFile:=TiniFile.Create(FileName);
  result:=myIniFile.ReadString(Section,Ident,Default);
  myIniFile.FreeInstance;
end;
{------------read Boolean------------}
function TFun.ReadIniFile(const FileName, Section, Ident: string;
  Default: Boolean): Boolean;
begin
  myIniFile:=TiniFile.Create(FileName);
  result:=myIniFile.ReadBool(Section,Ident,Default);
  myIniFile.FreeInstance;
end;
{------------read  Double------------}
function TFun.ReadIniFile(const FileName, Section, Ident: string;
  Default: Double): Double;
begin
  myIniFile:=TiniFile.Create(FileName);
  result:=myIniFile.ReadFloat(Section,Ident,Default);
  myIniFile.FreeInstance;
end;
{------------read DateTime-----------}
function TFun.ReadIniFile(const FileName, Section, Ident: string;
  Default: TdateTime): TdateTime;
begin
  myIniFile:=TiniFile.Create(FileName);
  result:=myIniFile.ReadDateTime(Section,Ident,Default);
  myIniFile.FreeInstance;
end;
//_________________________________________________________________________________
{------------Write Integer------------}
procedure TFun.WriteIniFile(const FileName, Section, Ident: string;
  Value: integer);
begin
  myIniFile:=TiniFile.Create(FileName);
  myIniFile.WriteInteger(Section,Ident,Value);
  myIniFile.FreeInstance;
end;
{------------Write String------------}
procedure TFun.WriteIniFile(const FileName, Section, Ident: string;
  Value: string);
begin
  myIniFile:=TiniFile.Create(FileName);
  myIniFile.WriteString(Section,Ident,Value);
  myIniFile.FreeInstance;
end;
{------------Write boolean------------}
procedure TFun.WriteIniFile(const FileName, Section, Ident: string;
  Value: Boolean);
begin
  myIniFile:=TiniFile.Create(FileName);
  myIniFile.WriteBool(Section,Ident,Value);
  myIniFile.FreeInstance;
end;
{------------Write Double------------}
procedure TFun.WriteIniFile(const FileName, Section, Ident: string;
  Value: Double);
begin
  myIniFile:=TiniFile.Create(FileName);
  myIniFile.WriteFloat(Section,Ident,Value);
  myIniFile.FreeInstance;
end;
{------------Write DateTime------------}
procedure TFun.WriteIniFile(const FileName, Section, Ident: string;
  Value: TdateTime);
begin
  myIniFile:=TiniFile.Create(FileName);
  myIniFile.WriteDateTime(Section,Ident,Value);
  myIniFile.FreeInstance;
end;
//______________________________________________________________________________
{procedure TFun.Destroy;
begin
  inherited destroy;
end;}
//______________________________________________________________________________

{--------------------}
{得到日期对应的时间  }
{--------------------}
function TFun.GetWeekOfChina(dDay: TdateTime): string;
var
  iwIndex:integer;
begin
  iwIndex:=dayOfweek(dDay);
  case iwIndex of
    1:result:='星期天';
    2:result:='星期一';
    3:result:='星期二';
    4:result:='星期三';
    5:result:='星期四';
    6:result:='星期五';
    7:result:='星期六';
  end;
end;
{--------------------------------------}
{星期一.....星期天: 1---7              }
{NND的外国人就喜欢用1表示星期天靠!不爽 }
{收以该位我们中国人习惯的1-7方式       }
{---------------------------------------}
function TFun.GetWeekOfNum(dDay: TdateTime): integer;
var
  iwIndex:integer;
begin
  iwIndex:=dayOfweek(dDay);
  if iwIndex=1 then iwIndex:=7 else iwIndex:=iwIndex-1;
  result:=iwIndex
end;
//________________________________________________________________________________________________________________________________________________________
{------------------------------------------------------}
{检测findStr是否in mainStr,如果存在则返回True,否则False}
{------------------------------------------------------}
function TFun.IsStrInOtherStr(mainStr,FindStr: string): Bool;
begin
 if strPos(pAnsiChar(mainStr),pAnsichar(FindStr))=nil
 then
   result:=False
 else
   result:=True;
end;
//______________________________________________________________________________
{--------------------------------------}
{利用GUID得到一个永远不会重复的随机序列}
{--------------------------------------}
function TFun.RandomNumByGUID:string;
var
  ID: TGUID;
begin
  if CreateGuid(Id) =0 then
  begin
    result:= GUIDToString(Id);
  end;
end;
//______________________________________________________________________________
{------------------------------}
{ 判断一个COM对像是否注册过    }
{------------------------------}
function TFun.IsCOMClassRegistered(GUID: TGUID): Boolean;
var
  COMGUID:String;
begin 
  with TRegistry.Create do 
  try 
    COMGUID:=GUIDToString(GUID);
    RootKey:=HKEY_CLASSES_ROOT;
    Result := OpenKey('\CLSID\'+COMGUID,False);
  finally 
    Free; 
  end;
end;
//______________________________________________________________________________
{-------------------------------------}
{           移去窗体的Title           }
{-------------------------------------}
procedure TFun.ReMoveWinTitle(Form:Tform);
begin
   SetWindowLong(Form.Handle,GWL_STYLE,
                GetWindowLong(Form.Handle,GWL_STYLE) and not WS_CAPTION);
  Form.Height:=Form.ClientHeight;
end;
//______________________________________________________________________________
{-------------------------------}
{判断BDE是否安装过。            }
{已安装返回True,否则为false     }
{-------------------------------}
function TFun.IsBDEInstalled: boolean;
var
  reg:Tregistry;
  s:string;
begin
   s:='';
   reg:=Tregistry.Create;
   reg.RootKey := HKEY_LOCAL_MACHINE;
   reg.OpenKey('SOFTWARE\Borland\Database Engine', False);
 try
    S:=reg.ReadString('CONFIGFILE01');
   //BDE installed
 finally
   if S<>'' then result:=True else result:=False;
   reg.CloseKey;
 end;
end;
//______________________________________________________________________________
{系统小喇叭发声}
procedure TFun.BeepEx(Freq: Word; MSecs: Integer);
begin
   DoBleep(Freq,MSecs); //DoBeep用户可调用过程头
end;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//==============================================================================
// 虚拟键盘，是由于本人从事数据采集系统的
// 工业电脑用的是触摸屏，写了这个，用这方便。呵呵。
//从TstrigGrid继承来的，，功能很有限，因为考虑到是用于6.5英寸的触摸屏上。
//没加其他标准的键盘功能。
//==============================================================================
{ TvirtualKeyBoard }
constructor TvirtualKeyBoard.Create(AOwner: TComponent);
const
   KeyStr:array[0..2,0..13] of string=(('7','8','9','A','B','C','D','E','F','G','H','I','J','←'),
                                      ('4','5','6','','K','M','N','L','O','P','Q','R','','↙'),
                                      ('0','1','2','3','.','S','T','U','V','W','X','Y','Z',','));
var
 i,j:integer;
begin
    inherited Create(AOwner);
    ScrollBars:=ssNone;
    Height:=96;
    Width:=438;
    self.Show;
    RowCount:=3;
    ColCount:=14;
    FixedCols:=0;
    FixedRows:=0;
    Ctl3D:=false;
    DefaultColwidth:=30;
    DefaultRowHeight:=30;
//    ,10,[B],GB2312_CHARSET,clWindowText
  //  font.Style:=[fsBold];
    font.Name:='宋体';
    font.Size:=16;
    font.Charset:=GB2312_CHARSET;
    //-----------------
    for i:=0 to RowCount-1 do
    begin
     for j:=0 to ColCount-1 do
     begin
        cells[j,i]:=KeyStr[i,j]
     end;
   end;
end;
{-------重载DrawCell着色----------}
procedure TvirtualKeyBoard.DrawCell(ACol, ARow: Integer; ARect: TRect;
  AState: TGridDrawState);
begin
  inherited;

  if (ACol<=2) or ((Arow=2) and (aCol in [13,3,4]))