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

📄 ribbonnotepaddemomain.pas

📁 胜天进销存源码,国产优秀的进销存
💻 PAS
📖 第 1 页 / 共 4 页
字号:
unit RibbonNotepadDemoMain;

interface

uses
  Types, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ComCtrls, dxBar, StdCtrls, dxBarExtItems, cxControls,
  ImgList, ActnList, cxLookAndFeels, dxStatusBar, cxGraphics, EBarsUtils,
  dxRibbonForm, dxRibbon, cxClasses, Menus, dxRibbonStatusBar, cxStyles,
  dxRibbonGallery, dxOffice11, cxGeometry, dxRibbonGalleryFilterEd;

const
  SchemeColorCount = 10;

type
  TColorMap = array [0..SchemeColorCount-1] of TColor;

  TColorPickerController = class
  private
    FColor: TColor;
    FColorGlyphSize: Integer;
    FColorDialog: TColorDialog;
    FColorDropDownGallery: TdxRibbonDropDownGallery;
    FColorItem: TdxRibbonGalleryItem;
    FColorMapItem: TdxRibbonGalleryItem;

    FThemeColorsGroup: TdxRibbonGalleryGroup;
    FAccentColorsGroup: TdxRibbonGalleryGroup;
    FStandardColorsGroup: TdxRibbonGalleryGroup;
    FCustomColorsGroup: TdxRibbonGalleryGroup;

    FMoreColorsButton: TdxBarButton;
    FNoColorButton: TdxBarButton;
    FColorDialogSetup: TdxBarButton;
    FOnColorChanged: TNotifyEvent;

    function GetBarManager: TdxBarManager;
    function GetRibbon: TdxCustomRibbon;
    procedure SetColor(Value: TColor);

    procedure ColorItemClick(Sender: TdxRibbonGalleryItem; AItem: TdxRibbonGalleryGroupItem);
    procedure ColorMapItemClick(Sender: TdxRibbonGalleryItem; AItem: TdxRibbonGalleryGroupItem);
    procedure NoColorButtonClick(Sender: TObject);
    procedure MoreColorsClick(Sender: TObject);
    procedure ColorDialogSetupButtonClick(Sender: TObject);

    property BarManager: TdxBarManager read GetBarManager;
    property Ribbon: TdxCustomRibbon read GetRibbon;
  protected
    function AddColorItem(AGalleryGroup: TdxRibbonGalleryGroup; AColor: TColor): TdxRibbonGalleryGroupItem;
    function CreateColorBitmap(AColor: TColor; AGlyphSize: Integer = 0): TcxBitmap;
    procedure CreateColorRow(AGalleryGroup: TdxRibbonGalleryGroup; AColorMap: TColorMap);
    procedure BuildThemeColorGallery;
    procedure BuildStandardColorGallery;
    procedure BuildColorSchemeGallery;

    procedure ColorChanged;
    procedure ColorMapChanged;
  public
    constructor Create(AColorItem, AColorMapItem: TdxRibbonGalleryItem; AColorDropDownGallery: TdxRibbonDropDownGallery);
    destructor Destroy; override;

    property Color: TColor read FColor;
    property OnColorChanged: TNotifyEvent read FOnColorChanged write FOnColorChanged;
  end;

  TRichEdit = class(ComCtrls.TRichEdit)
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  end;

  TRichEditUndoController = class
  private
    FLastMessageID: Integer;
    FIsLocked: Boolean;
    FGalleryItem: TdxRibbonGalleryItem;
    FEditor: TRichEdit;
  protected
    procedure AddAction(AnActionID: Integer);
    procedure PopUndo;
    procedure PushUndo(AnAction: string);
  public
    constructor Create(AGalleryItem: TdxRibbonGalleryItem; AEditor: TRichEdit);
    procedure AnalyseMessage;
    procedure Lock;
    procedure UnLock;
  end;

  TRibbonDemoMainForm = class(TdxRibbonForm)
    BarManager: TdxBarManager;
    dxBarButtonNew: TdxBarLargeButton;
    dxBarButtonOpen: TdxBarLargeButton;
    dxBarButtonSave: TdxBarLargeButton;
    dxBarSubItemSaveAs: TdxBarSubItem;
    dxBarButtonSaveAsRTF: TdxBarButton;
    dxBarButtonSaveAsText: TdxBarButton;
    dxBarButtonPrint: TdxBarLargeButton;
    dxBarButtonExit: TdxBarLargeButton;
    dxBarButtonUndo: TdxBarLargeButton;
    dxBarButtonCut: TdxBarLargeButton;
    dxBarButtonCopy: TdxBarLargeButton;
    dxBarButtonPaste: TdxBarLargeButton;
    dxBarButtonClear: TdxBarLargeButton;
    dxBarButtonSelectAll: TdxBarLargeButton;
    dxBarButtonFind: TdxBarLargeButton;
    dxBarButtonReplace: TdxBarLargeButton;
    dxBarComboFontSize: TdxBarCombo;
    dxBarButtonBold: TdxBarLargeButton;
    dxBarButtonItalic: TdxBarLargeButton;
    dxBarButtonUnderline: TdxBarLargeButton;
    dxBarButtonBullets: TdxBarLargeButton;
    dxBarButtonProtected: TdxBarLargeButton;
    dxBarButtonAlignLeft: TdxBarLargeButton;
    dxBarButtonCenter: TdxBarLargeButton;
    dxBarButtonAlignRight: TdxBarLargeButton;
    dxBarButtonFont: TdxBarLargeButton;
    dxBarSeparator: TdxBarSeparator;

    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    PrintDialog: TPrintDialog;
    FontDialog: TFontDialog;
    dxBarPopupMenu: TdxRibbonPopupMenu;
    dxBarGroup1: TdxBarGroup;
    dxBarButton1: TdxBarLargeButton;
    dxBarButton2: TdxBarLargeButton;
    dxBarButton3: TdxBarLargeButton;
    dxBarButton4: TdxBarLargeButton;
    dxBarButton5: TdxBarLargeButton;
    dxBarButton6: TdxBarLargeButton;
    dxBarButton7: TdxBarLargeButton;
    dxBarComboFontName: TdxBarFontNameCombo;
    dxBarLargeButton1: TdxBarLargeButton;
    dxBarLargeButton2: TdxBarLargeButton;
    ilStatusBarImages: TImageList;
    dxStatusBar: TdxRibbonStatusBar;
    FindDialog: TFindDialog;
    ReplaceDialog: TReplaceDialog;
    tabHome: TdxRibbonTab;
    Ribbon: TdxRibbon;
    tabAppearance: TdxRibbonTab;
    BarManagerBar5: TdxBar;
    BarManagerBar7: TdxBar;
    ApplicationMenu: TdxBarApplicationMenu;
    BarManagerBar8: TdxBar;
    BarManagerBar1: TdxBar;
    dxBarLargeButtonBlueScheme: TdxBarLargeButton;
    dxBarLargeButtonBlackScheme: TdxBarLargeButton;
    dxBarLargeButtonSilverScheme: TdxBarLargeButton;
    BarManagerBar9: TdxBar;
    dxBarLargeButton6: TdxBarLargeButton;
    dxBarLargeButton7: TdxBarLargeButton;
    BarManagerBar10: TdxBar;
    dxBarLargeButton8: TdxBarLargeButton;
    dxBarLargeButton9: TdxBarLargeButton;
    dxBarLargeButton10: TdxBarLargeButton;
    BarManagerBar11: TdxBar;
    BarManagerBar12: TdxBar;
    Editor: TRichEdit;
    dxBarScreenTipRepository1: TdxBarScreenTipRepository;
    cxLargeImages: TcxImageList;
    cxSmallImages: TcxImageList;
    BarManagerBar6: TdxBar;
    BarManagerBar13: TdxBar;
    btnLineNumber: TdxBarButton;
    btnColumnNumber: TdxBarButton;
    btnLocked: TdxBarButton;
    cxStyleRepository1: TcxStyleRepository;
    cxStyle1: TcxStyle;
    stModified: TdxBarStatic;
    stFontDialog: TdxBarScreenTip;
    stHelpButton: TdxBarScreenTip;
    dxBarButtonOptions: TdxBarButton;
    rgiFontColor: TdxRibbonGalleryItem;
    rgiColorTheme: TdxRibbonGalleryItem;
    dxBarButtonFontColor: TdxBarButton;
    dxRibbonDropDownGallery: TdxRibbonDropDownGallery;
    rgiItemSymbol: TdxRibbonGalleryItem;
    Panel1: TPanel;
    UndoDropDownGallery: TdxRibbonDropDownGallery;
    rgiUndo: TdxRibbonGalleryItem;
    bstSelectionInfo: TdxBarStatic;
    dxBarSubItem1: TdxBarSubItem;
    dxBarStatic1: TdxBarStatic;
    dxBarButton8: TdxBarButton;

    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);

    procedure dxBarButtonNewClick(Sender: TObject);
    procedure dxBarButtonOpenClick(Sender: TObject);
    procedure dxBarButtonCloseClick(Sender: TObject);
    procedure dxBarButtonSaveClick(Sender: TObject);
    procedure dxBarButtonSaveAsRTFClick(Sender: TObject);
    procedure dxBarButtonSaveAsTextClick(Sender: TObject);
    procedure dxBarButtonPrintClick(Sender: TObject);
    procedure dxBarButtonExitClick(Sender: TObject);

    procedure dxBarButtonUndoClick(Sender: TObject);
    procedure dxBarButtonCutClick(Sender: TObject);
    procedure dxBarButtonCopyClick(Sender: TObject);
    procedure dxBarButtonPasteClick(Sender: TObject);
    procedure dxBarButtonClearClick(Sender: TObject);
    procedure dxBarButtonSelectAllClick(Sender: TObject);
    procedure dxBarButtonFindClick(Sender: TObject);
    procedure dxBarButtonReplaceClick(Sender: TObject);

    procedure dxBarComboFontNameChange(Sender: TObject);
    procedure dxBarComboFontSizeChange(Sender: TObject);
    procedure dxBarButtonBoldClick(Sender: TObject);
    procedure dxBarButtonItalicClick(Sender: TObject);
    procedure dxBarButtonUnderlineClick(Sender: TObject);
    procedure dxBarButtonBulletsClick(Sender: TObject);
    procedure dxBarButtonAlignClick(Sender: TObject);
    procedure dxBarButtonProtectedClick(Sender: TObject);
    procedure FontClick(Sender: TObject);
    procedure FindOne(Sender: TObject);
    procedure ReplaceOne(Sender: TObject);
    procedure dxBarLargeButtonBlueSchemeClick(Sender: TObject);
    procedure dxBarLargeButtonBlackSchemeClick(Sender: TObject);
    procedure dxBarLargeButtonSilverSchemeClick(Sender: TObject);
    procedure dxBarLargeButton10Click(Sender: TObject);
    procedure dxBarLargeButton8Click(Sender: TObject);
    procedure dxBarLargeButton9Click(Sender: TObject);
    procedure dxBarLargeButton6Click(Sender: TObject);
    procedure dxBarLargeButton7Click(Sender: TObject);

    procedure EditorChange(Sender: TObject);
    procedure EditorSelectionChange(Sender: TObject);
    procedure EditorMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure RibbonResize(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormActivate(Sender: TObject);
    procedure ApplicationMenuRecentDocumentsClick(Sender: TObject;
      AIndex: Integer);
    procedure btnLockedClick(Sender: TObject);
    procedure RibbonHelpButtonClick(Sender: TdxCustomRibbon);
    procedure RibbonHideMinimizedByClick(Sender: TdxCustomRibbon;
      AWnd: Cardinal; AShift: TShiftState; const APos: TPoint;
      var AAllowProcessing: Boolean);
    procedure dxBarButtonOptionsClick(Sender: TObject);
    procedure dxBarButtonFontColorClick(Sender: TObject);
    procedure rgiItemSymbolGroupItemClick(Sender: TdxRibbonGalleryItem;
      AItem: TdxRibbonGalleryGroupItem);
    procedure rgiUndoHotTrackedItemChanged(APrevHotTrackedGroupItem,
      ANewHotTrackedGroupItem: TdxRibbonGalleryGroupItem);
    procedure rgiUndoGroupItemClick(Sender: TdxRibbonGalleryItem;
      AItem: TdxRibbonGalleryGroupItem);
  private
    FCanOnChange: Boolean;
    FFileName: string;
    FUpdating: Boolean;
    FColorPickerController: TColorPickerController;
    FEditorUndoController: TRichEditUndoController;

    function GetEditorCol: Integer;
    function GetEditorRow: Integer;
    procedure MakeNewDocument;
    procedure SetFileName(Value: string);
    procedure UpdateActionsImages;

    procedure AssignFontColorGlyph;
    procedure FontColorChanged(Sender: TObject);
    procedure SetFontColor;
    procedure Undo(Count: Integer);
  public
    procedure OpenFile(const AFileName: string);
    function QuerySaveFile: Integer;
    function SaveFile(ASaveAs: Boolean; APlainText: Boolean = False): Boolean;
    procedure SetColorScheme(const AName: string);
    procedure SetModified(Value: Boolean);
    procedure ShowItems(AShow: Boolean);

    property EditorCol: Integer read GetEditorCol;
    property EditorRow: Integer read GetEditorRow;
    property FileName: string read FFileName write SetFileName;
  end;

var
  RibbonDemoMainForm: TRibbonDemoMainForm;

implementation

{$R *.DFM}
{$R windowsxp.res}

uses
  RichEdit, RibbonNotepadDemoOptions, RibbonDemoAbout, ClipBrd,
  dxRibbonSkins, RibbonNotepadDemoGallerySetup, Math;

type
  TColorMapInfo = record
    Name: string;
    Map: TColorMap;
  end;
  TAccent = (aLight80, aLight60, aLight50, aLight40, aLight35, aLight25, aLight15, aLight5, aDark10, aDark25, aDark50, aDark75, aDark90);

const
  sRichEditFoundResultCaption = 'Information';
  sRichEditTextNotFound = 'The search text is not found.';
  sRichEditReplaceAllResult = 'Replaced %d occurances.';
  sDefaultDocName = 'Document1.rtf';

  RTFFilter = 'Rich Text Files (*.RTF)|*.RTF';
  TXTFilter = 'Plain text (*.TXT)|*.TXT';

  AStandardColorMap: TColorMap =
    ($0000C0, $0000FF, $00C0FF, $00FFFF, $50D092, $50B000, $F0B000, $C07000, $602000, $A03070);
  AColorMaps: array [0..5] of TColorMapInfo =(
    (Name: 'Default'; Map: (clWindow, clWindowText, $D2B48C, $00008B, $0000FF, $FF0000, $556B2F, $800080, clAqua, $FFA500)),
    (Name: 'Theme1'; Map: (clWindow, clWindowText, $7D491F, $E1ECEE, $BD814F, $4D50C0, $59BB9B, $A26480, $C6AC4B, $4696F7)),
    (Name: 'Theme2'; Map: (clWindow, clWindowText, $6D6769, $D1C2C9, $66B9CE, $84B09C, $C9B16B, $CF8565, $C96B7E, $BB79A3)),
    (Name: 'Theme3'; Map: (clWindow, clWindowText, $323232, $D1DEE3, $097FF0, $36299F, $7C581B, $42854E, $784860, $5998C1)),
    (Name: 'Theme4'; Map: (clWindow, clWindowText, $866B64, $D7D1C5, $4963D1, $00B4CC, $AEAD8C, $707B8C, $8CB08F, $4990D1)),
    (Name: 'Theme5'; Map: (clWindow, clWindowText, $464646, $FAF5DE, $BFA22D, $281FDA, $1B64EB, $9D6339, $784B47, $4A3C7D))
  );

function DPIRatio: Single;
begin
  Result := Screen.PixelsPerInch / 96;
end;

function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
  FontType: Integer; Data: Pointer): Integer; stdcall;
begin
  TStrings(Data).Add(LogFont.lfFaceName);
  Result := 1;
end;

function TRibbonDemoMainForm.GetEditorCol: Integer;
begin
  with Editor do
    Result := SelStart - SendMessage(Handle, EM_LINEINDEX, EditorRow, 0);
end;

function TRibbonDemoMainForm.GetEditorRow: Integer;
begin
  with Editor do
    Result := SendMessage(Handle, EM_LINEFROMCHAR, SelStart, 0);
end;

procedure TRibbonDemoMainForm.MakeNewDocument;
begin
  Editor.Clear;
  SetModified(False);
  FileName := sDefaultDocName;
end;

procedure TRibbonDemoMainForm.SetFileName(Value: string);
var
  AIndex: Integer;
begin
  Ribbon.DocumentName := ExtractFileName(Value);
  FFileName := Value;

  if FileExists(FFileName) then
  begin
    AIndex := ApplicationMenu.ExtraPaneItems.IndexOf(FFileName);
    if AIndex > -1 then
      ApplicationMenu.ExtraPaneItems.Delete(AIndex);
    ApplicationMenu.ExtraPaneItems.Insert(0).Text := FFileName;
  end;
end;

procedure TRibbonDemoMainForm.FindOne(Sender: TObject);
var
  StartPos, FindLength, FoundAt: Integer;
  Flags: TSearchTypes;
  P: TPoint;
  CaretR, R, IntersectR: TRect;
begin
  with Editor, TFindDialog(Sender) do
  begin
    if frDown in Options then
    begin
      if SelLength = 0 then StartPos := SelStart
      else StartPos := SelStart + SelLength;
      FindLength := Length(Text) - StartPos;
    end
    else
    begin
      StartPos := SelStart;
      FindLength := -StartPos;
    end;
    Flags := [];
    if frMatchCase in Options then Include(Flags, stMatchCase);
    if frWholeWord in Options then Include(Flags, stWholeWord);
    Screen.Cursor := crHourglass;
    FoundAt := Editor.FindText(FindText, StartPos, FindLength, Flags);
    if not (frReplaceAll in Options) then Screen.Cursor := crDefault;
    if FoundAt > -1 then
      if frReplaceAll in Options then
      begin
        SelStart := FoundAt;
        SelLength := Length(FindText);
      end
      else
      begin
        SetFocus;
        SelStart := FoundAt;
        SelLength := Length(FindText);

⌨️ 快捷键说明

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