functions.pas

一个Delphi写的跟考勤机门禁机收款机的接品软件源码

unit Functions;

interface

uses
  Windows, SysUtils, Controls, Classes, Forms, StdCtrls, Dialogs,
  Graphics, Mask;

  type
    TEditAccess=class(TEdit)
  public
    class procedure FOnKeyPress(Sender: TObject;var Key: Char);
  end;

  procedure SetGroupControlState(GroupBox: TWinControl; State: Boolean);
  function GetStrSection(const Str1: string; Section: Integer;const Seperators: TSysCharSet=[',']): string;
  function SplitString(const S: string;var args: array of string;const Seperators: TSysCharSet=[#9]): Boolean;
  function TransToGB(const Value: string): string;
  function TransFromGB(const Value: string): string;
  function MsgBox(Handle: HWND;const Text, Caption: string; uType: UINT): Integer;overload;
  function MsgBox(const Text: string; Flags: Longint=MB_ICONINFORMATION): Integer;overload;
  function CheckHandle(hPort: THandle): Boolean;
  function InputQuery(const ACaption, APrompt: string;var Value: string; MaxLen: Integer=0;const ValidChars: TSysCharSet=[#0..#$FF];const mask: string=''): Boolean;
  function MyStrToTime(StrTime: string): TDateTime;
  function TimeToMyStr(Time: TDateTime): string;
  procedure ClearIDList(List: TList);
  function GetSysCommPorts: string;
  function StrsToPeriods(const Strs: TStrings; var Periods: string): Boolean;
  function PeriodsToStrs(var Strs: TStrings; const PeriodBytes: string): Boolean;



implementation
uses
  EastRiver, GB2Big5, PrjConst;
  
var
  FValidChars: TSysCharSet=[#0..#255];

procedure SetGroupControlState(GroupBox: TWinControl; State: Boolean);
var
  i: Integer;
begin
  for i:=0 to GroupBox.ControlCount-1 do
    if GroupBox.Controls[i] is TControl then
    begin
      GroupBox.Controls[i].Enabled:=State;
      if GroupBox.Controls[i] is TWinControl then
        SetGroupControlState(GroupBox.Controls[i] as TWinControl, State);
    end;
end;

function GetStrSection(const Str1: string; Section: Integer;const Seperators: TSysCharSet): string;
var
  i, ct,
    head, tail: Integer;
begin
  ct := 0;
  tail := 0;
  for i := 1 to Length(Str1) do
  begin
    if Str1[i] in Seperators then
    begin
      head := tail;
      tail := i;
      inc(ct);
      if ct=Section then
      begin
        Result := Copy(Str1, head+1, tail-head-1);
        Break;
      end;
    end
    else if (ct=Section-1)and(i=Length(Str1)) then
    begin
      Result := Copy(Str1, tail+1, i-tail);
    end;
  end;
  Result := Trim(Result);
end;

function TransToGB(const Value: string): string;
begin
  if GetAcp=950 then Result:=Big5ToGB(Value) else Result:=UnicodeCht2Chs(Value);
end;

function TransFromGB(const Value: string): string;
begin
  if GetAcp=950 then Result:=GBToBig5(Value) else Result:=Value;
end;

function SplitString(const S: string;var args: array of string;const Seperators: TSysCharSet=[#9]): Boolean;
var
  i, ct, head, tail: Integer;
begin
  ct := 0;
  tail := 0;
  Result:=False;
  FillChar(Args, SizeOf(Args), 0);
  if Length(args)=0 then Exit;
  for i := 1 to Length(S) do
  begin
    if S[i] in Seperators then
    begin
      head := tail;
      tail := i;
      Args[Low(Args)+ct] := Copy(S, head+1, tail-head-1);
      inc(ct);
    end
    else if (i=Length(S)) then
    begin
      Args[Low(Args)+ct]:=Copy(S, tail+1, i-tail);
      Inc(ct);
      Break;
    end;
    if ct>High(Args) then Break;
  end;
  Result:=ct>0;
end;

function MsgBox(Handle: HWND;const Text, Caption: string; uType: UINT): Integer;
begin
  Result:=MessageBox(Handle, PChar(Text), PChar(Caption), uType);
end;

function MsgBox(const Text: string; Flags: Longint): Integer;
var
  Caption: string;
begin
  if (Flags and MB_ICONWARNING)<>0 then
    Caption:=msg_warning
  else if (Flags and MB_ICONERROR)<>0 then
    Caption:=msg_error
  else if (Flags and MB_ICONQUESTION)<>0 then
    Caption:=msg_confirm
  else Caption:=msg_information;
  if Assigned(Screen.ActiveForm) then
    Result:=MessageBox(Screen.ActiveForm.Handle, PChar(Text), PChar(Caption), Flags)
  else
    Result:=Application.MessageBox(PChar(Text), PChar(Caption), Flags);
end;

const
  winspl='winspool.drv';

function EnumPorts(pName: PAnsiChar; Level: DWORD; pPorts: Pointer; cbBuf: DWORD;
  var pcbNeeded, pcReturned: DWORD): BOOL; stdcall; external winspl name'EnumPortsA';

function GetSysCommPorts: string;
type
  PPortInfo1=^TPortInfo1;
  TPortInfo1=record
    pName: PAnsiChar;
  end;
var
  BytesNeeded, Returned, I: DWORD;
  Success: Boolean;
  PortsPtr: Pointer;
  InfoPtr: PPortInfo1;
  TempStr: string;
begin
  Success := EnumPorts(nil, 1, nil, 0, BytesNeeded, Returned);

  if (not Success)and(GetLastError=ERROR_INSUFFICIENT_BUFFER) then
  begin
    GetMem(PortsPtr, BytesNeeded);
    try
      Success := EnumPorts(nil, 1, PortsPtr, BytesNeeded, BytesNeeded, Returned);
      if Success then
        for I := 0 to Returned-1 do
        begin
          InfoPtr := PPortInfo1(DWORD(PortsPtr)+I*SizeOf(TPortInfo1));
          TempStr := Copy(InfoPtr^.pName, 1, 4);
          if Pos('COM', TempStr)<>0 then
          begin
            Result := Result+TempStr+#10;
          end
        end;
    finally
      FreeMem(PortsPtr);
    end;
  end;
end;

procedure ClearIDList(List: TList);
var
  i: Integer;
begin
  for i := List.Count-1 downto 0 do
    if Assigned(List[i]) then
      Dispose(List[i]);
  List.Clear;
end;

function CheckHandle(hPort: THandle): Boolean;
begin
  Result:=(hPort<>INVALID_HANDLE_VALUE)and(hPort<>0);
end;

function GetAveCharSize(Canvas: TCanvas): TPoint;
var
  I: Integer;
  Buffer: array[0..51] of Char;
begin
  for I := 0 to 25 do
    Buffer[I] := Chr(I+Ord('A'));
  for I := 0 to 25 do
    Buffer[I+26] := Chr(I+Ord('a'));
  GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
  Result.X := Result.X div 52;
end;

class procedure TEditAccess.FOnKeyPress(Sender: TObject;var Key: Char);
begin
  if not (Key in FValidChars) then Key:=#0;
end;

function InputQuery(const ACaption, APrompt: string;var Value: string; MaxLen: Integer=0;const ValidChars: TSysCharSet=[#0..#$FF];const mask: string=''): Boolean;
var
  Form: TForm;
  Prompt: TLabel;
  Edit: TMaskEdit;
  DialogUnits: TPoint;
  ButtonTop, ButtonWidth, ButtonHeight: Integer;
begin
  Result := False;
  Form := TForm.Create(Application);
  with Form do
  try
    Font := Application.MainForm.Font;
    Canvas.Font := Font;
    DialogUnits := GetAveCharSize(Canvas);
    BorderStyle := bsDialog;
    Caption := ACaption;
    ClientWidth := MulDiv(180, DialogUnits.X, 4);
    ClientHeight := MulDiv(63, DialogUnits.Y, 8);
    Position := poScreenCenter;
    Prompt := TLabel.Create(Form);
    with Prompt do
    begin
      Parent := Form;
      AutoSize := True;
      Left := MulDiv(8, DialogUnits.X, 4);
      Top := MulDiv(8, DialogUnits.Y, 8);
      Caption := APrompt;
    end;
    Edit := TMaskEdit.Create(Form);
    with Edit do
    begin
      if MaxLen>0 then MaxLength:=MaxLen
      else MaxLength:=255;
      if ValidChars<>[] then
        FValidChars:=ValidChars;
      Edit.EditMask:=Mask;
      OnKeyPress:=TEditAccess.FOnKeyPress;
      Parent := Form;
      Left := Prompt.Left;
      Top := MulDiv(19, DialogUnits.Y, 8);
      Width := MulDiv(164, DialogUnits.X, 4);
      Text := Value;
      SelectAll;
    end;
    ButtonTop := MulDiv(41, DialogUnits.Y, 8);
    ButtonWidth := MulDiv(50, DialogUnits.X, 4);
    ButtonHeight := MulDiv(16, DialogUnits.Y, 8);
    with TButton.Create(Form) do
    begin
      Parent := Form;
      Caption := SOKCaption;
      ModalResult := mrOk;
      Default := True;
      SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth,
        ButtonHeight);
    end;
    with TButton.Create(Form) do
    begin
      Parent := Form;
      Caption := SCancelCaption;
      ModalResult := mrCancel;
      Cancel := True;
      SetBounds(MulDiv(92, DialogUnits.X, 4), ButtonTop, ButtonWidth,
        ButtonHeight);
    end;
    if ShowModal=mrOk then
    begin
      Value := Edit.Text;
      Result := True;
    end;
  finally
    Form.Free;
  end;
end;

function MyStrToTime(StrTime: string): TDateTime;
//时间字符串格式:32:45
var
  tmpStr: string;
  tmpVar: Integer;
  tmpTime: TDateTime;
  Day, Hour, Min: WORD;
begin
  Result := 0;
  try
    StrTime := Trim(StrTime);
    if Length(StrTime)=5 then
    begin
      if StrTime[3]=TimeSeparator then
      begin
        tmpStr := Copy(StrTime, 1, 2);
        tmpVar := StrToIntDef(tmpStr, 0);
        Day := tmpVar div 24;
        Hour := tmpVar mod 24;
        tmpStr := Copy(StrTime, 4, 2);
        tmpVar := StrToIntDef(tmpStr, 0);
        Min := tmpVar;
        tmpTime := EncodeTime(Hour, Min, 0, 0);
        ReplaceDate(tmpTime, Day);
        Result := tmpTime;
      end;
    end
    else if Length(StrTime)=4 then //中间无时间分隔符
    begin
      tmpStr := Copy(StrTime, 1, 2);
      tmpVar := StrToIntDef(tmpStr, 0);
      Day := tmpVar div 24;
      Hour := tmpVar mod 24;
      tmpStr := Copy(StrTime, 3, 2);
      tmpVar := StrToIntDef(tmpStr, 0);
      Min := tmpVar;
      tmpTime := EncodeTime(Hour, Min, 0, 0);
      ReplaceDate(tmpTime, Day);
      Result := tmpTime;
    end;
  except
    Result := -1;
  end;
end;

function TimeToMyStr(Time: TDateTime): string;
var
  Day, Hour, Min, Sec, Msec: WORD;
  tmpStr: string;
begin
  if Time>=100/24 then
    Exit;
  if Time<0 then
    Exit;
  try
    Day := WORD(Trunc(Time));
    DecodeTime(Time, Hour, Min, Sec, MSec);
    Hour := Day*24+Hour;
    tmpStr := format('%.2u', [Hour]);
    Result := tmpStr+TimeSeparator;
    tmpStr := format('%.2u', [Min]);
    Result := Result+tmpStr;
  except
    Result := '';
  end;
end;

function StrsToPeriods(const Strs: TStrings; var Periods: string): Boolean;
var
  i, y: Integer;
  Buf: array[0..5] of Byte;
  TimeBegin, TimeEnd: TDateTime;
begin
  Result := False;
  if Assigned(Strs) then
  begin
    SetLength(Periods, 12);
    FillChar(Buf, Length(Buf), 0);
    for i := 0 to Strs.Count-1 do
    begin
      TimeBegin := MyStrToTime(Copy(Strs[i], 1, 5));
      TimeEnd := MyStrToTime(Copy(Strs[i], 6, 5));
      if (TimeEnd>0)and(TimeEnd>TimeBegin) then
        for y := Round(TimeBegin*48)to Round(TimeEnd*48)-1 do
        begin
          Buf[y div 8] := ((Buf[y div 8])or(1 shl(y mod 8)));
        end;
    end;
    for i := 0 to 5 do
    begin
      StrMove(@Periods[i*2+1], PChar(IntToHex(Buf[i], 2)), 2);
    end;
    Result := True;
  end;
end;

function PeriodsToStrs(var Strs: TStrings; const PeriodBytes: string): Boolean;
var
  i, head, tail: Integer;
  TimeBegin, TimeEnd: TDateTime;
  Buf: array[0..6] of Byte;
begin
  Result := False;
  tail := -1;
  if Assigned(Strs) then
  begin
    Strs.Clear;
    if PeriodBytes='' then
    begin
      Strs.Add(TimeToMyStr(0)+TimeToMyStr(1));
      Exit;
    end;
    HexToBin(PChar(PeriodBytes), @Buf, Length(PeriodBytes));
    Buf[6] := 0;
    for i := 0 to 48 do
    begin
      if ((Buf[i div 8])and(1 shl(i mod 8)))=0 then
      begin
        head := tail+1;
        tail := i;
        if (tail>head) then
        begin
          TimeBegin := head/48;
          TimeEnd := (tail)/48;
          if TimeEnd>=TimeBegin then
          begin
            Strs.Add(TimeToMyStr(TimeBegin)+TimeToMyStr(TimeEnd));
          end;
        end;
      end;
    end;
    Result := True;
  end;
end;


end.