ucommfunc.pas

中式财务栏 表格式录入 运行时设置可显示列、列名、列宽

{*******************************************************}
{                                                       }
{       公用函数                                        }
{                                                       }
{       版权所有 (C) 2007 咏南工作室                    }
{                                                       }
{*******************************************************}

unit uCommFunc;

interface

uses
  SysUtils, Forms, Windows, Controls, Messages, Dialogs, db, Classes,
  ComObj,IniFiles,ShellAPI,WinSock,TypInfo,DBCtrls;

//==============================================================================
// INI文件
//==============================================================================

Function ReadIniFile(const FileName,Section, Ident:string;
  Default: string):string; overload;
Function ReadIniFile(const FileName,Section, Ident:string;
  Default: integer):integer; overload;
Function ReadIniFile(const FileName,Section, Ident:string;
  Default: Double):Double; overload;
Function ReadIniFile(const FileName,Section, Ident:string;
  Default: Boolean):Boolean; overload;
Function ReadIniFile(const FileName,Section, Ident:string;
  Default: TdateTime):TdateTime; overload;

procedure WriteIniFile(const FileName,Section, Ident:string;
  Value:string);overload;
procedure WriteIniFile(const FileName,Section, Ident:string;
  Value:integer);overload;
procedure WriteIniFile(const FileName,Section, Ident:string;
  Value:Double);overload;
procedure WriteIniFile(const FileName,Section, Ident:string;
  Value:Boolean);overload;
procedure WriteIniFile(const FileName,Section, Ident:string;
  Value:TdateTime);overload;

//==============================================================================
// 字符串
//==============================================================================
function StrToStrEx(Value: string; strflag: string;Len: Integer;
  FillChar: Char = '0'): string;
function FindStr(ShortStr: String; LongStrIng: String): Integer;
{ 人民币小写转大写 }
function RMB(AMoney: Double): String;
{ 四舍五入 }
function RoundEx (const Value: Double): integer;
{ 得到汉字拼音助记码 }
function GetPy(const AHzStr: string): string;
{ 条形码 }
function EAN13(t_str: string): string;
{ 打开网址 }
procedure OpenURL(URL: string);
function GetAppPath: string;
function GetINIFile:string;
function GetMDB:string;

//==============================================================================
// 日期时间
//==============================================================================

function GetYear(Date: TDate): string;
function GetMonth(Date: TDate): string;
function GetDay(ADate: TDate): string;
procedure CheckDate(aDate: string);
{ 得到当前日期 }
function GetCurDate: string;

Function GetLocateIp(InternetIp:Boolean=False):String;

//==============================================================================
// 其它
//==============================================================================
{ 是否查询所有 }
procedure IsSelAll(aStr: string);
{ 通用窗口创建 }
procedure OpenChildForm(FormClass:TFormClass;var Form:TForm;Mark:Integer=0);
{ 将部分内存放进虚拟内存里 }
procedure ClearMemory;
{
  提供一个系统空闲时间函数（ms）,你可以用timer控件定时监测，
  如果系统空闲时间超过指定时间则做你想做的事：
  系统空闲-指系统无任何操作，包括键盘和鼠标）
}
function LastInput:dword;
{ 设置默认输入法 }
procedure SetImeA(AOwner:TForm);
{ 通用对话框 }
procedure InfoA(AStr:string);
procedure WarnA(AStr:string);
procedure ErrorA(AStr:string);
procedure QuestionA(AStr:string);
{ 汉化DBNavigator }
procedure CHNDBNavigatorA(ADBNavigator:TDBNavigator);

implementation

uses
  uDialog;

var
  myinifile:TIniFile;

procedure CHNDBNavigatorA(ADBNavigator:TDBNavigator);
var
  i:Integer;
begin
  with ADBNavigator do
  begin
    for I:=0 to ComponentCount-1   do
    begin
      if Components[I] is TNavButton then
      begin
        case TNavButton(Components[I]).Index of
            nbFirst:   TNavButton(Components[I]).Caption   :=   '首笔';
            nbPrior:   TNavButton(Components[I]).Caption   :=   '上笔';
            nbNext:    TNavButton(Components[I]).Caption   :=   '下笔';
            nbLast:    TNavButton(Components[I]).Caption   :=   '末笔';
            nbInsert:  TNavButton(Components[I]).Caption   :=   '新增';
            nbDelete:  TNavButton(Components[I]).Caption   :=   '删除';
            nbEdit:    TNavButton(Components[I]).Caption   :=   '修改';
            nbPost:    TNavButton(Components[I]).Caption   :=   '保存';
            nbCancel:  TNavButton(Components[I]).Caption   :=   '取消';
            nbRefresh: TNavButton(Components[I]).Caption   :=   '刷新';
        end;
      end;
    end;
  end;
  ADBNavigator.ShowHint:=False;
end;  

procedure InfoA(AStr:string);
begin
  Info(AStr);
end;  

procedure WarnA(AStr:string);
begin
  Warn(AStr);
end;    

procedure ErrorA(AStr:string);
begin
  Error(AStr);
end;    

procedure QuestionA(AStr:string);
begin
  Question(AStr);
end;  

{ 设置默认输入法 }
procedure SetImeA(AOwner:TForm);
var
  i:Integer;
begin
  for i := 0 to AOwner.ComponentCount - 1 do
    if GetPropInfo(AOwner.Components[i],'ImeName')<>nil then
      SetPropValue(AOwner.Components[i],'ImeName',
        ReadIniFile(getinifile,'ime','imename',''));
end;

function LastInput:dword;
var
  LInput: TLastInputInfo;
begin
  LInput.cbsize := sizeof(TLastInputInfo);
  GetLastInputInfo(LInput);
  result := GetTickCount - LInput.dwtime;
end;  


procedure ClearMemory;
begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then  //指定Win32平台的标识符
  begin
    SetProcessWorkingSetSize(GetCurrentProcess, $FFFFFFFF, $FFFFFFFF);
    Application.ProcessMessages;
  end;
end;

//获取本机IP地址
Function GetLocateIp(InternetIp:Boolean=False):String;
type
  TaPInAddr = Array[0..10] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  phe: PHostEnt;
  pptr: PaPInAddr;
  Buffer: Array[0..63] of Char;
  I: Integer;
  GInitData: TWSAData;
  IP: String;
begin
  Screen.Cursor := crHourGlass;
  try
    WSAStartup($101, GInitData);
    IP:='0.0.0.0';
    GetHostName(Buffer, SizeOf(Buffer));
    phe := GetHostByName(buffer);
    if phe = nil then
    begin
      ShowMessage(IP);
      Result:=IP;
      Exit;
    end;
    pPtr := PaPInAddr(phe^.h_addr_list);
    if InternetIp then
    begin
      I := 0;
      while pPtr^[I] <> nil do
      begin
        IP := inet_ntoa(pptr^[I]^);
        Inc(I);
      end;
    end
    else
      IP:=StrPas(inet_ntoa(pptr^[0]^));
    WSACleanup;
    Result:=IP;//如果上网则为上网ip否则是网卡ip
  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure OpenURL(URL: string);
begin
  ShellExecute(0, nil, PAnsiChar(URL), nil, nil, SW_NORMAL);
end;

function EAN13(t_str: string): string;   
var
  s: array[2..13] of integer;
  answer: string;
begin
  t_str:=trim(t_str);
  result:='';
  //空格跳出
  if length(t_str) < 12 then
    exit;
  s[13] := strtointdef(t_str[1], -1);
  s[12] := strtointdef(t_str[2], -1);
  s[11] := strtointdef(t_str[3], -1);
  s[10] := strtointdef(t_str[4], -1);
  s[9] := strtointdef(t_str[5], -1);
  s[8] := strtointdef(t_str[6], -1);
  s[7] := strtointdef(t_str[7], -1);
  s[6] := strtointdef(t_str[8], -1);
  s[5] := strtointdef(t_str[9], -1);
  s[4] := strtointdef(t_str[10], -1);
  s[3] := strtointdef(t_str[11], -1);
  s[2] := strtointdef(t_str[12], -1);
  if s[13] < 0 then exit;
  if s[12] < 0 then exit;
  if s[11] < 0 then exit;
  if s[10] < 0 then exit;
  if s[9] < 0 then exit;
  if s[8] < 0 then exit;
  if s[7] < 0 then exit;
  if s[6] < 0 then exit;
  if s[5] < 0 then exit;
  if s[4] < 0 then exit;
  if s[3] < 0 then exit;
  if s[2] < 0 then exit;
  answer := inttostr((s[2] + s[4] + s[6] + s[8] + s[10] + s[12]) * 3 +
   s[3] + s[5] + s[7] + s[9] + s[11] + s[13]);