function.pas

功能包中的大部分功能模块为本人自己所写。。部分收录我的网友的作品及网上比较精典的程序段。

  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]))
               or ((Arow=1) and (aCol in [12,13,3]))
               or ((Arow=0) and (aCol in [13])) then
  begin
      canvas.Font.Color:=clwhite;
      Canvas.Brush.Color:=clGray;
      Canvas.FillRect(ARect);
   end;
    Canvas.TextRect(ARect, ARect.Left+2, ARect.Top+2, Cells[ACol, ARow]);
  inherited DrawCell(ACol, ARow, ARect, AState);
end;

{----------------------------------}
{重载SelectCell处理                }
{当某一个格被选中时。处理按键值发送}
function TvirtualKeyBoard.SelectCell(ACol, ARow: Integer): Boolean;
 var
  KeyStr:string;
  keyHex:word;
//  fn:Tfun;
begin
// Fn:=Tfun.Create(self);
 KeyStr:=cells[aCol,aRow];
 if assigned(FVkeyDown) then OnSelectCell(self,keyStr);
 if FSendHandle<>nil then
 begin
    if  KeyStr='' then keyHex:=0 else keyHex:=ord(keystr[1]);
      case  AnsiIndexStr(KeyStr,[',','.','↙','←']) of
        0:keyHex:=188;
        1:keyHex:=VK_DECIMAL;
        2:keyHex:=vk_return;//回车
        3:keyHex:=VK_Back;//退格键
      end;
      DoBleep(500,100);
      Fn.SendKey(FSendHandle.Handle,keyHex);
   end;
// fn.Free;
 result:=true
end;

procedure TvirtualKeyBoard.SetSendHandle(Control: TWinControl);
begin
   if FSendHandle <> Control then FSendHandle := Control;
end;

                    {TExChart }
//==============================================================================
// TExChart:增强型的TChar组件，因为数据采集系统中老用到TChart，
//但标准的TChart功能上有点那个，HOHO,就加强加强.实际项目中用的十分方便
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//==============================================================================
procedure TExChart.DrawMouseLine(var Message: Tmessage);
var
 // Fn:Tfun;
  ChartIndex:integer;
  MousePos:Tpoint;
begin
if FDrawMouseLineFlag then
begin
  // Fn:=Tfun.Create(self);
  if self.SeriesCount>0 then
  begin
     ChartIndex:=Fn.ChartMoveLine(self,message.LParamLo,FDrawMouseLineColor);
    if (Series[0].Count>0) and (ChartIndex<>-1) then
    begin
      MousePos.X:=message.LParamLo;
      MousePos.Y:=Message.LParamHi;
        //FYLableDraw是用户表示FYLable显示的flag
      if FYLableDraw then
       Canvas.TextOut(3,3,FYLableCaption+FloatTostr(self.Series[0].YValue[ChartIndex])+FYLableunit);
     if assigned(FChartYIndex) then
       OnMouseMove(nil,ChartIndex,MousePos.X,MousePos.Y,Series[0].YValue[ChartIndex]);
     end;// if (Series[0].Count>0) and (ChartIndex<>-1) then
   //  Fn.Free;
   end;//if self.SeriesCount>0 then
end;//if FDrawMouseLineFlag then
end;
//------------------------------------------------------------------------------
procedure TExChart.SetDrawMouseLineFlag(Flag: Boolean);
begin
  if FDrawMouseLineFlag<>Flag then  FDrawMouseLineFlag:=Flag
end;
//------------------------------------------------------------------------------
procedure TExChart.SetDrawMouseLineColor(Color: TColor);
begin
 if FDrawMouseLineColor<>Color then FDrawMouseLineColor:=Color
end;
//------------------------------------------------------------------------------
{设置用与现实Y坐标上的值得lable的名字}
procedure TExChart.SetYLableCaption(caption:String);
begin
  if FYLableCaption<>caption then
     FYLableCaption:=caption;
end;
//______________________________________________________________________________
procedure TExChart.SetYLableUnit(UnitValue: String);
begin
     if FYLableUnit<>UnitValue then
     FYLableUnit:=UnitValue;
end;
//------------------------------------------------------------------------------
procedure TExChart.SetYLableDraw(Flag: boolean);
begin
   if Flag<>FYLableDraw then  FYLableDraw:=Flag
end;
{-----------------------------}
{创建时的默认设置             }
{-----------------------------}
constructor TExChart.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
   FDrawMouseLineFlag:=True;
   FDrawMouseLineColor:=clBlue;
   FYLableDraw:=True;
   FYLableCaption:='电压:';
   FYLableUnit:='(V)';
end;

{==============================================================================}
{ TExEdit}
{将回车转为Tab}
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
{===============================================================================}
constructor TExEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  LabelPosition:= lpLeft;
end;
//------------------------------------------------------------------------------
procedure TExEdit.SetCaption(const Value: string);
begin
  FCaption := Value;
  self.EditLabel.Caption:=FCaption;
end;
//------------------------------------------------------------