dm_unit.pas

报文上传,有关l波段雷达的传统系统 报文上传,有关l波段雷达的传统系统 报文上传,有关l波段雷达的传统系统‘ 报文上传,有关l波段雷达的传统系统

unit dm_unit;

interface

uses
  SysUtils, Classes, DB, ADODB,Dialogs, Forms;

type
  Tar=array of string;
  Tdm = class(TDataModule)
    ADOC: TADOConnection;
    qu1: TADOQuery;
    qu2: TADOQuery;
    procedure qu2AfterOpen(DataSet: TDataSet);
    procedure tb1AfterOpen(DataSet: TDataSet);
    procedure tb2AfterOpen(DataSet: TDataSet);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  dm: Tdm;
  apppath:string;
const
  appname='L波段雷达监控报文解码系统';
procedure ShowModalForm(aa:TFormClass;s:string);
procedure SetColWidth(fdataset:Tdataset);
function DeleteSpace(s:string):string;
function DeleteSpaceL(s:string):string;
function DeleteSpaceR(s:string):string;
procedure StringToArray(s,ch:string;var ar:Tar);
implementation
function DeleteSpaceL(s:string):string;
begin
  if length(s)<1 then
  begin
    result:=s;
    exit;
  end;
  while s[1]=' ' do
  begin
    delete(s,1,1);
    if length(s)<1 then
    begin
      result:=s;
      exit;
    end;
  end;
  result:=s;
end;
function DeleteSpaceR(s:string):string;
begin
  if length(s)<1 then
  begin
    result:=s;
    exit;
  end;
  while s[length(s)]=' ' do
  begin
    delete(s,length(s),1);
    if length(s)<1 then
    begin
      result:=s;
      exit;
    end;
  end;
  result:=s;
end;
function DeleteSpace(s:string):string;
begin
  s:=DeleteSpaceL(s);
  s:=DeleteSpaceR(s);
  result:=s;
end;
procedure StringToArray(s,ch:string;var ar:Tar);
var
  p,n:integer;
  s1:string;
begin
  n:=0;
  setlength(ar,length(s));
  s:=DeleteSpace(s);
  s:=s+ch;
  while s<>'' do
  begin
    p:=pos(ch,s);
    s1:=copy(s,1,p-1);
    s1:=DeleteSpace(s1);
    if s1='' then continue;
    ar[n]:=s1;
    delete(s,1,p);
    s:=DeleteSpaceL(s);
  //  showmessage(s+#13+ar[n]);
    inc(n);
  end;
//  showmessage(inttostr(n));
  setlength(ar,n);
end;
procedure SetColWidth(fdataset:Tdataset);
var
  i:integer;
  Fcolwidth:array of integer;
begin
  FDataSet.DisableControls;
  FDataSet.First;
  setlength(FColWidth,Fdataset.Fields.Count);
  for i:=0 to FdataSet.fieldcount-1 do
    Fcolwidth[i]:=length(Fdataset.Fields[i].DisplayLabel);
  while not Fdataset.eof do
  begin
    for i:=0 to Fdataset.fieldcount-1 do
    begin
      if length(FDataSet.Fields[i].DisplayText)>FColWidth[i] then
        FColWidth[i]:=length(FDataSet.Fields[i].DisplayText);
    end;
    FDataSet.Next;
  end;
  FDataSet.EnableControls;
  for i:=0 to FdataSet.fieldcount-1 do
    FDataSet.fields[i].DisplayWidth:=FColWidth[i]+2;
end;

{$R *.dfm}
procedure Tdm.qu2AfterOpen(DataSet: TDataSet);
const
  cp:array[0..2] of string=('日期','紫外线实况资料','紫外线预报等级');
var
  i:integer;
begin
  for i:=0 to 2 do
    dataset.fields[i].DisplayLabel:=cp[i];
end;

procedure Tdm.tb1AfterOpen(DataSet: TDataSet);
const
  cp:array[0..4] of string=('序号','刊物名称','百字以内金额','每百字加金额','上限');
var
  i:integer;
begin
  for i:=0 to 4 do
    dataset.Fields[i].DisplayLabel:=cp[i]
end;
procedure ShowModalForm(aa:TFormClass;s:string);
begin
  with aa.Create(nil) do
    try
      caption:=appname+'－'+s;
      showmodal;
    finally
      Free;
    end;
end;
procedure Tdm.tb2AfterOpen(DataSet: TDataSet);
const
  cp:array[0..7] of string=('序号','作者','文章标题','发表刊物','文件','字数','稿费','发表日期');
var
  i:integer;
begin
  for i:=0 to 7 do
    dataset.Fields[i].DisplayLabel:=cp[i];
  setcolwidth(dataset);
end;

end.