accidenceeditfrm.pas

来自「一个可以把源代码以语法高亮的形式转换成HTML格式或RTF格式。」· PAS 代码 · 共 676 行 · 第 1/2 页

procedure TFrmAccidenceEdit.btnDelSymbolClick(Sender: TObject);
begin
  if FSMTabMgr.TabCount > 0 then
    if MessageBox(Handle, PChar(pubGet('Qust_Delete')), PChar(pubGet(2)),
      MB_YESNO + MB_ICONQUESTION) = IDYES then
      FSMTabMgr.DelIndexTab;
end;

procedure TFrmAccidenceEdit.btnOKClick(Sender: TObject);
begin
  //ToDo: 退出控制
  if not IsInputRight then
    Exit;
  SetValueToAcci;
  if FAcciState.SaveToFile then
    ModalResult := mrOk;
end;

procedure TFrmAccidenceEdit.SetFontFrame(AFontConfig: TFontConfig;
  AFontFrame: TFrameFont);
begin
  // Obj -> UI  [Font]
  with AFontFrame, AFontConfig do
  begin
    cbFontName.ItemIndex := cbFontName.Items.IndexOf(FontName);
    cbFontNameSelect(nil);
    cbFontSize.ItemIndex := cbFontSize.Items.IndexOf(IntToStr(FontSize));
    cbFontSizeSelect(nil);
    cbFontColor.Selected := FontColor;
    cbFontColorSelect(nil);
    chkBold.Checked := fsBold in FontStyle;
    chkItalic.Checked := fsItalic in FontStyle;
    chkUnderline.Checked := fsUnderline in FontStyle;
    chkStrikethrough.Checked := fsStrikeOut in FontStyle;
  end;
end;

procedure TFrmAccidenceEdit.SetFontConfig(AFontFrame: TFrameFont;
  AFontConfig: TFontConfig);
begin
  // UI -> Obj  [Font]
  with AFontConfig, AFontFrame do
  begin
    FontName := cbFontName.Text;
    FontSize := StrToInt(cbFontSize.Text);
    FontColor := cbFontColor.Selected;
    FontStyle := [];
    if chkBold.Checked then
      Include(FontStyle, fsBold);
    if chkItalic.Checked then
      Include(FontStyle, fsItalic);
    if chkStrikethrough.Checked then
      Include(FontStyle, fsStrikeOut);
    if chkUnderline.Checked then
      Include(FontStyle, fsUnderline);
  end;
end;

procedure TFrmAccidenceEdit.SetValueToAcci;
var
  i: Integer;
  KWConfig: TKeyWordConfig;    // 定义引用
  KWFrame: TFrameKeyWord;
  SMConfig: TSymbolConfig;
  SMFrame: TFrameSymbol;
begin
  if Not Assigned(FAcciState) then
    Exit;  // 未分配
  // UI -> Obj
  with FAcciState.FAcciConfig do
  begin
  
    Clear;   // 删除 关键字、符号内容，也释放其中的对象
    
    // 常规、数字
    GeneralConfig.IgnoreCase := chkIgnoreCase.Checked;
    GeneralConfig.ShowLine := chkShowLine.Checked;
    GeneralConfig.BGround := cbBGColor.Selected;
    SetFontConfig(GelFontFrame, GeneralConfig.FontConfig);
    SetFontConfig(NumFontFrame, NumberConfig.FontConfig);
    // 关键字
    for i := 0 to FKWTabMgr.TabCount - 1 do
    begin
      KWConfig := TKeyWordConfig.Create;
      KWFrame := TFrameKeyWord(FKWTabMgr.TabItems[i]);
      KWConfig.Name := FKWTabMgr.TabNames[i];
      SetFontConfig(KWFrame.KWFontFrame, KWConfig.FontConfig);
      KWConfig.Values.Assign(KWFrame.KeyWords.Lines);
      KeyWords.Add(KWConfig);
    end;
    // 符号
    for i := 0 to FSMTabMgr.TabCount - 1 do
    begin
      SMConfig := TSymbolConfig.Create;
      SMFrame := TFrameSymbol(FSMTabMgr.TabItems[i]);
      SMConfig.Name := FSMTabMgr.TabNames[i];
      SetFontConfig(SMFrame.SMFontFrame, SMConfig.FontConfig);
      SMConfig.Range := SMFrame.cbRange.Text;
      SMConfig.HightLight := SMFrame.cbHightLight.Text;
      SMConfig.DoubleSymbol := SMFrame.cbDoubleSym.Checked;
      SMConfig.BeginValue := SMFrame.edtBValue.Text;
      SMConfig.ESC := SMFrame.edtESC.Text;
      if SMConfig.DoubleSymbol then
        SMConfig.EndValue := SMFrame.edtEValue.Text;
      Symbols.Add(SMConfig);
    end;
  end;
end;

function TFrmAccidenceEdit.IsInputRight: Boolean;
var
  i,j, M, N: Integer;
  T :TPoint;
  s :string;
  SMFrame: TFrameSymbol;
  tmpList: TStringList;

  function StringsInList(Src,Des :TStrings;
           var SrcIndex,DesIndex:integer):Integer;
  var i :integer;
  begin
    Result := -1;
    SrcIndex :=0;
    DesIndex :=0;
    if Des.Count =0 then Exit;
    for i:=0 to Src.Count -1 do
    begin
      if TStringList(Des).Find(Src[i],DesIndex) then
      begin
        SrcIndex := i;                             // 第几项重复
        Result := Integer(Des.Objects[DesIndex]);  // 与那一页重复
        break;
      end;
    end;
  end;  // Local
  
  // 自动清除重复值  -- 不同关键字之间
  procedure DelDupKey(Src,Des :TStrings);
  var i,k:integer;
  begin
    for i:=Src.Count -1 downto 0 do
      if TStringList(Des).Find(Src[i],k) then // 已存在
        Src.Delete(i);
    if Src.Count >0 then
    begin
      Des.AddStrings(Src);
      TStringList(Des).Sort ; // 只有排序的才能使用 find 过程
    end;
  end;  // Local

begin   // Main
  Result := False;
  //ToDo : 待处理  值 判断
  // 常规
  // 数字  -  只有字体，没什么好设置，不存在即用默认值
  // 关键字
  tmpList := TStringList.Create ;
  //tmpList.Sorted := True;         // 实时排序，可能按大小  IndexOf()
  // 是否大小写敏感 = Not 是否忽略大小写
  tmpList.CaseSensitive := Not chkIgnoreCase.Checked ; 
  try
    for i :=0 to FKWTabMgr.TabCount - 1 do
    with TFrameKeyWord(FKWTabMgr.TabItems[i]) do
    begin
      try
        // 格式化关键字列表:空行、二边空格、重复值去除。
        FormatKeyWordValues(KeyWords.Lines,i); 
      except
        on e :Exception do
        begin
          MessageBox(Handle, PChar(e.Message), PChar(pubGet(2)),
              MB_OK + MB_ICONINFORMATION);
          PageControl.ActivePage := TSKeyWord;
          FKWTabMgr.ActiveTab := i;
          Exit;
        end;  
      end;
      if KeyWords.Lines.Count =0 then
        if MessageBox(Handle,
             PChar(Format(pubGet('Info_KeyWords_Empty'),[FKWTabMgr.TabNames[i]])),
             PChar(pubGet(2)),
             MB_YesNo + MB_ICONINFORMATION)=ID_No then
        begin
          PageControl.ActivePage := TSKeyWord ;
          FKWTabMgr.ActiveTab := i;
          KeyWords.SetFocus;
          Result := False;
          exit;
        end;

      j:=StringsInList(KeyWords.Lines,tmpList,M,N);
      if j<>-1 then
      begin
        s := Format(pubGet('Info_KeyWords_Dup') ,
           [ FKWTabMgr.TabNames[i], FKWTabMgr.TabNames[j],tmpList[N],#13#10 ]);
        if MessageBox(Handle, PChar(s), PChar(pubGet(2)),
            MB_YESNO + MB_ICONINFORMATION)=idYes then
        begin
          PageControl.ActivePage := TSKeyWord;
          FKWTabMgr.ActiveTab := i;
          //SendMessage(0,EM_LineIndex
          //TPoint(TMemo(KeyWords).CaretPos).Y :=0;// := TPoint(TMemo(KeyWords).CaretPos.X ,k);
          //SendMessage(TFrameKeyWord(FKWTabMgr.TabItems[i]).KeyWords.Handle,
          //   EM_SETSEL, N, N);
          //M :=KeyWords.CaretPos.X + M;
          //SendMessage(KeyWords.Handle , EM_SETSEL, M,M );
          T.X := M;
          T.Y := M;
          KeyWords.CaretPos :=T;
          KeyWords.SetFocus;
          Result := False;
          exit;
        end
        else    // 自动清除重复值 -- 不同关键字之间
        begin
          DelDupKey(KeyWords.Lines,tmpList); // Delete keywords -> tmpList
        end;
      end
      else
      begin
        tmpList.AddStrings(KeyWords.Lines);
        tmpList.Sort;
      end;
    end;

    // 符号
    tmpList.Clear;
    for i :=0 to FSMTabMgr.TabCount - 1 do
    begin
      SMFrame := TFrameSymbol(FSMTabMgr.TabItems[i]);
      j := tmpList.IndexOf(SMFrame.edtBValue.Text);
      if j>-1 then
      begin
        s := Format(pubGet('Info_BValue_Dup') ,
             [FSMTabMgr.TabNames[i],
              FSMTabMgr.TabNames[Integer(tmpList.Objects[j])] ]);
        MessageBox(Handle, PChar(s), PChar(pubGet(2)),
          MB_OK + MB_ICONINFORMATION);
        PageControl.ActivePage := TSSymbols;
        FSMTabMgr.ActiveTab := i;
        SMFrame.edtBValue.SetFocus;
        Result := False;
        exit;
      end
      else
        tmpList.AddObject(SMFrame.edtBValue.Text ,Pointer(i));

      if Not SMFrame.edtESC.Enabled then SMFrame.edtESC.Text :='';

      if SMFrame.edtBValue.Text = '' then
      begin
        MessageBox(Handle, PChar(pubGet('Info_BValue')),
          PChar(pubGet(2)), MB_OK + MB_ICONINFORMATION);
        PageControl.ActivePage := TSSymbols;
        FSMTabMgr.ActiveTab := i;
        SMFrame.edtBValue.SetFocus;
        Result := False;
        exit;
      end;

      if SMFrame.edtBValue.Text[1] in ['A'..'Z','a'..'z','_'] then
      begin
        MessageBox(Handle, PChar(pubGet('Info_BValue_InVaild')),
          PChar(pubGet(2)),MB_OK + MB_ICONINFORMATION);
        PageControl.ActivePage := TSSymbols;
        FSMTabMgr.ActiveTab := i;
        SMFrame.edtBValue.SetFocus;
        Result := False;
        exit;
      end;
      
      if SMFrame.cbDoubleSym.Checked and (SMFrame.edtEValue.Text = '') then
      begin
        MessageBox(Handle, PChar(pubGet('Info_EValue')), 
          PChar(pubGet(2)),MB_OK + MB_ICONINFORMATION);
        PageControl.ActivePage := TSSymbols;
        FSMTabMgr.ActiveTab := i;
        SMFrame.edtEValue.SetFocus;
        Result := False;
        exit;
      end;
    end;
  finally
    tmpList.Free;
  end;
  Result := True;
end;

procedure TFrmAccidenceEdit.FormatKeyWordValues(KWValues: TStrings;TabIndex:integer);
var
  i: Integer;
  s ,PrevStr: string;
  tmpList :TStringList;
begin
  //将空行、空格行去除、二边空格；去除重复值(按常规中是否大小写敏感)；排序(升序)

  tmpList := TStringList.Create;
  KWValues.BeginUpdate ;
  try
    tmpList.CaseSensitive := Not chkIgnoreCase.Checked ;// 是否按大小写比较
    //tmpList.Sorted := True;               // 插入时排序，有重复值自动过滤
    //tmpList.Duplicates := dupIgnore;      // 已是默认值
    //TStringList(KWValues).Sort;
    
    for i:=0 to KWValues.Count do           // 去前后空格、排序
      tmpList.Add(Trim(KWValues[i]));    
    tmpList.Sort; 
    PrevStr := '';
    KWValues.Clear;     
    for i := 0 to tmpList.Count -1 do
    begin
      s := tmpList[i];
      if (s<>'') then                       // 去空行
      begin
        // 关键字首字母是否合法
        if Not (s[1] in ['A'..'Z','a'..'z','_']) then
          Raise Exception.Create(pubGet('Info_KeyWord_Invalid')); 
        // 与上个值比较，相同则不加入  -- 因为已排序
        if (chkIgnoreCase.Checked and (CompareText(PrevStr ,s)=0)) or
           (Not chkIgnoreCase.Checked and (CompareStr(PrevStr ,s)=0)) then
        begin 
        end   
        else
        begin        
          KWValues.AddObject(s,Pointer(TabIndex)); 
          PrevStr := s;                            
        end;                                      
      end;      
    end;    // for/end
    
  finally
    KWValues.EndUpdate;
    tmpList.Free;
  end;
end;

end.