ziliao.pas

地震模拟资料数字化的过程中

procedure TData.CreatePicutre_Refresh(const index: byte);
var
   temp : TP;
   i,j : integer;
   T : TRect;
begin
   if index=1 then
      temp := TP1
   else
      temp := TP2;
   t.Top :=0;
   t.Right :=0;
   t.Left := temp.TB.Bitmap.Width;
   t.Bottom := temp.TB.Bitmap.Height;
   with temp.TB.Bitmap.Canvas do
      begin
      brush.Style := bssolid;
      brush.Color := clwhite;
      fillrect(t);
      textout(1,1,Format('%8.2f',[temp.Max_Value]));
      textout(1,temp.TB.Bitmap.Height-14,Format('%8.2f',[temp.Min_Value]));
      if temp.DataSource then     //绘制原始数据
      begin
         with temp do
         begin
           Pen.Color := clblue;
           Pen.Width := 1;
           Moveto(1, round(5+(Max_Value-Data_YuanShi[Index_begin,0])*Scale_Y));
           for i:=Index_begin+1 to Index_End do
              lineto(round((i-Index_begin)*Scale_X)+1,round(5+(Max_Value-Data_YuanShi[i,0])*Scale_Y));

           //绘制打折点
           Pen.Color := clred;
           Pen.Width := 2;
           for i:=Index_begin+1 to Index_End do
             if high(Data_YuanShi[i])>=1 then
               for j:=1 to high(Data_YuanShi[i]) do
               begin
                  Moveto(round((i-Index_begin)*Scale_X)+1,round(5+(Max_Value-Data_YuanShi[i,j])*Scale_Y));
                  lineto(round((i-Index_begin)*Scale_X)+1,round(5+(Max_Value-Data_YuanShi[i,j])*Scale_Y)-1);
               end
         end;
      end
      else
      begin    //绘制结果
         Pen.Color := clblue;
         Pen.Width := 1;
         with temp do
         begin
           Moveto(1, round(5+(Max_Value-Data_Chuli[Index_begin])*Scale_Y));
           for i:=Index_begin+1 to Index_End do
              lineto(round((i-Index_begin)*Scale_X)+1,round(5+(Max_Value-Data_Chuli[i])*Scale_Y));
         end;
      end;
   end;
   temp := nil;
end;

procedure TData.Data_Clear_Taijie(const id1, id2: integer;const flag : integer=1);
var
   i1,i2,index1,index2,t : integer;
   temp1,temp2,Sumdx,dx : Double;
   i,j : integer;
begin
    i1 := min(id1,id2);
    i2 := max(id1,id2);
    Search_Data(i1,2,index1,temp1);
    Search_Data(i2,2,index2,temp2);
    if flag=1 then
    begin
      Sumdx := temp2-temp1;       //台阶的总位移量
      dx    := Sumdx /(index2-index1);
      if TP2.DataSource  then     //原始数据
      begin
         for i := index1+1 to index2-1 do
           for j := 0 to length(Data_Yuanshi[i]) - 1 do
              Data_Yuanshi[i,j] := Data_Yuanshi[i,j] - round((i-index1)*dx);
         for i := index2 to length(Data_Yuanshi)-1 do
            for j := 0 to length(Data_Yuanshi[i]) - 1 do
              Data_Yuanshi[i,j] := Data_Yuanshi[i,j] - round(Sumdx);
      end
      else                        //处理后的数据
      begin
         for i := index1+1 to index2-1 do
            Data_Chuli[i] := Data_Chuli[i]- (i-index1)*dx ;
         for i := index2 to length(Data_Chuli) - 1 do
            Data_Chuli[i] := Data_Chuli[i]- Sumdx;
      end;
    end
    else if flag =2  then     //
    begin
       if TP2.DataSource  then     //原始数据
       begin
           showmessage('暂时该程序不支持原始数据去台阶');
           raise Exception.Create('暂时该程序不支持原始数据去台阶');
       end
       else
       begin
           j := (index2-index1-1);     //消除点的个数
           temp1 := temp1-temp2;       //数据错动的大小
           for i := index1+1 to length(Data_Chuli)-1-j do
              Data_Chuli[i] := Data_Chuli[i+j]+temp1;
           setlength(Data_Chuli,length(Data_Chuli)-j);  //重新设置处理后的数据的长度
       end;
    end;
end;

procedure TData.Data_Sub_Average(const id1, id2: integer);
var
   i1,i2,index1,index2,t : integer;
   temp1,temp2,Sum,Average : Double;
   i,j ,iAverage: integer;
begin
    i1 := min(id1,id2);
    i2 := max(id1,id2);
    Search_Data(i1,2,index1,temp1);
    Search_Data(i2,2,index2,temp2);
    sum := 0;
    for i := index1 to index2 do
    begin
       if TP2.DataSource  then    //原始数据
           sum := sum + Data_Yuanshi[i,0]
       else                       //处理后的数据
           sum := sum + Data_Chuli[i];
    end;
    Average := sum/(index2-index1+1);
    iAverage := round(Average);
    if TP2.DataSource  then
    begin
       for i := 0 to length(Data_Yuanshi) - 1 do
          for j := 0 to length(Data_Yuanshi[i]) - 1 do
             Data_YuanShi[i,j] := Data_YuanShi[i,j] - iAverage;
    end
    else
    begin
       for i := 0 to length(Data_Chuli) - 1 do
         Data_ChuLi[i] := Data_Chuli[i]-Average;

    end;
end;

destructor TData.Destroy;
var
  i : integer;
begin
    for i:= low(Data_Yuanshi) to high(Data_Yuanshi) do
       setlength(Data_Yuanshi[i],0);
    setlength(Data_Yuanshi,0);
    setlength(Data_ChuLi,0);
    TP1.Free ;
    TP2.Free ;
    inherited;
end;

function TData.PutOut_Yuanshi: TStringList;
var
  i,j : Integer;
  s : string;
begin
    result := TStringList.Create;
    for i:= low(Data_YuanShi) to high(Data_YuanShi) do
    begin
        if high(Data_YuanShi[i])>0 then
        begin
          s :='';
          for j := low(Data_YuanShi[i]) to high(Data_YuanShi[i]) do
             s := s + format(' %4d  %8d',[i+ Findex_Min,Data_Yuanshi[i,j]]);
          result.Add(s);
        end;
    end;
end;

procedure TData.Search_Data(const index, dataindex: integer;
  out Data_index: integer; out Data_Value: Double);
var
  t : TP;
begin
       if dataindex=1 then
          t := TP1
       else if dataindex=2 then
          t := TP2;
       Data_index := round((index-1)/t.Scale_X);
       if Data_index<0 then
          Data_index:=0;
       if (dataindex=1) and (Data_index>length(Data_Yuanshi)-1) then    //设置原始数据的最大查找范围
           Data_index := length(Data_Yuanshi)-1;
       if (dataindex=2) and (Data_index>length(Data_Chuli)-1) then      //设置处理后数据的最大查找范围
           Data_index := length(Data_Chuli)-1;
       Data_index := Data_index + t.Index_Begin;
       if  T.DataSource then
          Data_Value := data_Yuanshi[Data_index,0]
       else
          Data_Value := Data_Chuli[Data_index];
end;

{ TP }

constructor TP.Create(width, heigh: integer);
begin
    self.B_Heigh := heigh;
    self.Flag := false;
    self.B_Width := width;
    self.TB := TPicture.Create ;
    TB.Bitmap.Width := width;
    TB.Bitmap.Height := heigh;
end;

destructor TP.Destroy;
begin
  TB.Free;
  inherited;
end;

procedure TP.Init_Data(const Data_Source: boolean; const id_min,
  id_max: integer);     //初始化数据
begin
   self.DataSource := Data_Source;
   self.Index_Begin := id_min;
   self.Index_End := id_max;
   self.Scale_X := trunc((self.B_Width-2)/(id_max-id_min+1));     //X轴方向的放大倍数
end;

procedure TP.Init_Value(const MinValue, MaxValue, AverageValue: Double);
begin
  self.Min_Value := MinValue;
  self.Max_Value := MaxValue;
  self.Average_Value := AverageValue;
  self.Scale_Y := (self.B_Heigh-10)/(Max_Value-Min_Value);
end;

end.