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

📄 unit1.pas

📁 与Action相结合,可以解决中文件显示乱码
💻 PAS
📖 第 1 页 / 共 2 页
字号:
  rve.ApplyStyleConversion(TEXT_BACKCOLOR);
end;
{------------------------------------------------------------------------------}
// applying paragraph background color
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  case Application.MessageBox('Make the selected paragraph background transparent?'#13+
                            '(YES - make transparent; NO - choose color)',
                            'Text Background', MB_YESNOCANCEL or MB_ICONQUESTION) of
    IDYES:
      cd.Color := clNone;
    IDNO:
      begin
        cd.Color := rvs.ParaStyles[rve.CurParaStyleNo].Background.Color;
        if cd.Color=clNone then
          cd.Color := clWhite;
        if not cd.Execute then
          exit;
      end;
    IDCANCEL:
      exit;
  end;
  rve.ApplyParaStyleConversion(PARA_COLOR);
end;
{------------------------------------------------------------------------------}
// The heart of this demo: rve.OnStyleConversion
procedure TForm1.rveStyleConversion(Sender: TCustomRichViewEdit; StyleNo,
  UserData: Integer; AppliedToText: Boolean; var NewStyleNo: Integer);
var FontInfo: TFontInfo;
begin
  FontInfo := TFontInfo.Create(nil);
  try
    FontInfo.Assign(rvs.TextStyles[StyleNo]);
    case UserData of
      TEXT_BOLD:
        if btnBold.Down then
          FontInfo.Style := FontInfo.Style+[fsBold]
        else
          FontInfo.Style := FontInfo.Style-[fsBold];
      TEXT_ITALIC:
        if btnItalic.Down then
          FontInfo.Style := FontInfo.Style+[fsItalic]
        else
          FontInfo.Style := FontInfo.Style-[fsItalic];
      TEXT_UNDERLINE:
        if btnUnderline.Down then
          FontInfo.Style := FontInfo.Style+[fsUnderline]
        else
          FontInfo.Style := FontInfo.Style-[fsUnderline];
      TEXT_APPLYFONTNAME:
        FontInfo.FontName := FontName;
      TEXT_APPLYFONTSIZE:
        FontInfo.Size     := FontSize;
      TEXT_APPLYFONT:
        FontInfo.Assign(fd.Font);
      TEXT_COLOR:
        FontInfo.Color := cd.Color;
      TEXT_BACKCOLOR:
        FontInfo.BackColor := cd.Color;
      // add your code here....
    end;
    NewStyleNo := rvs.TextStyles.FindSuchStyle(StyleNo,FontInfo,RVAllFontInfoProperties);
    if NewStyleNo=-1 then begin
      rvs.TextStyles.Add;
      NewStyleNo := rvs.TextStyles.Count-1;
      rvs.TextStyles[NewStyleNo].Assign(FontInfo);
      rvs.TextStyles[NewStyleNo].Standard := False;
    end;
  finally
    FontInfo.Free;
  end;
end;
{------------------------------------------------------------------------------}
procedure TForm1.rveParaStyleConversion(Sender: TCustomRichViewEdit;
  StyleNo, UserData: Integer; AppliedToText: Boolean;
  var NewStyleNo: Integer);
var ParaInfo: TParaInfo;
begin
  ParaInfo := TParaInfo.Create(nil);
  try
    ParaInfo.Assign(rvs.ParaStyles[StyleNo]);
    case UserData of
      PARA_ALIGNMENT:
        ParaInfo.Alignment := GetAlignmentFromUI;
      PARA_INDENTINC:
        begin
          ParaInfo.LeftIndent := ParaInfo.LeftIndent+20;
          if ParaInfo.LeftIndent>200 then
            ParaInfo.LeftIndent := 200;
        end;
      PARA_INDENTDEC:
        begin
          ParaInfo.LeftIndent := ParaInfo.LeftIndent-20;
          if ParaInfo.LeftIndent<0 then
            ParaInfo.LeftIndent := 0;
        end;
      PARA_COLOR:
        ParaInfo.Background.Color := cd.Color;
      // add your code here....
    end;
    NewStyleNo := rvs.ParaStyles.FindSuchStyle(StyleNo,ParaInfo,RVAllParaInfoProperties);
    if NewStyleNo=-1 then begin
      rvs.ParaStyles.Add;
      NewStyleNo := rvs.ParaStyles.Count-1;
      rvs.ParaStyles[NewStyleNo].Assign(ParaInfo);
      rvs.ParaStyles[NewStyleNo].Standard := False;
    end;
  finally
    ParaInfo.Free;
  end;
end;
{------------------------------------------------------------------------------}
// applying paragraph style
procedure TForm1.btnApplyParaClick(Sender: TObject);
begin
  rve.ApplyParaStyleConversion(PARA_ALIGNMENT);
end;
{------------------------------------------------------------------------------}
// changing left indents
procedure TForm1.btnIdentDecClick(Sender: TObject);
begin
  rve.ApplyParaStyleConversion(PARA_INDENTDEC);
end;

procedure TForm1.btnIdentIncClick(Sender: TObject);
begin
  rve.ApplyParaStyleConversion(PARA_INDENTINC);
end;
{------------------------------------------------------------------------------}
procedure TForm1.cmbFontSizeKeyPress(Sender: TObject; var Key: Char);
begin
  if ord(Key)=VK_RETURN then begin
    Key := #0;
    cmbFontSizeClick(nil);
  end;
end;
{------------------------------------------------------------------------------}
procedure TForm1.cmbFontSizeExit(Sender: TObject);
begin
  cmbFontSizeClick(nil);
end;
{------------------------------------------------------------------------------}
procedure TForm1.mitUndoClick(Sender: TObject);
begin
  rve.Undo;
end;
{------------------------------------------------------------------------------}
procedure TForm1.mitRedoClick(Sender: TObject);
begin
  rve.Redo;
end;
{------------------------------------------------------------------------------}
procedure TForm1.mitCutClick(Sender: TObject);
begin
  rve.CutDef;
end;
{------------------------------------------------------------------------------}
procedure TForm1.mitCopyClick(Sender: TObject);
begin
  rve.CopyDef;
end;
{------------------------------------------------------------------------------}
procedure TForm1.mitPasteClick(Sender: TObject);
begin
  rve.Paste;
end;
{------------------------------------------------------------------------------}
procedure TForm1.mitDeleteClick(Sender: TObject);
begin
  rve.DeleteSelection;
end;
{------------------------------------------------------------------------------}
function TForm1.SaveIfNeeded: Boolean;
begin
  Result := True;
  if rve.Modified then
    case Application.MessageBox('Save file now?','File was modified',
                                MB_ICONQUESTION or MB_YESNOCANCEL) of
      IDYES:
        Result := Save;
      IDNO:
        Result := True;
      IDCANCEL:
        Result := False;
    end;
end;
{------------------------------------------------------------------------------}
function TForm1.Save: Boolean;
begin
  if FileName='' then
    Result := SaveAs
  else begin
    rve.SaveRVF(FileName, False);
    rve.Modified := False;
    StatusBar1.Panels[0].Text := '';
    Result := True;
  end;
end;
{------------------------------------------------------------------------------}
function TForm1.SaveAs: Boolean;
begin
  if sd.Execute then begin
    FileName := sd.FileName;
    Result := Save;
    if Result then
      Caption := ExtractFileName(FileName) + '- RDemo';
    end
  else
    Result := False;
end;
{------------------------------------------------------------------------------}
procedure TForm1.Open;
begin
  if not SaveIfNeeded then exit;
  if od.Execute then begin
    FileName := od.FileName;
    rve.LoadRVF(FileName);
    rve.Format;
    rveCurTextStyleChanged(nil);
    rveCurParaStyleChanged(nil);
    StatusBar1.Panels[0].Text := '';
    Caption := ExtractFileName(FileName) + '- RDemo';
  end;
end;
{------------------------------------------------------------------------------}
procedure TForm1.New;
begin
  if not SaveIfNeeded then exit;
  FileName := '';
  StatusBar1.Panels[0].Text := '';
  Caption := 'Unnamed - RDemo';
  rve.Clear;
  rve.Format;
  // you can delete non default styles here...
  rveCurTextStyleChanged(nil);
  rveCurParaStyleChanged(nil);
end;
{------------------------------------------------------------------------------}
procedure TForm1.mitNewClick(Sender: TObject);
begin
  New;
end;
{------------------------------------------------------------------------------}
procedure TForm1.mitOpenClick(Sender: TObject);
begin
  Open;
end;
{------------------------------------------------------------------------------}
procedure TForm1.mitSaveClick(Sender: TObject);
begin
  Save;
end;
{------------------------------------------------------------------------------}
procedure TForm1.mitSaveAsClick(Sender: TObject);
begin
  SaveAs;
end;
{------------------------------------------------------------------------------}
procedure TForm1.mitExitClick(Sender: TObject);
begin
  Close;
end;
{------------------------------------------------------------------------------}
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := SaveIfNeeded;
end;

end.

⌨️ 快捷键说明

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