uclass.pas

数据库试验题目

unit UClass;

interface
uses
  DBTables, SysUtils, StrUtils, DateUtils, ADODB, UPublic, Dialogs, ExtCtrls,
  Forms, StdCtrls, ClrBtn, Graphics;

type
  TCT = class(TObject)
  private
    sCTPF, sCTCK: string;
    iCTNR: integer;
  public
    function GetCTPF: string;
    function GetCTNR: integer;
    function GetCTCK: string;
    function GetCT: string;
    //箱号校验，成功返回真，否则返回假
    function ifChkPass: Boolean;
    procedure SetCTPF(CTPF: string);
    procedure SetCTNR(CTNR: integer);
    procedure SetCTCK(CTCK: string);
    procedure SetCT(CT: string);
  end;

  TDTTM = class(TObject)
  private
    sDate, sTime: string;
    function GetFillStr(sSrc: string; iLen: integer; sSgin: string; sFill: string): string;
  public
    function GetDateInt: integer;
    function GetTimeInt: integer;
    function GetDateStr: string;
    function GetTimeStr: string;
    function GetDateFmt: string;
    function GetTimeFmt: string;
    function GetDateTimeFmt: string;
    procedure SetDate(iDate: integer);
    procedure SetTime(iTime: integer);
    procedure SetFmtDateTime(sDateTime: string);
    function GetTimeShortFmt: string;
  end;
  //================================================================

  TLinkItem = class(TObject)
  private
    _Prev, _Next: TLinkItem;
    _Data: TObject;
    _Style: string;
  public
    constructor Create;
    property Prev: TLinkItem read _Prev write _Prev;
    property Data: TObject read _Data write _Data;
    property Next: TLinkItem read _Next write _Next;
    property Style: string read _Style write _Style;
    destructor Destroy;
  end;

  TLink = class(TObject)
  private
    _firstItem: TLinkItem;
    _Style: string;
  public
    constructor Create;
    procedure Add(NewData: TObject);
    procedure Del(DelData: TObject);
    function findItem(curData: TObject): TLinkItem;
    function GetFirst: TLinkItem;
    property Style: string read _Style write _Style;
    function GetCount: integer;
  end;

  TLightItem = class(TObject)
  private
    _Color, _FontColor, _LightColor, _LightFontColor: TColor;
    _ClrBtn: TClrBtn;
    procedure SetClrBtn(Value: TClrBtn);
  public
    constructor Create;
    property Color: TColor read _Color write _Color;
    property FontColor: TColor read _FontColor write _FontColor;
    property LightColor: TColor read _LightColor write _LightColor;
    property LightFontColor: TColor read _LightFontColor write _LightFontColor;
    property ClrBtn: TClrBtn read _ClrBtn write SetClrBtn;
    destructor Destroy;
  end;

  THighLight = class(TObject)
  private
    _DataLink: TLink;
    _Timer: TTimer;
    _Style: string;
    procedure timer(Sender: TObject);
    function GetLightTime: integer;
    procedure SetLightTime(Value: integer);
    function findItem(curData: TClrBtn): TLightItem;
  public
    constructor Create;
    property LightTime: integer read GetLightTime write SetLightTime;
    procedure Add(NewData: TClrBtn);
    procedure Del(DelData: TClrBtn);
    procedure Start;
    procedure Stop;
    function isHas(curData: TClrBtn): Boolean;
    function GetCount: integer;
  end;

  TTimeMsg = class(TObject)
  private
    _time: string;
    _msg: string;
    _level: string;
  public
    constructor Create;
    property time: string read _time write _time;
    property msg: string read _msg write _msg;
    property level: string read _level write _level;
  end;

implementation

//TCT------------------------------

function TCT.GetCTPF: string;
begin
  result := sCTPF;
end;

function TCT.GetCTNR: integer;
begin
  result := iCTNR;
end;

function TCT.GetCTCK: string;
begin
  result := sCTCK;
end;

function TCT.GetCT: string;
begin
  result := GetFillStr(sCTPF, 4, 'R', ' ') + GetFillStr(inttostr(iCTNR), 6, 'L', '0') + sCTCK;
end;

procedure TCT.SetCTPF(CTPF: string);
begin
  sCTPF := CTPF;
end;

procedure TCT.SetCTNR(CTNR: integer);
begin
  iCTNR := CTNR;
end;

procedure TCT.SetCTCK(CTCK: string);
begin
  sCTCK := CTCK;
end;

procedure TCT.SetCT(CT: string);
begin
  if CT='' then
  begin
    sCTPF:='';
    iCTNR:=0;
    sCTCK:='';
    exit;
  end;
  sCTPF := leftstr(CT, 4);
  iCTNR := strtoint(midstr(CT, 5, length(CT) - 5));
  sCTCK := copy(CT, 11,2);
end;

//TDTTM--------------------------------

function TDTTM.GetDateInt: integer;
begin
  result := strtoint(sdate);
end;

function TDTTM.GetTimeInt: integer;
begin
  result := strtoint(stime);
end;

function TDTTM.GetDateStr: string;
begin
  result := sdate;
end;

function TDTTM.GetTimeStr: string;
begin
  result := stime;
end;

function TDTTM.GetDateFmt: string;
var
  sY, sM, sD: string;
begin
  sy := leftstr(sdate, 4);
  sm := midstr(sdate, 5, 2);
  sd := rightstr(sdate, 2);
  result := sy + '-' + sm + '-' + sd;
end;

function TDTTM.GetTimeFmt: string;
var
  sH, sN, sS: string;
begin
  sh := leftstr(stime, 2);
  sn := midstr(stime, 3, 2);
  ss := rightstr(stime, 2);
  result := sh + ':' + sn + ':' + ss;
end;

function TDTTM.GetDateTimeFmt: string;
begin
  result := getdatefmt + ' ' + gettimefmt;
end;

procedure TDTTM.SetDate(iDate: integer);
begin
  sdate := inttostr(idate);
end;

procedure TDTTM.SetTime(iTime: integer);
var
  sTemp: string;
  i: integer;
begin
  stemp := '';
  for i := 1 to 6 - length(inttostr(itime)) do
    stemp := stemp + '0';
  stemp := stemp + inttostr(itime);
  stime := stemp;
end;

procedure TDTTM.SetFmtDateTime(sDateTime: string);
var
  sY, sM, sD, sh, sn, ss, smil: Word;
  dtTemp: TDateTime;
begin
  dttemp := strtodatetime(sdatetime);
  DecodeDateTime(dttemp, sy, sm, sd, sh, sn, ss, smil);
  sdate := getfillstr(inttostr(sy), 4, 'L', '0')
    + getfillstr(inttostr(sm), 2, 'L', '0')
    + getfillstr(inttostr(sd), 2, 'L', '0');
  stime := getfillstr(inttostr(sh), 2, 'L', '0')
    + getfillstr(inttostr(sn), 2, 'L', '0')
    + getfillstr(inttostr(ss), 2, 'L', '0');
end;

function TDTTM.GetFillStr(sSrc: string; iLen: integer; sSgin: string; sFill: string): string;
var
  i: integer;
  sTemp: string;
begin
  stemp := '';
  for i := 1 to ilen - length(sSrc) do
    stemp := stemp + sfill;
  if ilen - length(ssrc) < 0 then
  begin
    result := leftstr(ssrc, ilen);
    exit;
  end;
  if uppercase(ssgin) = 'L' then result := stemp + ssrc;
  if uppercase(ssgin) = 'R' then result := ssrc + stemp;
end;

function TDTTM.GetTimeShortFmt: string;
var
  sH, sN, sS: string;
begin
  sh := leftstr(stime, 2);
  sn := midstr(stime, 3, 2);
  ss := rightstr(stime, 2);
  result := sh + ':' + sn;
end;

//箱号校验，成功返回真，否则返回假
//参数：箱号

function TCT.ifChkPass: Boolean;
const ArrayOfConter: array[1..26] of integer = (10, 12, 13, 14, 15, 16, 17, 18, 19,
    20, 21, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 34, 35, 36, 37, 38);
var vconum, hdsz, vcon, res, c: string;
  dxsz, i, j, k, jj, rester, tot: longint;
begin
  vconum := GetCT;
  if length(TRIM(vconum)) <= 10 then
  begin
    messagedlg('箱号少于11位', mtInformation, [mbOk], 0);
    Result := false;
    abort;
  end;
  tot := 0;
  i := 1;

  while i <= 10 do //计算箱主代号及顺序号的加权乘积和
  begin
    vcon := copy(vconum, i, 1);
    jj := ord(vcon[1]) - 64;
    if jj < 0 then
      dxsz := StrToInt(vcon)
    else
      dxsz := ArrayOfConter[jj];
    j := 1;
    K := 1;
    while j < i do
    begin
      K := K * 2;
      j := j + 1;
    end;
    tot := tot + dxsz * K;
    i := i + 1;
  end;
  rester := tot mod 11;
  hdsz := '012345678910'; //判断集装箱号校验位
  if rester = 10 then
    res := copy(hdsz, 11, 2)
  else
    res := copy(hdsz, rester + 1, 1);

  c := Trim(Copy(vconum, 11, 2));

  if res = c then
    Result := true
  else
    Result := false;
end;

{ TLink }

procedure TLink.Add(NewData: TObject);
var
  curItem: TLinkItem;
begin
  curItem := TLinkItem.Create;
  curItem.Style := _Style;
  curItem.Data := NewData;
  if _firstItem = nil then
  begin
    _firstItem := curItem;
    _firstItem.Prev := nil;
  end
  else
  begin
    _firstItem.Prev := curItem;
    curItem.Next := _firstItem;
    _firstItem := curItem;
  end;
end;

constructor TLink.Create;
begin
  inherited Create;
  _firstItem := nil;
end;

procedure TLink.Del(DelData: TObject);
var
  curItem: TLinkItem;
begin
  curItem := findItem(DelData);
  if curItem = nil then exit;
  if _firstItem = curItem then
  begin
    _firstItem := curItem.Next;
  end
  else
  begin
    if curItem.Prev <> nil then
      curItem.Prev.Next := curItem.Next;
    if curItem.Next <> nil then
      curItem.Next.Prev := curItem.Prev;
  end;
  curItem.Destroy;
end;

function TLink.findItem(curData: TObject): TLinkItem;
var
  curItem: TLinkItem;
begin
  curItem := _firstItem;
  result := nil;
  while curItem <> nil do
  begin
    if curItem.Data = curData then
      result := curItem;
    curItem := curItem.Next;
  end;
end;

function TLink.GetCount: integer;
var
  curItem: TLinkItem;
  i: integer;
begin
  i := 0;
  curItem := _firstItem;
  while curItem <> nil do
  begin
    i := i + 1;
    curItem := curItem.Next;
  end;
  result := i;
end;

function TLink.GetFirst: TLinkItem;
begin
  result := _firstItem;
end;

{ TLinkItem }

constructor TLinkItem.Create;
begin
  inherited Create;
  _Prev := nil;
  _Data := nil;
  _Next := nil;
  _Style := 'NoFree';
end;

destructor TLinkItem.Destroy;
begin
  _Prev := nil;
  if _Style = 'Free' then _Data.Destroy
  else _Data := nil;
  _Next := nil;
  inherited Destroy;
end;

{ THighLight }

procedure THighLight.Add(NewData: TClrBtn);
var
  curItem: TLightItem;
begin
  curItem := TLightItem.Create;
  curItem.ClrBtn := NewData;
  _DataLink.Add(curItem);
  Start;
end;

constructor THighLight.Create;
begin
  inherited Create;
  _DataLink := TLink.Create;
  _DataLink.Style := 'Free';
  _Timer := TTimer.Create(Application);
  _Timer.OnTimer := timer;
  _Timer.Interval := 500;
  _Timer.Enabled := false;
  _Style := 'NL';
end;

procedure THighLight.Del(DelData: TClrBtn);
var
  curItem: TLightItem;
begin
  Stop;
  curItem := findItem(DelData);
  if curItem <> nil then
  begin
    DelData.Color := curItem.Color;
    DelData.Font.Color := curItem.FontColor;
    _DataLink.Del(curItem);
  end;
  if _DataLink.GetFirst <> nil then
    Start;
end;

function THighLight.findItem(curData: TClrBtn): TLightItem;
var
  curItem: TLinkItem;
begin
  curItem := _DataLink.GetFirst;
  result := nil;
  while curItem <> nil do
  begin
    if (curItem.Data as TLightItem).ClrBtn = curData then
    begin
      result := curItem.Data as TLightItem;
      break;
    end;
    curItem := curItem.Next;
  end;
end;

function THighLight.GetCount: integer;
begin
  result := _DataLink.GetCount;
end;

function THighLight.GetLightTime: integer;
begin
  result := _Timer.Interval;
end;

function THighLight.isHas(curData: TClrBtn): Boolean;
begin
  if findItem(curData) = nil then result := false
  else result := true;
end;

procedure THighLight.SetLightTime(Value: integer);
begin
  _Timer.Interval := Value;
end;

procedure THighLight.Start;
begin
  _Timer.Enabled := true;
end;

procedure THighLight.Stop;
begin
  _Timer.Enabled := false;
end;

procedure THighLight.timer(Sender: TObject);
var
  curLight: TLightItem;
  curItem: TLinkItem;
begin
  curItem := _DataLink.GetFirst;
  if _Style = 'NL' then _Style := 'L'
  else _Style := 'NL';
  while curItem <> nil do
  begin
    if curItem.Data is TLightItem then
      curLight := (curItem.Data as TLightItem);
    if _Style = 'NL' then
    begin
      curLight.ClrBtn.Color := curLight.LightColor;
      curLight.ClrBtn.Font.Color := curLight.LightFontColor;
    end
    else
    begin
      curLight.ClrBtn.Color := curLight.Color;
      curLight.ClrBtn.Font.Color := curLight.FontColor;
    end;
    curItem := curItem.Next;
  end;
end;

{ TLightItem }

constructor TLightItem.Create;
begin
  _Color := clBtnFace;
  _FontColor := clWindowText;
  _LightColor := clActiveCaption;
  _LightFontColor := clHighlightText;
  _ClrBtn := nil;
end;

destructor TLightItem.Destroy;
begin
  ClrBtn := nil;
  inherited Destroy;
end;

procedure TLightItem.SetClrBtn(Value: TClrBtn);
begin
  _ClrBtn := Value;
  _FontColor := Value.Font.Color;
end;

{ TTimeMsg }

constructor TTimeMsg.Create;
begin
  inherited Create;
  _time := timetostr(now);
  _msg := '';
  _level := '1';
end;

end.