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

📄 mainform.pas

📁 地震模拟资料数字化的过程中
💻 PAS
字号:
unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Buttons,ZiLiao, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    ControlBar1: TControlBar;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    OpenDialog1: TOpenDialog;
    SpeedButton5: TSpeedButton;
    StatusBar1: TStatusBar;
    Image1: TImage;
    Image2: TImage;
    Button1: TButton;
    SaveDialog1: TSaveDialog;

    procedure SpeedButton4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1DblClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image2Click(Sender: TObject);
    procedure Image2DblClick(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
  private
    { Private declarations }
  public
     zoom_index : integer;
     Imageclick : boolean;
     id : integer;
     id1 : integer;      //保存图片第一次单击的位置
     id1_flag : boolean; //是否第一次单击了
     id2 : integer;      //保存图片第二次单击的位置
     id2_falg : boolean; //是否第二次单击了
    { Public declarations }
  end;
//查找图片坐标x对应的数据     dataindex为1时候为TP1,2时为TP2,
//procedure Search_Data(const index : integer;const dataindex : integer; out Data_index : integer;out Data_Value : Double);

var
  Form1: TForm1;
  Data : TData;
implementation

{$R *.dfm}

//procedure Search_Data(const index : integer;const dataindex:integer ; out Data_index : integer;out Data_Value : Double);
//var
//  t : TP;
//begin
//       if dataindex=1 then
//          t := Data.TP1
//       else if dataindex=2 then
//          t := Data.TP2;
//       Data_index := round((index-1)/t.Scale_X);
//       if Data_index<0 then
//          Data_index:=0;
//       if Data_index>length(Data.Data_Yuanshi)-1 then
//           Data_index := length(Data.Data_Yuanshi)-1;
//       Data_index := Data_index + t.Index_Begin;
//       if  T.DataSource then
//          Data_Value := Data.data_Yuanshi[Data_index,0]
//       else
//          Data_Value := Data.Data_Chuli[Data_index];
//end;


procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
    if self.OpenDialog1.Execute then
    begin
        self.SpeedButton4.Enabled := false;
        Data.Free ;
        Data := TData.Create(self.OpenDialog1.FileName);
        self.SpeedButton4.Enabled := true;
        self.StatusBar1.Panels[0].Text :=  ExtractFileName(self.OpenDialog1.FileName);
        Data.CreatePicture(1,true,0,0);
        self.Image1.Canvas.Draw(0,0,Data.TP1.TB.Graphic);
    end;
end;

procedure TForm1.SpeedButton5Click(Sender: TObject);
var
    f : textfile;
    p,i : integer;
begin
    if self.SaveDialog1.Execute  then
      if assigned(Data) and Data.TP2.Flag  then
      begin
         if fileexists(self.SaveDialog1.FileName) and
            (MessageBox(self.Handle,'文件已存在,是否覆盖','文件已存在,是否覆盖',MB_YESNO )= IDYes) then
               Exit;
         assignfile(f,self.SaveDialog1.FileName);
         rewrite(f);
         for i := 0 to length(Data.Data_ChuLi) - 1 do
             writeln(f,format('%10.4f',[Data.Data_ChuLi[i]*(-1.0)]));
         closefile(f);
      end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    self.OpenDialog1.InitialDir := getcurrentdir;
    self.StatusBar1.Panels[0].Text := '请先调入波形文件';
    self.Imageclick := false;
    self.id1_flag := false;
    self.id2_falg := false;
    self.SaveDialog1.InitialDir := getcurrentdir;
    self.SaveDialog1.Title := '保存处理后的数据文件,数据将要反向';
end;

procedure TForm1.Image1DblClick(Sender: TObject);
var
  temp : integer;
begin
    if assigned(Data) and Data.TP1.Flag  then
    begin
      temp :=round((zoom_index-1)/Data.TP1.Scale_X);
      Data.CreatePicture(2,Data.TP1.DataSource,temp-50,temp+50);
      self.Image2.Canvas.Draw(0,0,Data.TP2.TB.Graphic);
      self.id1_flag := false;
      self.id2_falg := false;
    end;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
   temp : integer;
   t : Double;
begin
     if assigned(Data) and Data.TP1.Flag  then
     begin
       self.zoom_index := x;
       Data.Search_Data(x,1,temp,t);
       self.StatusBar1.Panels[1].Text := format('第%d个数据:%f',[temp,t]);
     end;
end;


procedure TForm1.Image2Click(Sender: TObject);
var
  index1,index2,id : integer;
  s : string;
begin
    if (self.Imageclick) and (self.SpeedButton1.Down or self.SpeedButton2.Down ) then
    begin
      if assigned(Data) then
      begin
        with self.Image2.Canvas do
        begin
          pen.Color := clred;
          pen.Style := psDot	;
          pen.Mode := pmNotXor;
          if not self.id1_flag  then
          begin
             self.id1_flag := true;
             self.id1 := self.id ;
             moveto(self.id1,0);
             lineto(self.id1,self.Image2.Height);
          end
          else if not self.id2_falg  then
          begin
             self.id2_falg := true;
             self.id2 := self.id;
             moveto(self.id2,0);
             lineto(self.id2,self.Image2.Height);
          end;
          if (self.id1_flag and self.id2_falg)  then
          begin
            if self.SpeedButton1.Down  then     //去台阶
            begin
               s :=inputbox('请选去台阶的方式','1为线性去台阶,2为水平拼接去台阶','1');
               if s = '1' then
                  id := 1
               else if s = '2'  then
                  id := 2;  
               Data.Data_Clear_Taijie(self.id1,self.id2,id);
               Data.CreatePicture(2,Data.TP2.DataSource,0,0);
               self.Image2.Canvas.Draw(0,0,Data.TP2.TB.Graphic);
            end;
            if self.SpeedButton2.Down  then     //去平均值
            begin
               Data.Data_Sub_Average(self.id1,self.id2);
               Data.CreatePicture(2,Data.TP2.DataSource,0,0);
               self.Image2.Canvas.Draw(0,0,Data.TP2.TB.Graphic);
            end;
            self.id1_flag := false;
            self.id2_falg := false;
            self.SpeedButton1.Down := false;
            self.SpeedButton2.Down := false;
            self.Imageclick := false;
          end;
        end;
      end;
    end;
end;

procedure TForm1.Image2DblClick(Sender: TObject);
var
  temp : integer;
  t : Double;
begin
    if assigned(Data) and Data.TP2.Flag  then
    begin
      Data.Search_Data(self.id,2,temp,t);
      Data.CreatePicture(2,Data.TP2.DataSource,temp-50,temp+50);
      self.Image2.Canvas.Draw(0,0,Data.TP2.TB.Graphic);
      self.id1_flag := false;
      self.id2_falg := false;
    end;
end;

procedure TForm1.Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
   temp : integer;
   t : Double;
begin
     if assigned(Data) and Data.TP2.Flag  then
     begin
       self.id := x;
       Data.Search_Data(x,2,temp,t);
       self.StatusBar1.Panels[2].Text := format('第%d个数据:%f',[temp,t]);
     end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  t : array of array of integer;
begin
  setlength(t,5);
  setlength(t[1],1);
  showmessage(inttostr(high(t[1])));
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
    self.Imageclick := true;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
    self.Imageclick := true;
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
var
   s : string;
   i : integer;
begin
     i :=0;
     //while((i<>1) or (i<>2) )do
     begin
       s :=inputbox('请选择消除数据打折的方式','1为取最大值,2为向两边拓展','2');
       if s='1' then
          i:=1;
       if s='2' then
          i:=2;
     end;
     Data.ChuLi(i);   //以第i中方式处理数据
     Data.CreatePicture(2,false,0,0);
     self.Image2.Canvas.Draw(0,0,Data.TP2.TB.Graphic);
     self.id1_flag := false;
     self.id2_falg := false;
end;

end.


⌨️ 快捷键说明

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