u_util.pas

这是一个60吨地磅称量系统

unit U_UTIL;

interface

uses
  Classes, Dialogs, SysUtils, ExtCtrls, Graphics, Windows;
{function  Shell_NotifyIcon(DWMessage:WORD;lpData:TNotifyIconData):uint;Stdcall;

    type


       PNotifyIconData = ^TNotifyIconData;
       TNotifyIconData = record
          cbSize:DWORD;
          UID:UINT;
          Uflags:UINT;
          Wnd:HWND;
          UCallBackMessage:UINT;
          hIcon:HICON;
          szTip:array [0..63] of AnsiChar;
          end;
      const
            NIM_ADD=$00000000;
            NIM_DELETE=$00000001;
            NIM_MODIFY=$00000002;
function  Shell_NotifyIcon(DWMessage:WORD;lpData:PNotifyIconData):uint;Stdcall;//任务栏小图标函数

procedure ModifyTrayIcon(Action:DWORD);}
function  U_GetPort(p:word):byte; stdcall;
Procedure U_SetPort(p:word;b:byte);Stdcall;

function  U_DiskExist(Drive,Lang:Integer): Boolean;
function  U_FileExist(FileName: string; Hint:Boolean): Boolean;
function  U_FileExistOK(FileName: string; Hint:Boolean): Boolean;
procedure U_DelFile(FileName:string; Hint:Boolean);
function  U_CopyFile(SrcFileName, DestFileName:String; Hint:Boolean): Boolean;

function  U_CDayOfWeek(const InDate: TDateTime):string;
function  U_DirExist(Dir:String; Hint:Boolean):Boolean;
function  U_ChgDir(Dir:String; Hint:Boolean):Boolean;
function  U_MakeDir(Dir, SubDir:String; Hint:Boolean):Boolean;

procedure U_DrawLine(PaintBox:TPaintBox; X1,Y1,X2,Y2:Integer; Color:TColor; Style:TPenStyle);
procedure U_DrawText(PaintBox:TPaintBox; X,Y:Integer; Str:String; Color:TColor);
procedure U_PaintBoxInit(PaintBox:TPaintBox; XSec,YSec,MinY,MaxY,Left,Right,Top,Bottom,bkColor:Integer);
procedure U_PaintBoxDraw(PaintBox:TPaintBox; MinY,MaxY,X1,X2,Force:Integer; Y1,Y2:Double; sText:String; Color:TColor);

function U_IsNumberStr(Str:String):Boolean;
function U_IsDecStr(Str:String):Boolean;
function U_IsHexStr(Str:String):Boolean;
function U_IsFloatStr(Str:String):Boolean;
function U_ToDecStr(Int,Digit:Integer;AddChar:String):String;
function U_ToHexStr(Int,Digit:Integer;AddChar:String):String;
function U_ToFloatStr(Int,Digit:Integer;AddChar:String):String;
function U_DecStrToInt(Str:String):Integer;
function U_HexStrToInt(Str:String):Integer;
function U_FloatStrToInt(Str:String):Integer;
function U_StrToInt(Str:String):Integer;
function U_StrToFloat(Str:String):Extended;
function U_AddPreZero(Str:String;Len:Integer):String;
function U_AddPreBlank(Str:String;Len:Integer):String;
function U_AddLastBlank(Str:String;Len:Integer):String;

implementation


{procedure ModifyTrayIcon(Action:DWORD);//任务栏 小图标方法
          const
               VM_TRAYICON=VM_APP+0;
          var
             NIData:TNodifyIconData;
begin
     with NIData do
begin
     cbSize:=SizeOf(TNodifyIconData);
     UID:=0;
     Uflags:=NIF_MESSAGE or NIF_ICON or NIF_TIP;
     Wnd:=Handle;//鼠标事件，给Wnd窗口
     UCallBackMessage:=VM_TRAYICON;//使用同样的图标
     hIcon:=Application.Icon.Handle;//提示名字与文件名相同
     StrPcopy(SzTip.Application.Title);
     end;
     Shell_NotifyIcon(Action,@NIData);
     end; }

function U_GetPort(p:word):byte; stdcall;
begin
   asm
      push edx
      push eax
      mov  dx,p
      in   al,dx
      mov  @result,al
      pop  eax
      pop  edx
   end;
end;

Procedure U_SetPort(p:word;b:byte);Stdcall;
begin
   asm
      push edx
      push eax
      mov  dx,p
      mov  al,b
      out  dx,al
      pop  eax
      pop  edx
   end;
end;

function U_DiskExist(Drive,Lang:Integer): Boolean;
var
  R:Boolean;
begin
  R:=True;
  if DiskFree(Drive)<0 then
  begin
    if Lang<1 then
      SHOWMESSAGE('磁蝶机'+Chr(Ord('A')+Drive-1)+'没有磁盘，请插入磁盘')
    else
      SHOWMESSAGE('No Floppy in Disk '+Chr(Ord('A')+Drive-1));
    R:=False;
  end;
  Result:=R;
end;

function U_FileExist(FileName:string; Hint:Boolean): Boolean;
var
  F: File;
  R:Integer;
begin
  {$I-}
  AssignFile(F, FileName);
  FileMode := 0;
  Reset(F);
  R:=IOResult;
  if R=0 then CloseFile(F);
  {$I+}
  Result:= (R=0) and (FileName<>'');
  if (Result=False) and (Hint=True) then
     MessageDlg('档案'+FileName+'不存在！',mtInformation,[mbOk],0);
end;

function U_FileExistOk(FileName:string; Hint:Boolean): Boolean;
var
  F: File;
  R:Integer;
begin
  {$I-}
  AssignFile(F, FileName);
  FileMode := 0;
  Reset(F);
  R:=IOResult;
  if R=0 then
  begin
     R:=FileSize(F);
     if R<0 then R:=-1
     else        R:=0;
     CloseFile(F);
  end;
  {$I+}
  Result:= (R=0) and (FileName<>'');
  if (Result=False) and (Hint=True) then
     MessageDlg('档案'+FileName+'不存在！',mtInformation,[mbOk],0);
end;

procedure U_DelFile(FileName:string; Hint:Boolean);
var
  F: File;
begin
  if U_FileExist(FileName,False) then
  begin
    {$I-}
    AssignFile(F, FileName);
    Erase(F);
    {$I+}
    if Hint then SHOWMESSAGE('删除完成') ;
  end;
end;

function U_CopyFile(SrcFileName, DestFileName:String; Hint:Boolean): Boolean;
var
  SrcFile, DestFile:Integer;
  ChkRead, ChkWrite:Integer;
  Buffer:String[255];
begin
  Result:=False;
  if U_FileExistOk(SrcFileName,True)=False then Exit;
  DestFile:=FileCreate(DestFileName);
  if DestFile<0 then
  begin
    MessageDlg('生成档案'+DestFileName+'失败! ',mtInformation,[mbOk],0);
    Exit;
  end;
  SrcFile:=FileOpen(SrcFileName,0);
  Repeat
      ChkRead:=FileRead(SrcFile,Buffer,SizeOf(Buffer));
      ChkWrite:=FileWrite(DestFile,Buffer,ChkRead);
  until (ChkRead<>SizeOf(Buffer)) or (ChkWrite<>ChkRead);
  FileClose(DestFile);
  FileClose(SrcFile);
  Result:=True;
  if Hint then SHOWMESSAGE('拷贝完成') ;
end;

function U_CDayOfWeek(const InDate: TDateTime):string;
var
  WeekDay:integer;
begin
  WeekDay:=DayOfWeek(InDate);
  case WeekDay of
    1: result:='星期日';
    2: result:='星期一';
    3: result:='星期二';
    4: result:='星期三';
    5: result:='星期四';
    6: result:='星期五';
    7: result:='星期六';
  end;
end;

function U_DirExist(Dir:String; Hint:Boolean):Boolean;
var
  CurDir:String;
begin
  GetDir(0,CurDir);
  Result:=True;
  {$I-}
  ChDir(Dir);
  if IOResult<>0 then Result:=False;
  {$I+}
  ChDir(CurDir);
  if (Result=False) and (Hint=True) then
     MessageDlg('路径'+Dir+'不存在！',mtInformation,[mbOk],0);
end;

function U_ChgDir(Dir:String; Hint:Boolean):Boolean;
var
  CurDir:String;
  P, T:Integer;
begin
  GetDir(0,CurDir);
  Result:=True;
  {$I-}
  ChDir(copy(Dir,1,3));
  if IOResult <> 0 then Result:=False
  else
  begin
    if Length(Dir)>4 then
    begin
      Dir:=copy(Dir,4,Length(Dir)-3);
      P:=Pos('\',Dir);
      T:=1;
      while (P>0) and (T=1) do
      begin
        ChDir(copy(Dir,1,P-1));
        if IOResult <> 0 then
        begin
          Result:=False;
          T:=0;
        end
        else
        begin
          Dir:=copy(Dir,P+1,Length(Dir)-2);
          P:=Pos('\',Dir);
        end;
      end;
    end;
    if Result=True then
    begin
      ChDir(Dir);
      if IOResult <> 0 then Result:=False;
    end;
  end;
  if Result=False then
  begin
    ChDir(Copy(CurDir,1,3));
    ChDir(CurDir);
    if Hint=True then
      MessageDlg('目录'+Dir+'不存在！',mtWarning,[mbOk],0);
  end;
  {$I+}
end;

function U_MakeDir(Dir, SubDir:String; Hint:Boolean):Boolean;
var
  CurDir:String;
begin
  GetDir(0,CurDir);
  Result:=True;
  {$I-}
  if U_ChgDir(Dir,False)=True then
  begin
    ChDir(SubDir);
    if IOResult <> 0 then
    begin
      MkDir(SubDir);
      if IOResult <> 0 then Result:=False;
    end
  end
  else
    Result:=False;
  U_ChgDir(CurDir,False);
  if (Result=False) and (Hint=True) then
    MessageDlg('无法产生目录'+SubDir,mtWarning,[mbOk],0);
  {$I+}
end;
procedure U_DrawLine(PaintBox:TPaintBox; X1,Y1,X2,Y2:Integer; Color:TColor; Style:TPenStyle);
begin
  with PaintBox.Canvas do
  begin
    Pen.Color:=Color;
    Pen.Style:=Style;
    MoveTo(X1,Y1);
    LineTo(X2,Y2);
  end;
end;

procedure U_DrawText(PaintBox:TPaintBox; X,Y:Integer; Str:String; Color:TColor);
begin
  with PaintBox.Canvas do
  begin
    Font.Color:=Color;
    Font.Size:=8;
    Font.Name:='MS Sans Serif';
    TextOut(X,Y,Str);
  end;
end;

procedure U_PaintBoxInit(PaintBox:TPaintBox; XSec,YSec,MinY,MaxY,Left,Right,Top,Bottom,bkColor:Integer);
var
  i, AllY, XPeriod, YPeriod, lColor:INTEGER;
  OffY:Real;
  RectSize:Trect;
begin
  AllY:=MaxY-MinY;
  OffY:=AllY/YSec;
  with PaintBox do
  begin
    RectSize:=Rect(0,0,Width,Height);
    Canvas.Brush.Color:=bkColor;
    Canvas.FillRect(RectSize);
  end;
  if bkColor=clBLACK then lColor:=clWHITE
  else                    lColor:=clBLACK;

  XPeriod:=Trunc((Right-Left)/XSec);
  U_DrawLine(PaintBox,Left-1,Bottom,Right,Bottom,lColor,psSolid);//X-Axis
  YPeriod:=Trunc((Bottom-Top)/YSec);
  U_DrawLine(PaintBox,Left-1,Top,Left-1,Bottom,lColor,psSolid);  //Y-Axis

  for i:=0 to YSec do
  begin
    U_DrawLine(PaintBox,Left-4,Bottom-i*YPeriod,Left,Bottom-i*YPeriod,lColor,psSolid);
    if (AllY mod 10)<>0 then
      U_DrawText(PaintBox,Left-36,Bottom-i*YPeriod-6,Format('%5.1f',[MinY+OffY*i]),lColor)
    else
      U_DrawText(PaintBox,Left-36,Bottom-i*YPeriod-6,Format('%5.0f',[MinY+OffY*i]),lColor);
  end;
  {
  YPeriod:=Trunc((Bottom-Top)/20);
  if bkColor=clBLACK then
  begin
    for i:=1 to 20 do
    begin
      U_DrawLine(PaintBox,Left,Bottom-i*YPeriod,Right,Bottom-i*YPeriod,clNavy,psDot);
    end;
    for i:=1 to XSec do
    begin
      U_DrawLine(PaintBox,Left+i*XPeriod,Top,Left+i*XPeriod,Bottom-1,clNavy,psDot);
    end;
  end;
  }
end;

procedure U_PaintBoxDraw(PaintBox:TPaintBox; MinY,MaxY,X1,X2,Force:Integer; Y1,Y2:Double; sText:String; Color:TColor);
var
  Height:Integer;
  AllY:Double;
  Ys,Ye:Real;
begin
  if PaintBox=nil then Exit;
  AllY:=MaxY-MinY;
  Height:=PaintBox.Height-23;
  Ys:=Height-((Y1-MinY)*Height/AllY)+10;
  Ye:=Height-((Y2-MinY)*Height/AllY)+10;
  if sText='' then
  begin
    U_DrawLine(PaintBox,X1,Trunc(Ys),X2,Trunc(Ye),Color,psSolid);
  end
  else
  begin
    if Force=1 then U_DrawText(PaintBox,X1,Trunc(Ys)-6,sText,Color);
    if Force>1 then U_DrawText(PaintBox,X2,Trunc(Ye)-6,sText,Color);
    if Trunc(Ys)<>Trunc(Ye) then
    begin
      U_DrawText(PaintBox,X1,Trunc(Ys)-6,sText,Color);
      U_DrawText(PaintBox,X2,Trunc(Ye)-6,sText,Color);
    end;
//    U_DrawLine(PaintBox,X1,Trunc(Ys),X2,Trunc(Ye),Color,psDot);
    U_DrawLine(PaintBox,X1,Trunc(Ys),X2,Trunc(Ye),Color,psSolid);
  end;
end;

//  检查是否数字字符串
function U_IsNumberStr(Str:String):Boolean;
var
  i, Asc:Integer;
begin
  Result:=False;
  if Str='' then Exit;
  Result:=True;
  for i:=1 to Length(Str) do
  begin
    Asc:=Ord(Str[i]);
    if (Asc<Ord('0')) or (Asc>Ord('9')) then Result:=False;
  end;
end;

//检查是否十位数字串
function U_IsDecStr(Str:String):Boolean;
var
  i, Asc:Integer;
begin
  Result:=False;
  if Str='' then Exit;
  Result:=True;
  for i:=1 to Length(Str) do
  begin
    Asc:=Ord(Str[i]);
    if (Asc<Ord('0')) or (Asc>Ord('9')) then
    begin
      if (Asc<>Ord('-')) and (Asc<>Ord('+')) then Result:=False
      else if Length(Str)<2 then Result:=False;
    end;
  end;
end;

// 检查是否十六进制字串
function U_IsHexStr(Str:String):Boolean;
var
  i, Asc:Integer;
begin
  Result:=False;
  if Str='' then Exit;
  Result:=True;
  for i:=1 to Length(Str) do
  begin
    Asc:=Ord(Str[i]);
    if (Asc<Ord('0')) or (Asc>Ord('9')) then
    begin
      if (Asc<Ord('A')) or (Asc>Ord('F')) then Result:=False;
    end;
  end;
end;

//检查是否小数型字串
function U_IsFloatStr(Str:String):Boolean;
var
  i, Asc:Integer;
begin
  Result:=False;
  if Str='' then Exit;
  Result:=True;
  for i:=1 to Length(Str) do
  begin
    Asc:=Ord(Str[i]);
    if (Asc<Ord('0')) or (Asc>Ord('9')) then
    begin
      if (Asc<>Ord('-')) and (Asc<>Ord('+')) and (Asc<>Ord('.')) then Result:=False
      else if Length(Str)<2 then Result:=False;
    end;
  end;
end;

//转换成十进制字串
function U_ToDecStr(Int,Digit:Integer;AddChar:String):String;
begin
  Result:=Format('%d', [Int]);
  if Digit>0 then
  begin
    while Length(Result)<Digit do
    begin
      Result:=AddChar+Result;
    end;
  end;
end;

// 转换成十六进制字串
function U_ToHexStr(Int,Digit:Integer;AddChar:String):String;
begin
  Result:=Format('%x', [Int]);
  if Digit>0 then
  begin
    while Length(Result)<Digit do
    begin
      Result:=AddChar+Result;
    end;
  end;
end;

//转换成小数型字串
function U_ToFloatStr(Int,Digit:Integer;AddChar:String):String;
begin
  Result:=Format('%.1f', [Int]);
  if Digit>0 then
  begin
    while Length(Result)<Digit do
    begin
      Result:=AddChar+Result;
    end;
  end;
end;

//十进制字串转换成数字
function U_DecStrToInt(Str:String):Integer;
begin
  Result:=0;
  if U_IsDecStr(Str) then Result:=StrToInt(Str);
end;

//十六进制字串转换成数字
function U_HexStrToInt(Str:String):Integer;
var
  i, Asc:Integer;
begin
  Result:=0;
  if U_IsHexStr(Str) then
  begin
    for i:=1 to Length(Str) do
    begin
      Asc:=Ord(Str[i]);
      if Asc>Ord('9') then Asc:=Asc-Ord('A')+10
      else                 Asc:=Asc-Ord('0');
      Result:=Result*16+Asc;
    end;
  end;
end;

//字串转换成数字
function U_StrToInt(Str:String):Integer;
begin
  Result:=0;
  if U_IsDecStr(Str) then Result:=U_DecStrToInt(Str)
  else if U_IsHexStr(Str) then Result:=U_HexStrToInt(Str);
end;

// 字串转换成数字