clockoptions.~pas

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

unit ClockOptions;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Gb2Big5, EastRiver, Grids, StdCtrls, ComCtrls, Mask, PrjConst;

type
  TEditEx=class(TEdit)
    private
      FAlignment: TAlignment;
    protected
      procedure SetAlignment(Value: TAlignment);
      procedure CreateParams(var Params: TCreateParams); override;
    published
      property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
  end;
  
  TdlgOptions = class(TForm)
    PageControl2: TPageControl;
    tsClockMode: TTabSheet;
    gbWorkMode: TGroupBox;
    cbA0: TCheckBox;
    cbA1: TCheckBox;
    cbA2: TCheckBox;
    GroupBox4: TGroupBox;
    cbB0: TCheckBox;
    cbB1: TCheckBox;
    cbA7: TCheckBox;
    cbA6: TCheckBox;
    cbA3: TCheckBox;
    GroupBox5: TGroupBox;
    cbA4511: TRadioButton;
    cbA4501: TRadioButton;
    cbA4510: TRadioButton;
    cbA450: TRadioButton;
    GroupBox6: TGroupBox;
    cbB2: TCheckBox;
    cbC4: TCheckBox;
    cbB765101: TCheckBox;
    GroupBox7: TGroupBox;
    cbB765000: TRadioButton;
    cbB765011: TRadioButton;
    cbB765100: TRadioButton;
    tsOther: TTabSheet;
    gbCardLen: TGroupBox;
    Label4: TLabel;
    Label20: TLabel;
    edDispLen: TEdit;
    edDataLen: TEdit;
    gbBrushSpace: TGroupBox;
    lbBrushSpace1: TLabel;
    lbRepeatSpace1: TLabel;
    lbBrushSpace2: TLabel;
    lbRepeatSpace2: TLabel;
    edBrushSpace: TEdit;
    edRepeatSpace: TEdit;
    gbBrushPeriods: TGroupBox;
    sbAddClockTime: TButton;
    sbDelClockTime: TButton;
    sbReWriteClockTime: TButton;
    lvClockTime: TListView;
    gbRingTimes: TGroupBox;
    sbAddRingTime: TButton;
    sbDelRingTime: TButton;
    sbReWriteRingTime: TButton;
    lvRingTime: TListView;
    tsICCard: TTabSheet;
    gbGroupCheck: TGroupBox;
    Label25: TLabel;
    Label40: TLabel;
    edGroup: TEdit;
    cbGroupStation: TComboBox;
    rbOneMany: TRadioButton;
    rbManyMany: TRadioButton;
    tsFonts: TTabSheet;
    GroupBox15: TGroupBox;
    Label11: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label39: TLabel;
    btnTransFont: TButton;
    cbFontLib: TComboBox;
    edBeginPage: TEdit;
    edPageCount: TEdit;
    edFindChar: TEdit;
    dgFontDots1: TDrawGrid;
    btnQueryFont: TButton;
    btnOk: TButton;
    btnCancel: TButton;
    gbSaveBlock: TGroupBox;
    Label36: TLabel;
    Label37: TLabel;
    Label38: TLabel;
    cbCardType: TComboBox;
    cbSector: TComboBox;
    cbPassword: TComboBox;
    msg: TLabel;
    cbB3: TCheckBox;
    cbUseClockTime: TCheckBox;
    Label12: TLabel;
    meLockTime: TMaskEdit;
    Label19: TLabel;
    tsDisplay: TTabSheet;
    GroupBox1: TGroupBox;
    edNormalMsg: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    edBrushMsg: TEdit;
    GroupBox2: TGroupBox;
    edNotification: TMemo;
    cbWordWrap: TCheckBox;
    chbCLS: TCheckBox;
    edShowTime: TEdit;
    Label9: TLabel;
    lbMsgUnit: TLabel;
    btnSendMsg: TButton;
    Label3: TLabel;
    edFirstWinMsg: TEdit;
    cbB4: TCheckBox;
    RadioButton1: TRadioButton;
    Label5: TLabel;
    Label6: TLabel;
    edRight: TMaskEdit;
    edError: TMaskEdit;
    GroupBox3: TGroupBox;
    cbPeriod: TCheckBox;
    cbStarMac: TCheckBox;
    procedure btnOkClick(Sender: TObject);
    procedure btnQueryFontClick(Sender: TObject);
    procedure dgFontDots1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure btnTransFontClick(Sender: TObject);
    procedure PageControl2Change(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure edBrushSpaceExit(Sender: TObject);
    procedure sbAddClockTimeClick(Sender: TObject);
    procedure sbDelClockTimeClick(Sender: TObject);
    procedure sbAddRingTimeClick(Sender: TObject);
    procedure sbReWriteRingTimeClick(Sender: TObject);
    procedure sbReWriteClockTimeClick(Sender: TObject);
    procedure rbOneManyClick(Sender: TObject);
    procedure rbManyManyClick(Sender: TObject);
    procedure cbGroupStationChange(Sender: TObject);
    procedure cbA0Click(Sender: TObject);
    procedure meLockTimeChange(Sender: TObject);
    procedure edRWTimeOutExit(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure cbFontLibChange(Sender: TObject);
    procedure cbCardTypeChange(Sender: TObject);
    procedure PageControl2Changing(Sender: TObject;
      var AllowChange: Boolean);
    procedure sbDelRingTimeClick(Sender: TObject);
    procedure cbA450Click(Sender: TObject);
    procedure cbUseRingTimeClick(Sender: TObject);
    procedure edRepeatSpaceExit(Sender: TObject);
    procedure btnSendMsgClick(Sender: TObject);
    procedure chbCLSClick(Sender: TObject);
    procedure edFirstWinMsgKeyPress(Sender: TObject; var Key: Char);
    procedure edNormalMsgKeyPress(Sender: TObject; var Key: Char);
    procedure edBrushMsgKeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
    bRuning, ReadedExtProp: Boolean;
    FontStream: TMemoryStream;
    Dots1: array[0..$F, 0..$F]of Boolean;//汉字点阵
    FontFileName: string;
    procedure ReadClockerTimes;
    procedure SaveClockerTimes;
    procedure ReadRingTimes;
    procedure SaveRingTimes;
  public
    { Public declarations }
    pclk: PClockInfo;
    fmsg: string;
  end;

var
  dlgOptions: TdlgOptions;

implementation

uses Hints, Main, ClockTime, RingTime, Functions;

{$R *.DFM}

const
  JFFileName='Eep040JT.bin';
  FFFileName='Eep040FT.bin';

procedure TEditEx.SetAlignment(Value: TAlignment);
begin
  if Value<>FAlignment then
  begin
    FAlignment:=Value;
    ReCreateWnd;
  end;
end;

procedure TEditEx.CreateParams(var Params: TCreateParams);
const
   Alignments: array[TAlignment] of DWORD=(ES_LEFT,ES_RIGHT,ES_CENTER);
begin
  inherited CreateParams(Params);
  Params.Style:=Params.Style or Alignments[FAlignment];
end;

procedure TdlgOptions.ReadClockerTimes;
var
  i, Num: Integer;
  Strs: TStrings;
  S: string;
  ClockerTimes: array[0..3] of TClockerTime;
begin
  lvClockTime.Items.Clear;
  Num:=ReadClockerTime(pclk.hPort, ClockerTimes);
  if Num>0 then
    with lvClockTime do
    begin
      for i:=0 to Num-1 do
      begin
        with Items.Add do
        begin
          Caption:=ClockerTimes[i].StartTime;
          SubItems.Add(ClockerTimes[i].EndTime);
        end;
      end;
  //    AlphaSort;
    end
  else
  begin
    Strs:=TStringList.Create;
    try
      fIni.ReadSectionValues(format(SBrushSec, [pclk.port, pclk.clock_id]), Strs);
      for i:=0 to Strs.Count-1 do
      begin
        with lvClockTime.Items.Add do
        begin
          S:=GetStrSection(Strs[i], 2, ['=']);
          Caption:=Copy(S, 1, 4);
          SubItems.Add(Copy(S, 6, 4));
        end;
      end;
    finally
      Strs.Free;
    end;
  end;
end;

procedure TdlgOptions.SaveClockerTimes;
var
  i: Integer;
begin
  begin
    fIni.EraseSection(format(SBrushSec, [pclk.port, pclk.clock_id]));
    for i:=0 to lvClockTime.Items.Count-1 do
    begin
      fini.WriteString(format(SBrushSec, [pclk.port, pclk.clock_id]), IntToStr(i), lvClockTime.Items[i].Caption+'-'+lvClockTime.Items[i].SubItems[0]);
    end;
  end;
end;

procedure TdlgOptions.ReadRingTimes;
var
  i, Num: Integer;
  S: string;
  Ringtimes: array[0..31]of TRingTime;
  Strs: TStrings;
begin
  lvRingTime.Items.Clear;
  Num:=ReadRing(pclk.hPort, RingTimes);
  if Num>0 then
  with lvRingTime do
  begin
    for i:=0 to Num-1 do
    begin
      with Items.Add do
      begin
        Caption:=IntToStr(RingTimes[i].hour);
        SubItems.Add(IntToStr(RingTimes[i].minute));
        SubItems.Add(IntToStr(RingTimes[i].second));
        SubItems.Add(IntToStr(RingTimes[i].RingTimeLen));
      end;
    end;
//    AlphaSort;
  end else
  begin
    Strs:=TStringList.Create;
    try
      fIni.ReadSectionValues(format(SRingTimeSec, [pclk.Port, pclk.clock_id]), Strs);
      for i:=0 to Strs.Count-1 do
      begin
        with lvRingTime.Items.Add do
        begin
          S:=GetStrSection(Strs[i], 2, ['=']);
          Caption:=Copy(S, 1, 2);
          SubItems.Add(Copy(S, 3, 2));
          SubItems.Add(Copy(S, 5, 2));
          SubItems.Add(Copy(S, 7, 2));
        end;
      end;
    finally
      Strs.Free;
    end;
  end;
end;

procedure TdlgOptions.SaveRingTimes;
var
  i: Integer;
begin
//  if lvRingTime.Items.Count>0 then
  begin
    fIni.EraseSection(format(SRingTimeSec, [pclk.port, pclk.clock_id]));
    for i:=0 to lvRingTime.Items.Count-1 do
    begin
      fini.WriteString(format(SRingTimeSec, [pclk.Port, pclk.clock_id]), IntToStr(i), lvRingTime.Items[i].Caption +
        lvRingTime.Items[i].SubItems[0]+lvRingTime.Items[i].SubItems[1]+lvRingTime.Items[i].SubItems[2]);
    end;
  end;
end;

procedure TdlgOptions.btnQueryFontClick(Sender: TObject);
var
  Position, x, y, qq, ww: Integer;
  Buf1: array[0..$F]of Byte;
  Buf2: array[0..$F]of Byte;
  S: String;
begin
  if Length(edFindChar.Text)>0 then
  begin
    S:=edFindChar.Text;
    if GetAcp=950 then S:=Big5ToGB(S);
    qq:=Ord(S[1]);
    ww:=Ord(S[2]);
    if (qq>$A0) and (ww>$A0) then
    begin
      edBeginPage.Text:=IntToStr(($1000+((qq - $A1) * 94 + (ww - $A1)) * 32) div $100);
      Position := $1000+((qq - $A1) * 94 + (ww - $A1)) * 32;
      FontStream.Position:=Position;
      FontStream.Read(Buf1, $10);
      FontStream.Read(Buf2, $10);
    end
    else
    begin
      Position := qq*$10;
      FontStream.Position:=Position;
      FontStream.Read(Buf1, $10);
      Position := ww*$10;
      FontStream.Position:=Position;
      FontStream.Read(Buf2, $10);
    end;

    for x:=0 to 7 do
      for y:=0 to 7 do
        Dots1[x, y]:=(Buf1[x] and (1 shl y))<>0;

    for x:=0 to 7 do
      for y:=8 to $F do
        Dots1[x, y]:=(Buf1[x+8] and (1 shl (y-8)))<>0;

    for x:=8 to $F do
      for y:=0 to $7 do
        Dots1[x, y]:=(Buf2[x-8] and (1 shl y))<>0;

    for x:=8 to $F do
      for y:=8 to $F do
        Dots1[x, y]:=(Buf2[x] and (1 shl (y-8)))<>0;
        
    dgFontDots1.Invalidate;
  end;
end;

procedure TdlgOptions.dgFontDots1DrawCell(Sender: TObject; ACol,
  ARow: Integer; Rect: TRect; State: TGridDrawState);
begin
  if (ARow<$10)and(ACol<$10) then
  begin
    if Dots1[ACol, ARow] then
    begin
      dgFontDots1.Canvas.Brush.Color:=clRed;
      dgFontDots1.Canvas.FillRect(Rect);
    end else
    begin
      dgFontDots1.Canvas.Brush.Color:=dgFontDots1.Brush.Color;
      dgFontDots1.Canvas.FillRect(Rect);
    end;
  end;
end;

procedure TdlgOptions.btnTransFontClick(Sender: TObject);
label
  Err;
var
  Beginps, ps: Integer;
  buf: array[0..$FF]of char;
  S, SaveCaption: String;
  timebegin: TDateTime;
  SaveCursor: TCursor;
begin
  if bRuning then
  begin
    bRuning:=False;
    Exit;
  end;
  if Assigned(pclk) and (pclk.hPort<>0) then
  begin
    bRuning:=True;
    if not Assigned(dlgHints) then dlgHints:=TdlgHints.Create(Self);
    dlgHints.msg.Caption:='';
    dlgHints.Show;