function.pas

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

  Result := GetWindow(Result, GW_CHILD);
  SetLength(S, 40);
  GetClassName(Result, PChar(S), 39);
  if PChar(S) <> 'SysListView32' then Result := 0;
end;
//______________________________________________________________________________

{----------------TIconHintX------------------}
{    重载ActivateHint，调整输出字符长度      }
{--------------------------------------------}
procedure TIconHintX.ActivateHint(Rect: TRect; const AHint: string);
type
  TAnimationStyle = (atSlideNeg, atSlidePos, atBlend);
const
  AnimationStyle: array[TAnimationStyle] of Integer = (AW_VER_NEGATIVE,
    AW_VER_POSITIVE, AW_BLEND);
var
  Animate: BOOL;
  Style: TAnimationStyle;
  pos:Tpoint;
begin
  GetCursorPos(Pos);
  FActivating := True;
  try
    Caption :='  '+AHint; (*前面价2个空格让图标可以正常显示*)
    Inc(Rect.right,12);
    Inc(Rect.Bottom,4);
    UpdateBoundsRect(Rect);
    if Rect.Top + Height > Screen.DesktopHeight then
      Rect.Top := Screen.DesktopHeight - Height;
    if Rect.Left + Width > Screen.DesktopWidth then
      Rect.Left := Screen.DesktopWidth - Width;
    if Rect.Left < Screen.DesktopLeft then Rect.Left := Screen.DesktopLeft;
    if Rect.Bottom < Screen.DesktopTop then Rect.Bottom := Screen.DesktopTop;
    SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top, Width, Height,SWP_NOACTIVATE);
    if (GetTickCount - FLastActive > 250) and (Length(AHint) < 100) and
       Assigned(AnimateWindowProc) then
    begin
      SystemParametersInfo(SPI_GETTOOLTIPANIMATION, 0, @Animate, 0);
      if Animate then
      begin
        SystemParametersInfo(SPI_GETTOOLTIPFADE, 0, @Animate, 0);
        if Animate then
          Style := atBlend
        else
          if Pos.Y > Rect.Top then
            Style := atSlideNeg
          else
            Style := atSlidePos;
        AnimateWindowProc(Handle, 100, AnimationStyle[Style] or AW_SLIDE);
      end;
    end;
    ParentWindow := Application.Handle;
    ShowWindow(Handle, SW_SHOWNOACTIVATE);
    Invalidate;
  finally
    FLastActive := GetTickCount;
    FActivating := False;
  end;
end;
//______________________________________________________________________________
{function TIconHintX.CalcHintRect(MaxWidth: Integer; const AHint: string;
  AData: Pointer): TRect;
var
  Hicon:TBitmap;
begin
  Hicon:=TBitmap.Create;
  Hicon.LoadFromResourceName(Hinstance,'HICON');
 //-----
  Result := inherited CalcHintRect(MaxWidth,AHint, AData);
  Result.Right := (Length(AHint) * 5) + Hicon.Width*4;
  Result.Bottom := (Hicon.Height)+4;
  Hicon.Free;
end;    }
//______________________________________________________________________________

procedure TIconHintX.Paint;
var
  Hicon:TBitmap;
  R: TRect;
begin
  inherited;
  R := ClientRect;
  Inc(R.Left, 20);
  Inc(R.Top, 2);
  //-------
  Hicon:=TBitmap.Create;
  Hicon.LoadFromResourceName(Hinstance,'HICON');
  color:=$00EEFDF2;
  Canvas.Draw(1,1,Hicon);
  SendMessage(Handle, WM_NCPAINT, 0, 0); //画提示栏边框
  Hicon.Free;
end;
//______________________________________________________________________________

{-------------------------------}
{     设置parent窗体的字体      }
{-------------------------------}
procedure TFun.SetParentWinDefFont(Sender:TObject;const defFont: Tfont);
begin
   if defFont=nil then
   begin;
     {设置默认}
     TForm(Sender as TComponent).Font.Name:='宋体';
     TForm(Sender as TComponent).Font.Size:=9;
     TForm(Sender as TComponent).Font.Height:=-12;
     TForm(Sender as TComponent).Font.Color:=clblack;
     TForm(Sender as TComponent).Font.Charset:=GB2312_CHARSET
   end else
     (*用户定义*)
     TForm(Sender as TComponent).Font:=defFont
end;
//______________________________________________________________________________

{---------------------------}
{      计算x的Y次方         }
{---------------------------}
function TFun.Squ(X, Y: integer): integer;
var
  i,sum:integer;
begin
  sum:=1;
  for i:=1 to Y do  sum:=sum*X;
  result:=sum
end;
{浮点型}
function TFun.Squ(X: Double; Y: integer): Double;
var
  i:integer;
  dsum:double;
begin
  dsum:=1;
  for i:=1 to Y do  dsum:=dsum*X;
  result:=dsum
end;
//______________________________________________________________________________

{-------------------------------------------------------}
{在指定的chart控件上画1条数直线，并返回mouse所在的index }
{处理鼠标在Chart里移动的过程，在最近的数据点上画一直线，}
{X表示是鼠标的X坐标位置，iValueIdx是回传的数据点索引号  }
{chart的index 从0开始的。。要注意                       }
{-------------------------------------------------------}
Function TFun.ChartMoveLine(Chart:Tobject;MousePos_X:Integer;LineColor:TColor):integer;
Var
  i,x:Integer;
  iXPosition,iValueIdx,iValueCount:Integer;
  dXValue : Double;
begin
  x:=MousePos_X;
  iValueIdx:=-1;
  iValueCount:=TChart(Chart as TComponent).Series[0].count;
  if iValueCount<>0 then
  begin
        dXValue := TChart(Chart as TComponent).Series[0].XScreenToValue(X);
        if dXValue <= TChart(Chart as TComponent).Series[0].XValue[0] then
          iValueIdx := 0
        else if dXValue >= TChart(Chart as TComponent).Series[0].XValue[iValueCount-1] then
          iValueIdx := iValueCount-1
        else
        for i:=1 to iValueCount-1 do
          if (dXValue >= TChart(Chart as TComponent).Series[0].XValue[i-1]) and (dXValue <= TChart(Chart as TComponent).Series[0].XValue[i]) then
          begin
            if (dXValue-TChart(Chart as TComponent).Series[0].XValue[i-1])<(TChart(Chart as TComponent).Series[0].XValue[i]-dXValue) then
              iValueIdx := i-1
            else
              iValueIdx := i;
            break;
          end;
        dXValue := TChart(Chart as TComponent).Series[0].XValue[iValueIdx];
        iXPosition := TChart(Chart as TComponent).BottomAxis.CalcXPosValue(dXValue);
        TChart(Chart as TComponent).Repaint;
        With TChart(Chart as TComponent).Canvas do
        begin
          Pen.Width:=1;
          Pen.Style:=psSolid;
          Pen.Color:=LineColor;
          with TChart(Chart as TComponent) do
          begin
            MoveTo(iXposition,ChartRect.Top);
            LineTo(iXPosition,ChartRect.Bottom );
          end;//with TChart(Chart as TComponent) do
        end;
      end;// if iValueCount<>0 then
     result:=iValueIdx;//返回mouse所在的chart上的index
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