upub.~pas

来自「一.录入学生信息（预计有81个学生」· ~PAS 代码 · 共 357 行

unit uPub;

interface

uses ShellAPI,SysUtils,Windows,Grids,Aligrid,Graphics,Classes,StdCtrls,DBCtrls,ComCtrls,
  Forms,Controls,Messages,SPComm,ActiveX,AxCtrls,ComObj,
  Dialogs,DB,DBGrids,DBGridEh;


Type                      //树节点结构
  GroupData=Record
    GroupCode:String;
    GroupName:String;
    LimitCap:Extended;
    DeviceCode1:String;
    DeviceName1:String;
    UseType1:Integer;
    RunStatus1:Integer;
    DeviceCode2:String;
    DeviceName2:String;
    UseType2:Integer;
    RunStatus2:Integer;
    Selected:Boolean;
end;

Type                      //树节点结构
  ELEData=Record
    DeviceCode:String;
    DeviceName:String;
    UseType:Integer;
    RunStatus:Integer;
end;

Type                      //工作任务结构
  PWorks=^Works;
  Works=Record
    DeviceCode:String;
    DeviceName:String;
    StartTime:Integer;
    Para:String;
    OpType:Integer;
    ActDealCmd:String;
    OutTimeCount:Integer;   //指令超时记数
end;

Type                      //树
  PNodeData=^NodeData;
  NodeData=Record
    Code:String;
    Name:String;
end;


Var AppPath:String;
Var RowHeight:Integer;
Var NeedSplashClose:Boolean;

Var GroupList:Array of GroupData;
Var EleList:Array of ELEData;
Var FMPoints:Array[0..5] of TPoint;
Var NowWorks:Array of  Works;

Var BackColor:Integer;
Var StopColor:Integer;
Var RunColor:Integer;
Var IniParamFile:String;
Var WorkChanged:Boolean;  //任务数据是否改变
Var RctSPortDataBuf:TStringList;

Var MLRun:Boolean;    //是否模拟运行
Var MLSendBuf:TStringList;  //模拟下行数据缓冲区
Var ActSendBuf:TStringList; //实际下行数据缓冲区

procedure fShellExecute(const Method: WideString);
procedure nextfocus(control1 : tobject;SouKey:Word;SouShift:TShiftState=[]) ;
Function Assign0(SouStr:String;NewLength:Integer):String;
Function TrimExd(SelStr:String):String;
Procedure EmptyGrid(SouGrid:TStringAlignGrid);
Procedure FileCopy( Const sourcefilename, targetfilename: String );
Function GetParity(SelParStr:String):Integer;
Function ComSendDataBase(Com:TComm;ComDataBase:String):Boolean;
Procedure SendData(ComDataBase:String);
Function CountStrInStr(SubStr:String;TargetStr:String):Integer;
procedure Delay(lMilliSeconds: Dword);

//排序专用部分
Function GetMinRow(ColNum,StartRow,EndRow:integer;SouGrid:TStringGrid):Integer;
Procedure ExchangeRow(OldRow,SelRow,BufRow:Integer;SouGrid:TStringAlignGrid);
Function GetMaxRow(ColNum,StartRow,EndRow:integer;SouGrid:TStringGrid):Integer;
Procedure Sort(ColNum:Integer;Upper,IsNumeric:Boolean;SouGrid:TStringAlignGrid);



implementation

procedure fShellExecute(const Method: WideString);
var TempS:Array[0..255] of char;
begin
  StrPCopy(TempS,Method);
  ShellExecute(0,nil,TempS,nil,nil,sw_normal);
end;

procedure nextfocus(control1 : tobject;SouKey:Word;SouShift:TShiftState=[]) ;
begin
  If SouKey=13 then
    If (control1 Is TMemo) Or (control1 Is TDBMemo) Or (control1 Is TRichEdit) then
    begin
      If ssCtrl in SouShift then
        postmessage(tform(tcontrol(control1).owner).handle,wm_Nextdlgctl,0,0)
      else
        Exit;
    end
    else If Control1 Is TStringAlignGrid then
    begin
      Exit;
    end
    else
    begin
      postmessage(tform(tcontrol(control1).owner).handle,wm_Nextdlgctl,0,0) ;
    end;
end ;

Function Assign0(SouStr:String;NewLength:Integer):String;
var Temploop:Integer;
    TempStr:String;
begin
  TempStr:=SouStr;
  For Temploop:= Length(SouStr)+1 to NewLength Do
  begin
    TempStr:='0'+TempStr;
  end;
  Result:=TempStr;
end;

Function TrimExd(SelStr:String):String;
var TmpRtn:String;
    Tmploop:Integer;
begin
  TmpRtn:='';
  For Tmploop:=1 to Length(SelStr) Do
  begin
    if SelStr[Tmploop]<>' ' then
    begin
      TmpRtn:=TmpRtn+SelStr[Tmploop];
    end; 
  end;
  Result:=TmpRtn;
end;

Procedure EmptyGrid(SouGrid:TStringAlignGrid);
var TempRow,TempCol:Integer;
begin
  For TempRow:=0 to SouGrid.RowCount-1 do
  begin
    SouGrid.RowFont[TempRow].Color:=clblack;
    SouGrid.ColorRow[TempRow]:=clWindows;
    SouGrid.RowHeights[TempRow]:=SouGrid.DefaultRowHeight;
    For TempCol:=0 to SouGrid.ColCount-1 Do
    begin
      SouGrid.Cells[TempCol,TempRow]:='';
    end;
  end;
end;

Procedure FileCopy( Const sourcefilename, targetfilename: String );
Var
  S, T: TFileStream;
Begin
  S := TFileStream.Create( sourcefilename, fmOpenRead );

  try
    T := TFileStream.Create( targetfilename,
                             fmOpenWrite or fmCreate );
    try
      T.CopyFrom(S, S.Size ) ;
    finally
      T.Free;
    end;
  finally
    S.Free;
  end;
End;

Function GetParity(SelParStr:String):Integer;
begin
  if SelParStr='pEven' then
  begin
    Result:=0;
    Exit;
  end;
  if SelParStr='pMark' then
  begin
    Result:=1;
    Exit;
  end;
  if SelParStr='pNone' then
  begin
    Result:=2;
    Exit;
  end;
  if SelParStr='pOdd' then
  begin
    Result:=3;
    Exit;
  end;
  if SelParStr='pSpace' then
  begin
    Result:=4;
    Exit;
  end;
  Result:=-1;
end;

{------------------------------------------------------------------}
 // 函数名称：ComSendDataBase
 // 功能描述：通过串口发送串口数据
 // 输入参数：
 // 参   数1：Com        类型：TComm        意义： 串口对向
 // 参   数2：ComDataBase         类型：String        意义： 要发送的串口数据
 // 输出参数：
 // 返 回 值：通过串口发送成功的状态
 // 编  码：  zy
 // 返 回 值：成功 True            False 失败
 // 时  间  ：2004/11/18
{------------------------------------------------------------------}
Function ComSendDataBase(Com:TComm;ComDataBase:String):Boolean;
Var
Buf :pchar;
I   :Integer;
Begin
//  PublicComDataBase:='';
    i:=length(ComDataBase);
    Buf:=pchar(ComDataBase);
  IF Not Com.WriteCommData(Buf,i) Then
    Begin
      Result:=False;
      Exit;
    End;
  Result:=True;
   Exit;
end;

Procedure SendData(ComDataBase:String);
begin
  ActSendBuf.Add(ComDataBase);
end;


Function CountStrInStr(SubStr:String;TargetStr:String):Integer;
var TempPos,TempCount:Integer;
    TempSou:String;
begin
  TempCount:=0;
  TempSou:=TargetStr;
  While True Do
  begin
    TempPos:=Pos(SubStr,TempSou);
    if TempPos=0 then Break;
    TempCount:=TempCount+1;
    Delete(TempSou,1,TempPos+length(SubStr)-1);
  end;
  Result:=TempCount;
end;

procedure Delay(lMilliSeconds: Dword);
var lStart: DWord;
begin
   lStart := GetTickCount;
   while GetTickCount - lStart <= lMilliSeconds do
      Application.ProcessMessages;
end;

Procedure Sort(ColNum:Integer;Upper,IsNumeric:Boolean;SouGrid:TStringAlignGrid);
var TempLocate,TempLoop:Integer;
begin
  SouGrid.RowCount:=SouGrid.RowCount+1;
  For Temploop:=1 to SouGrid.RowCount-2 do
  begin
    if Upper then
    begin
      TempLocate:=GetMinRow(ColNum,Temploop,SouGrid.RowCount-2,SouGrid);
      ExchangeRow(Temploop,TempLocate,SouGrid.RowCount-1,SouGrid);
    end
    else
    begin
      TempLocate:=GetMaxRow(ColNum,Temploop,SouGrid.RowCount-2,SouGrid);
      ExchangeRow(Temploop,TempLocate,SouGrid.RowCount-1,SouGrid);
    end;
  end;
  For Temploop:=0 to SouGrid.ColCount-1 do
  begin
    SouGrid.Cells[Temploop,SouGrid.RowCount-1]:='';
  end;
  SouGrid.RowCount:=SouGrid.RowCount-1;
 { For Temploop:=1 to SouGrid.RowCount-1 do
  begin
    SouGrid.Cells[0,Temploop]:=IntToStr(Temploop);
  end;}
end;

Function GetMinRow(ColNum,StartRow,EndRow:integer;SouGrid:TStringGrid):Integer;
var TempMin,Temploop:Integer;
    MinStr,TempStr:String;
begin
  MinStr:=SouGrid.Cells[ColNum,StartRow];
  TempMin:=StartRow;
  For TempLoop:=StartRow to EndRow do
  begin
    TempStr:=SouGrid.Cells[ColNum,Temploop];
    if StrComp(PChar(MinStr),PChar(TempStr))>0 then
    begin
      MinStr:=TempStr;
      TempMin:=Temploop;
    end;
  end;
  Result:=TempMin;
end;

Function GetMaxRow(ColNum,StartRow,EndRow:integer;SouGrid:TStringGrid):Integer;
var TempMax,Temploop:Integer;
    MaxStr,TempStr:String;
begin
  MaxStr:=SouGrid.Cells[ColNum,StartRow];
  TempMax:=StartRow;
  For TempLoop:=StartRow to EndRow do
  begin
    TempStr:=SouGrid.Cells[ColNum,Temploop];
    if StrComp(PChar(MaxStr),PChar(TempStr))<0 then
    begin
      MaxStr:=TempStr;
      TempMax:=Temploop;
    end;
  end;
  Result:=TempMax;
end;

Procedure ExchangeRow(OldRow,SelRow,BufRow:Integer;SouGrid:TStringAlignGrid);
var Temploop:Integer;
    TempHeight:Integer;
    TmpCOlor:Integer;
begin
  TempHeight:=SouGrid.RowHeights[OldRow];
  TmpCOlor:=SouGrid.RowFont[OldRow].Color;
  SouGrid.RowHeights[OldRow]:=SouGrid.RowHeights[SelRow];
  SouGrid.RowFont[OldRow].Color:=SouGrid.RowFont[SelRow].Color;
  SouGrid.RowHeights[SelRow]:=TempHeight;
  SouGrid.RowFont[SelRow].Color:=TmpCOlor;
  For Temploop:=0 to SouGrid.ColCount-1 do
  begin
    SouGrid.Cells[Temploop,BufRow]:=SouGrid.Cells[Temploop,OldRow];
    SouGrid.Cells[Temploop,OldRow]:=SouGrid.Cells[Temploop,SelRow];
    SouGrid.Cells[Temploop,SelRow]:=SouGrid.Cells[Temploop,BufRow];
  end;
end;

end.