rm_richedit.pas

胜天进销存源码,国产优秀的进销存

  RMSetStrProp(FileSaveAsItem, 'Caption', rmRes + 188);
  RMSetStrProp(FileExitItem, 'Caption', rmRes + 162);
  RMSetStrProp(EditMenu, 'Caption', rmRes + 163);
  RMSetStrProp(EditUndoItem, 'Caption', rmRes + 164);
  RMSetStrProp(EditCutItem, 'Caption', rmRes + 166);
  RMSetStrProp(EditCopyItem, 'Caption', rmRes + 167);
  RMSetStrProp(EditPasteItem, 'Caption', rmRes + 168);
  RMSetStrProp(EditInsertFieldItem, 'Caption', rmRes + 575);
  RMSetStrProp(EditFontItem, 'Caption', rmRes + 576);
  RMSetStrProp(btnSuperscript, 'Hint', rmRes + 580);
  RMSetStrProp(btnSubscript, 'Hint', rmRes + 581);

  btnOK.Hint := RMLoadStr(rmRes + 573);
  btnCancel.Hint := RMLoadStr(rmRes + 574);
end;

procedure TRMRichForm.SelectionChange(Sender: TObject);
var
  lFont: TFont;
  lFontHeight: Integer;
begin
  with Editor.Paragraph do
  begin
    try
      FUpdating := True;
      FRuler.UpdateInd;
      btnFontBold.Down := fsBold in Editor.SelAttributes.Style;
      btnFontItalic.Down := fsItalic in Editor.SelAttributes.Style;
      btnFontUnderline.Down := fsUnderline in Editor.SelAttributes.Style;
      btnBullets.Down := Boolean(Numbering);
      BtnSuperscript.Down := RMGetSubscriptStyle(Editor) = rmssSuperscript;
      BtnSubscript.Down := RMGetSubscriptStyle(Editor) = rmssSubscript;

      lFont := TFont.Create;
      lFont.Size := Editor.SelAttributes.Size;
      lFontHeight := lFont.Height;
      lFont.Free;
      RMSetFontSize(TComboBox(FcmbFontSize), lFontHeight, Editor.SelAttributes.Size);

      FCmbFont.FontName := Editor.SelAttributes.Name;
      case Ord(Alignment) of
        0: btnAlignLeft.Down := True;
        1: btnAlignRight.Down := True;
        2: btnAlignCenter.Down := True;
      end;
      UpdateCaretPos;
    finally
      FUpdating := False;
    end;
  end;
end;

procedure TRMRichForm.UpdateCaretPos;
var
  CharPos: TPoint;
begin
  CharPos.Y := SendMessage(Editor.Handle, EM_EXLINEFROMCHAR, 0,
    Editor.SelStart);
  CharPos.X := (Editor.SelStart -
    SendMessage(Editor.Handle, EM_LINEINDEX, CharPos.Y, 0));
  Inc(CharPos.Y);
  Inc(CharPos.X);
  StatusBar.Panels[0].Text := Format(FStatusString, [CharPos.Y, CharPos.X]);

  btnCopy.Enabled := Editor.SelLength > 0;
  btnCut.Enabled := btnCopy.Enabled;
  EditCutItem.Enabled := btnCut.Enabled;
  EditCopyItem.Enabled := btnCopy.Enabled;
end;

function TRMRichForm.CurrText: TTextAttributes;
begin
  if Editor.SelLength > 0 then
    Result := Editor.SelAttributes
  else
    Result := Editor.DefAttributes;
end;

procedure TRMRichForm.SetEditRect;
var
  R: TRect;
begin
  with Editor do
  begin
    R := Rect(GutterWid, 0, ClientWidth - GutterWid, ClientHeight);
    SendMessage(Handle, EM_SETRECT, 0, Longint(@R));
  end;
end;

procedure TRMRichForm.SetFileName(const FileName: string);
begin
  FFileName := FileName;
end;

procedure TRMRichForm.SetModified(Value: Boolean);
begin
  if Value then
    StatusBar.Panels[1].Text := 'Modified'
  else
    StatusBar.Panels[1].Text := '';
end;

procedure TRMRichForm.FormResize(Sender: TObject);
begin
  SetEditRect;
  SelectionChange(Sender);
end;

procedure TRMRichForm.FormPaint(Sender: TObject);
begin
  SetEditRect;
end;

procedure TRMRichForm.FileOpen(Sender: TObject);
begin
  OpenDialog.Filter := RMLoadStr(SRTFFile) + '(*.rtf)|*.rtf' + '|' +
    RMLoadStr(STextFile) + '(*.txt)|*.txt';
  if OpenDialog.Execute then
  begin
    Editor.Lines.LoadFromFile(OpenDialog.FileName);
    Editor.SetFocus;
    SelectionChange(Self);
  end;
end;

procedure TRMRichForm.FileSaveAs(Sender: TObject);
begin
  SaveDialog.Filter := RMLoadStr(SRTFFile) + ' (*.rtf)|*.rtf|' +
    RMLoadStr(STextFile) + ' (*.txt)|*.txt';
  if SaveDialog.Execute then
    Editor.Lines.SaveToFile(SaveDialog.FileName);
end;

procedure TRMRichForm.EditUndo(Sender: TObject);
begin
  with Editor do
    if HandleAllocated then
      SendMessage(Handle, EM_UNDO, 0, 0);
end;

procedure TRMRichForm.SelectFont(Sender: TObject);
begin
  FontDialog1.Font.Assign(Editor.SelAttributes);
  if FontDialog1.Execute then
    CurrText.Assign(FontDialog1.Font);
  Editor.SetFocus;
end;

procedure TRMRichForm.btnOKClick(Sender: TObject);
begin
  OnResize := nil;
  ModalResult := mrOk;
end;

procedure TRMRichForm.btnCancelClick(Sender: TObject);
begin
  OnResize := nil;
  ModalResult := mrCancel;
end;

procedure TRMRichForm.FormActivate(Sender: TObject);
begin
  FUpdating := True;
  Editor.SetFocus;
  FUpdating := False;
end;

procedure TRMRichForm.FormCreate(Sender: TObject);
var
  i, liOffset: Integer;
begin
  Editor := TRMRichEdit.Create(Self);
  with Editor do
  begin
    Parent := Self;
    Align := alClient;
    ScrollBars := ssBoth;
    OnChange := EditorChange;
    OnSelectionChange := SelectionChange;
  end;

  Localize;
  FcmbFont := TRMFontComboBox.Create(ToolBar1);
  with FcmbFont do
  begin
    Parent := ToolBar1;
    Left := 0;
    Top := 0;
    Height := 21;
    Width := 150;
    Tag := 7;
//    Device := rmfdPrinter;
    OnChange := OnCmbFontChange;
  end;
  FcmbFontSize := TComboBox.Create(ToolBar1);
  with FcmbFontSize do
  begin
    Parent := ToolBar1;
    Left := 150;
    Top := 0;
    Height := 21;
    Width := 59;
    Tag := 8;
    DropDownCount := 12;
    if RMIsChineseGB then
      liOffset := 0
    else
      liOffset := 13;
    for i := Low(RMDefaultFontSizeStr) + liOffset to High(RMDefaultFontSizeStr) do
      Items.Add(RMDefaultFontSizeStr[i]);
    OnChange := OnCmbFontSizeChange;
  end;
  FBtnFontColor := TRMColorPickerButton.Create(ToolBar1);
  with FBtnFontColor do
  begin
    Parent := ToolBar1;
    Left := ToolButton4.Left + ToolButton4.Width;
    Top := 0;
    ColorType := rmptFont;
    OnColorChange := OnColorChangeEvent;
  end;

  FRuler := TRMRuler.Create(Self);
  with FRuler do
  begin
    Top := ToolBar1.Top + ToolBar1.Height;
    RichEdit := TCustomRichEdit(Editor);
    Align := alTop;
    Height := 26;
    OnIndChanged := SelectionChange;
  end;

  FStatusString := RMLoadStr(rmRes + 578) + ': %3d   ' + RMLoadStr(rmRes + 579) + ': %3d';
  OpenDialog.InitialDir := ExtractFilePath(ParamStr(0));
  SaveDialog.InitialDir := OpenDialog.InitialDir;
  SelectionChange(Self);
end;

procedure TRMRichForm.btnInsertFieldClick(Sender: TObject);
var
  s: string;
begin
  if RMDesigner <> nil then
  begin
    s := RMDesigner.InsertExpression;
    if s <> '' then
      Editor.SelText := s;
  end;
end;

procedure TRMRichForm.btnCutClick(Sender: TObject);
begin
  Editor.CutToClipboard;
end;

procedure TRMRichForm.btnCopyClick(Sender: TObject);
begin
  Editor.CopyToClipboard;
end;

procedure TRMRichForm.btnPasteClick(Sender: TObject);
begin
  Editor.PasteFromClipboard;
end;

procedure TRMRichForm.FileNewItemClick(Sender: TObject);
begin
  SetFileName('Untitled');
  Editor.Modified := True;
  SetModified(True);
end;

procedure TRMRichForm.btnFilePrintClick(Sender: TObject);
begin
  if PrintDialog.Execute then
    Editor.Print(FFileName);
end;

procedure TRMRichForm.EditorChange(Sender: TObject);
begin
  SetModified(Editor.Modified);
  btnUndo.Enabled := SendMessage(Editor.Handle, EM_CANUNDO, 0, 0) <> 0;
end;

procedure TRMRichForm.FormShow(Sender: TObject);
begin
  SelectionChange(Self);
  EditorChange(Self);
  SetModified(FALSE);
  Editor.SetFocus;
end;

procedure TRMRichForm.btnFontClick(Sender: TObject);
begin
  FontDialog1.Font.Assign(Editor.SelAttributes);
  if FontDialog1.Execute then
    CurrText.Assign(FontDialog1.Font);
  Editor.SetFocus;
end;

procedure TRMRichForm.btnBulletsClick(Sender: TObject);
begin
  if FUpdating then
    Exit;
  Editor.Paragraph.Numbering := TNumberingStyle(btnBullets.Down);
end;

procedure TRMRichForm.btnAlignLeftClick(Sender: TObject);
begin
  if FUpdating then
    Exit;
  case TControl(Sender).Tag of
    312: Editor.Paragraph.Alignment := taLeftJustify;
    313: Editor.Paragraph.Alignment := taCenter;
    314: Editor.Paragraph.Alignment := taRightJustify;
  end;
end;

procedure TRMRichForm.btnFontBoldClick(Sender: TObject);
var
  s: TFontStyles;
begin
  if FUpdating then
    Exit;
  s := [];
  if btnFontBold.Down then
    s := s + [fsBold];
  if btnFontItalic.Down then
    s := s + [fsItalic];
  if btnFontUnderline.Down then
    s := s + [fsUnderline];
  CurrText.Style := s;
end;

procedure TRMRichForm.OnCmbFontChange(Sender: TObject);
begin
  if FUpdating then
    Exit;
  CurrText.Name := FCmbFont.FontName;
  if RMIsChineseGB then
  begin
    if ByteType(FCmbFont.FontName, 1) = mbSingleByte then
      CurrText.Charset := ANSI_CHARSET
    else
      CurrText.Charset := GB2312_CHARSET;
  end;
end;

procedure TRMRichForm.OnCmbFontSizeChange(Sender: TObject);
var
  liFontSize: Integer;
  lFont: TFont;
begin
  if FUpdating then Exit;

  liFontSize := RMGetFontSize(TComboBox(FCmbFontSize));
  if liFontSize > 0 then
    CurrText.Size := liFontSize
  else
  begin
    lFont := TFont.Create;
    lFont.Height := liFontSize;
    liFontSize := lFont.Size;
    CurrText.Size := liFontSize;
    lFont.Free;
  end;
end;

procedure TRMRichForm.OnColorChangeEvent(Sender: TObject);
begin
  CurrText.Color := FBtnFontColor.CurrentColor;
end;

procedure TRMRichForm.FormDestroy(Sender: TObject);
begin
  FRuler.Free;
end;

procedure TRMRichForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  OnResize := nil;
end;

procedure TRMRichForm.btnSuperscriptClick(Sender: TObject);
begin
  if FUpdating then
    Exit;
  if btnSuperscript.Down then
    RMSetSubscriptStyle(Editor, rmssSuperscript)
  else if btnSubscript.Down then
    RMSetSubscriptStyle(Editor, rmssSubscript)
  else
    RMSetSubscriptStyle(Editor, rmssNone);
end;


{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}

procedure TRMRichView_LoadFromRichEdit(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TRMRichView(Args.Obj).LoadFromRichEdit(TRMRichEdit(V2O(Args.Values[0])));
end;

const
	cRM = 'RM_RichEdit';

procedure RM_RegisterRAI2Adapter(RAI2Adapter: TJvInterpreterAdapter);
begin
  with RAI2Adapter do
  begin
    AddClass(cRM, TRMRichView, 'TRMRichView');
    AddClass(cRM, TRMRichEdit, 'TRMRichEdit');

    AddGet(TRMRichView, 'LoadFromRichEdit', TRMRichView_LoadFromRichEdit, 1, [0], varEmpty);
  end;
end;

{$IFDEF USE_RICHEDIT_VER_20}
var
  OldError: Longint;
  FLibHandle: THandle;
  Ver: TOsVersionInfo;
{$ENDIF}

initialization
  RMRegisterObjectByRes(TRMRichView, 'RM_RichObject', RMLoadStr(SInsRichObject), TRMRichForm);
//  RMRegisterControl('ReportPage Additional', 'RM_OtherComponent', False,
//    TRMRichView, 'RM_RichObject', RMLoadStr(SInsRichObject));
  RM_RegisterRAI2Adapter(GlobalJvInterpreterAdapter);

  RichEditVersion := 1;
{$IFDEF USE_RICHEDIT_VER_20}
  OldError := SetErrorMode(SEM_NOOPENFILEERRORBOX);
  try
    FLibHandle := LoadLibrary('RICHED20.DLL');
    if (FLibHandle > 0) and (FLibHandle < HINSTANCE_ERROR) then
      FLibHandle := 0;
    if FLibHandle = 0 then
    begin
      FLibHandle := LoadLibrary('RICHED32.DLL');
      if (FLibHandle > 0) and (FLibHandle < HINSTANCE_ERROR) then
        FLibHandle := 0;
    end
    else
    begin
      RichEditVersion := 2;
      Ver.dwOSVersionInfoSize := SizeOf(Ver);
      GetVersionEx(Ver);
      with Ver do
      begin
        if (dwPlatformId = VER_PLATFORM_WIN32_NT) and
          (dwMajorVersion >= 5) then
          RichEditVersion := 3;
      end;
    end;
  finally
    SetErrorMode(OldError);
  end;
{$ENDIF}

finalization
{$IFDEF USE_RICHEDIT_VER_20}
  if FLibHandle <> 0 then
    FreeLibrary(FLibHandle);
{$ENDIF}

end.