⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmmain.pas

📁 用于建筑的测斜数据处理!把测试设备的数据下载电脑,通过本系统进行分析,然后生成所需要的数据!
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit frmmain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ImgList, Menus, StdCtrls, ComCtrls, ToolWin, FileCtrl, Grids,
  Buttons, CheckLst,Registry,comobj;

////------自定义Tedit,用来设定Edit右对齐---------------/////////
type
        Tmyedit = class(Tedit)
        private
                FAlignment:TAlignment;
        protected
                procedure createParams(var Params:TcreateParams);override;
                procedure setAlignment(value:TAlignment);
        published
                property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
end;
////------END自定义Tedit,用来设定Edit右对齐---------------/////////
type jzdata = record // A+面数值、A-面数值、B+面数值、B-面数值是原始数据直接从 *.csv获取
        depth:real;                    //深度
        az:real;                       //A+面数值
        af:real;                       //A-面数值
        bz:real;                       //B+面数值
        bf:real;                       //B-面数值
        fmca:real;                     //A面平面差
        fjca:real;                     //A面平均差
        fmcb:real;                     //B面平面差
        fjcb:real;                     //B面平均差
        ztxa:real;
        ztxb:real;
end;
type Tjzdata = array[1..100] of jzdata;
type data = record
        depth:real;
        az:real;
        af:real;
        bz:real;
        bf:real;
        fmca:real;
        fjca:real;
        fmcb:real;
        fjcb:real;
        ztxa:real;
        ztxb:real;
end;
type Tdata = array[1..100] of  data;
type
  Tmain = class(TForm)
    Label4: TLabel;
    Memo_head: TMemo;
    Button1: TButton;
    ProgressBar1: TProgressBar;
    cklistbox: TCheckListBox;
    btncldata: TBitBtn;
    ProgressBar2: TProgressBar;
    StringGrid: TStringGrid;
    GroupBox1: TGroupBox;
    DriveComboBox1: TDriveComboBox;
    DirectoryListBox1: TDirectoryListBox;
    FileListBox1: TFileListBox;
    ToolBar1: TToolBar;
    ToolButton3: TToolButton;
    ToolButton1: TToolButton;
    ToolButton5: TToolButton;
    ToolButton2: TToolButton;
    ToolButton4: TToolButton;
    StaticText1: TStaticText;
    StaticText2: TStaticText;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    MainMenu1: TMainMenu;
    N2: TMenuItem;
    N7: TMenuItem;
    N3: TMenuItem;
    N8: TMenuItem;
    N4: TMenuItem;
    N6: TMenuItem;
    N9: TMenuItem;
    N5: TMenuItem;
    OpenDialog1: TOpenDialog;
    ImageList1: TImageList;
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    function  GetFileTime(const Tf:string):string;
    function CovFileDate(Fd:_FileTime):TDateTime;
    function getfilenum(a:string):integer;
    function openexcel(filename:string):boolean;
    procedure N1Click(Sender: TObject);
    procedure FileListBox1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure btncldataClick(Sender: TObject);
    procedure ToolButton1Click(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
    procedure ToolButton5Click(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ToolButton3Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
    edtjz:Tmyedit;
    openflag:boolean;
    procedure getstr(a,dep,az,af,bz,bf:string);
  end;

var
  main: Tmain;
  jzdatacl:Tjzdata;
  datacl:Tdata;
  datazza:array[1..50,1..100] of real;
  datazzb:array[1..50,1..100] of real;
  datapjca:array[1..50,1..100] of real;
  datapjcb:array[1..50,1..100] of real;
  datapmca:array[1..50,1..100] of real;
  datapmcb:array[1..50,1..100] of real;
  dataljca:array[1..50,1..100] of real;
  dataljcb:array[1..50,1..100] of real;
  datadepth:array[1..50,1..100] of real;
  datestr:array[1..100] of string;
  depthnum,datenum:integer;
  fvexcel:Variant;

implementation

uses frmdataresult, frmexpressions, frmabout, frmchartexp, frmregsoft,
  frmstart;

{$R *.dfm}
function Tmain.openexcel(filename:string):boolean;
begin
        Result := True;
        try
                FvExcel := CreateOleObject('Excel.Application');
        except
                Application.MessageBox('打开Excel失败',PChar(Application.Title),MB_ICONERROR);
                Result := False;
        end;
        FvExcel.Caption := '';
        FvExcel.visible:=true;
        FvExcel.WorkBooks.Open(FileName); //打开工作簿
        FvExcel.WorkSheets[1].Activate;  //设置第1个工作表为活动工作表
end;
///////-----------------一下是设置TEdit的右对齐的方法-------------------------/////////
procedure Tmyedit.setAlignment(value: TAlignment);                                /////
begin                                                                             /////
  if value <> FAlignment then                                                     /////
  begin                                                                           /////
    FAlignment := value;                                                          /////
    RecreateWnd;                                                                  /////
  end;                                                                            /////
end;                                                                              /////
procedure Tmyedit.CreateParams(var Params: TCreateParams);                        /////
begin                                                                             /////
  inherited CreateParams(Params);                                                 /////
  case Alignment of                                                               /////
    taLeftJustify  : Params.Style := Params.Style or (ES_LEFT or Es_MULTILINE);   /////
    taRightJustify : Params.Style := Params.Style or (ES_RIGHT or ES_MULTILINE);  /////
    taCenter       : Params.Style := Params.Style or (ES_CENTER or Es_MULTILINE); /////
  end;                                                                            /////
end;                                                                              /////
/////////////////////----一下是设置TEdit的右对齐的方法-------//////////////////////////
procedure Tmain.getstr(a,dep,az,af,bz,bf:string);
begin
        dep:=copy(a,1,pos(',',a)-1);
        a:=copy(a,pos(',',a)+1,length(a)-pos(',',a));
        az:=copy(a,1,pos(',',a)-1);
        a:=copy(a,pos(',',a)+1,length(a)-pos(',',a));
        af:=copy(a,1,pos(',',a)-1);
        a:=copy(a,pos(',',a)+1,length(a)-pos(',',a));
        bz:=copy(a,1,pos(',',a)-1);
        a:=copy(a,pos(',',a)+1,length(a)-pos(',',a));
        bf:=a;
end;
function Tmain.GetFileTime(const Tf:string):string;
var
        Tp:TSearchRec; { 申明Tp为一个查找记录 }
        T2:string;
begin
        FindFirst(Tf,faAnyFile,Tp); { 查找目标文件 }
        //T1:=FormatDateTime('yyyymmdd,hh:mm:ss',CovFileDate(Tp.FindData.ftCreationTime));
        T2:=FormatDateTime('yyyy-mm-dd,hh:mm:ss',CovFileDate(Tp.FindData.ftLastWriteTime));
{ 返回文件的修改时间 }
        result:=T2;
        FindClose(Tp);
end;
function Tmain.CovFileDate(Fd:_FileTime):TDateTime;
{ 转换文件的时间格式 }
var 
Tct:_SystemTime; 
Temp:_FileTime;
begin 
FileTimeToLocalFileTime(Fd,Temp); 
FileTimeToSystemTime(Temp,Tct); 
CovFileDate:=SystemTimeToDateTime(Tct);
end;

function Tmain.getfilenum(a:string):integer;
begin
        //result:=strtoint(copy(a,pos('(',a)+1,Pos(a,')')-pos(a,'(')-1));
        result:=strtoint(copy(a,pos('(',a)+1,pos(')',a)-pos('(',a)-1));
end;



procedure Tmain.FormActivate(Sender: TObject);
var
        dir:string;
        i,j:integer;
begin
openflag:=false;
dir:=extractfiledir(application.ExeName);
self.DirectoryListBox1.Directory:=dir;
for i:=1 to 100 do
        for j:=1 to 5 do
                stringgrid.Cells[j,i]:='';
btncldata.Enabled:=false;
stringgrid.Cols[1].Text:='深度';
stringgrid.Cols[2].Text:='A+面';
stringgrid.Cols[3].Text:='A-面';
stringgrid.Cols[4].Text:='B+面';
stringgrid.Cols[5].Text:='B-面';
for i:=1 to 100 do
        stringgrid.Rows[i].Text:=inttostr(i);

end;

procedure Tmain.FormCreate(Sender: TObject);
var
        re_id:integer;
        registerTemp:Tregistry;
        inputstr,get_id:string;
        dy,clickedok:boolean;
        sycs:integer;
begin
        edtjz:=Tmyedit.Create(self);
        edtjz.Alignment:=tarightjustify;
        edtjz.Parent:=self;
        edtjz.Left:=80;
        edtjz.Top:=312;
        edtjz.Width:=450;
        edtjz.ReadOnly:=true;
        edtjz.Enabled:=false;
        //////--设定程序的使用次数--////
        {dy:=false;//软件是否已到注册期、及是否继续使用的标志,当值为false的时候是允许使用的;
        registerTemp:=Tregistry.Create;     //准备使用注册表
        with registerTemp do
        begin
                RootKey:=HKEY_LOCAL_MACHINE;//存放在根目录下
                if openkey('Software\Microsoft\Windows\CurrentVersion\cxsys',true) then
                //建立目录,存放标志值
                begin
                        if valueexists('gc_id') then //用gc_id的值作为标志,首先判断其时候存在
                        begin
                                re_id:=readinteger('gc_id'); //读取标志值
                                if (re_id<>0) and (re_id<>100) then //若标志为0,则说明已注册;
                                //如果为为0,且值不到100,说明虽未注册,但是允许使用的次数还没有达到;
                                begin
                                        sycs:=trunc((100-re_id)/5);
                                        self.Caption:=self.Caption+'  软件没有注册,最多使用20次!  您还可以使用'+inttostr(sycs)+'次';
                                        re_id:=re_id+5; //允许标志的最大值未100,每次加5,最多使用20次;
                                        writeinteger('gc_id',re_id);  //将更新后的标志写入注册表
                                end
                                else
                                        self.Caption:=self.Caption+'  软件已注册';

                                if re_id=100 then dy:=true; //如果更新的标志值已到100,则应该注册;
                end
                else
                        writeinteger('gc_id',5);       //如果注册表chenliang不存在,则建立,并init
                end;
                if dy then  //若dy值未true,则应该提示使用者输入注册码,进行注册;
                begin
                        clickedok:=inputquery('您输入的是注册软件,清输入注册码:','',inputstr);
                        if clickedok then
                        begin
                                get_id:=inttostr(27593758*2);   //注册码是55187516
                                if get_id=inputstr then
                                begin
                                        writeinteger('gc_id',0);
                                        closekey;
                                        free;
                                        self.Caption:='数字测斜仪器数据分析系统 广州铁路(集团)公司科学技术研究所  软件已注册';
                                end
                                else
                                begin
                                        application.MessageBox('注册码错误!请与作者联系!','警告框',mb_ok);
                                        closekey;
                                        free;
                                        application.Terminate;
                                end;
                        end
                        else
                        begin
                                application.MessageBox('注册码错误!请与作者联系!','警告框',mb_ok);
                                closekey;
                                free;
                                application.Terminate;
                        end;
                end;
        end;   }
/////////////////////////////////-----------软件注册部分--------------------------///////////
end;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -