ribbonnotepaddemomain.pas

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

        Windows.GetCaretPos(P);
        P := ClientToScreen(P);
        CaretR := Rect(P.X, P.Y, P.X + 2, P.Y + 20);
        GetWindowRect(Handle, R);
        if IntersectRect(IntersectR, CaretR, R) then
          if P.Y < Screen.Height div 2 then
            Top := P.Y + 40
          else
            Top := P.Y - (R.Bottom - R.Top + 20);
      end
    else
      if not (frReplaceAll in Options) then
        Application.MessageBox(sRichEditTextNotFound,
          sRichEditFoundResultCaption, MB_ICONINFORMATION);
  end;
end;

procedure TRibbonDemoMainForm.ReplaceOne(Sender: TObject);
var
  ReplacedCount, OldSelStart, PrevSelStart: Integer;
  S: string;
begin
  with Editor, TReplaceDialog(Sender) do
  begin
    ReplacedCount := 0;
    OldSelStart := SelStart;
    if frReplaceAll in Options then
      Screen.Cursor := crHourglass;
    repeat
      if (SelLength > 0) and ((SelText = FindText) or
        (not (frMatchCase in Options) and
         (AnsiUpperCase(SelText) = AnsiUpperCase(FindText)))) then
      begin
        SelText := ReplaceText;
        Inc(ReplacedCount);
      end;
      PrevSelStart := SelStart;
      FindOne(Sender);
    until not (frReplaceAll in Options) or (SelStart = PrevSelStart);
    if frReplaceAll in Options then
    begin
      Screen.Cursor := crDefault;
      if ReplacedCount = 0 then S := sRichEditTextNotFound
      else
      begin
        SelStart := OldSelStart;
        S := Format(sRichEditReplaceAllResult, [ReplacedCount]);
      end;
      Application.MessageBox(PChar(S), sRichEditFoundResultCaption,
        MB_ICONINFORMATION);
    end;
  end;
end;

procedure TRibbonDemoMainForm.RibbonResize(Sender: TObject);
begin
  if Ribbon.QuickAccessToolbar.Position = qtpAboveRibbon then
    dxBarLargeButton8.Down := True
  else
    dxBarLargeButton9.Down := True;
end;

procedure TRibbonDemoMainForm.EditorChange(Sender: TObject);
begin
  if Editor = nil then Exit;

  Editor.OnSelectionChange(Editor);
  SetModified(Editor.Modified);
  dxBarButtonUndo.Enabled := SendMessage(Editor.Handle, EM_CANUNDO, 0, 0) <> 0;
  RibbonDemoMainForm.FEditorUndoController.AnalyseMessage;
end;

procedure TRibbonDemoMainForm.EditorMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbRight then
    dxBarPopupMenu.PopupFromCursorPos;
end;

procedure TRibbonDemoMainForm.EditorSelectionChange(Sender: TObject);
begin
  with Editor, SelAttributes do
  begin
    FUpdating := True;
    dxBarComboFontSize.OnChange := nil;
    dxBarComboFontName.OnChange := nil;
    try
       btnLineNumber.Caption := Format(' Line: %3d ', [1 + EditorRow]);
       btnColumnNumber.Caption := Format(' Row: %3d ', [1 + EditorCol]);

       dxBarButtonCopy.Enabled := SelLength > 0;
       dxBarButtonCut.Enabled := dxBarButtonCopy.Enabled;
       dxBarButtonPaste.Enabled := SendMessage(Editor.Handle, EM_CANPASTE, 0, 0) <> 0;
       dxBarButtonClear.Enabled := dxBarButtonCopy.Enabled;

       dxBarComboFontSize.Text := IntToStr(Size);
       dxBarComboFontName.Text := Name;

       dxBarButtonBold.Down := fsBold in Style;
       dxBarButtonItalic.Down := fsItalic in Style;
       dxBarButtonUnderline.Down := fsUnderline in Style;

       dxBarButtonBullets.Down := Boolean(Paragraph.Numbering);
       case Ord(Paragraph.Alignment) of
         0: dxBarButtonAlignLeft.Down := True;
         1: dxBarButtonAlignRight.Down := True;
         2: dxBarButtonCenter.Down := True;
       end;
       dxBarButtonProtected.Down := Protected;
    finally
      FUpdating := False;
      dxBarComboFontSize.OnChange := dxBarComboFontSizeChange;
      dxBarComboFontName.OnChange := dxBarComboFontNameChange;
    end;
  end;
end;

procedure TRibbonDemoMainForm.OpenFile(const AFileName: string);
begin
  if Editor.Modified then
    case QuerySaveFile of
      ID_YES:
        if not SaveFile(False) then
          Exit;
      ID_CANCEL:
        Exit;
    end;
  OpenDialog.FileName := AFileName;
  if (AFileName <> '') or OpenDialog.Execute then
  begin
    FileName := OpenDialog.FileName;
    Editor.Lines.LoadFromFile(FileName);
    SetModified(False);
  end;
end;

function TRibbonDemoMainForm.QuerySaveFile: Integer;
begin
  Result := Application.MessageBox(
    PChar(Format('Do you want to save the changes you made to "%s"?', [Ribbon.DocumentName])),
    PChar(Application.Title), MB_ICONQUESTION or MB_YESNOCANCEL);
end;

function TRibbonDemoMainForm.SaveFile(ASaveAs: Boolean; APlainText: Boolean = False): Boolean;
begin
  SaveDialog.FileName := ChangeFileExt(ExtractFileName(FileName), '');

  if APlainText then
    SaveDialog.Filter := TXTFilter
  else
    SaveDialog.Filter := RTFFilter;

  ASaveAs := ASaveAs or (FileName = '') or (FileName = sDefaultDocName);
  Result := not ASaveAs or SaveDialog.Execute;
  if Result then
  begin
    Editor.PlainText := APlainText;
    Editor.Lines.SaveToFile(SaveDialog.FileName);
    if not APlainText then
    begin
      SetModified(False);
      if ASaveAs then
        FileName := SaveDialog.FileName;
    end;
  end;
end;

procedure TRibbonDemoMainForm.SetColorScheme(const AName: string);
begin
  Ribbon.ColorSchemeName := AName;
  Panel1.Color := Ribbon.ColorScheme.GetPartColor(rfspRibbonForm);
  dxStatusBar.Invalidate;
end;

procedure TRibbonDemoMainForm.SetModified(Value: Boolean);
begin
  Editor.Modified := Value;
  if Value then
  begin
    stModified.ImageIndex := 2;
    stModified.Caption := 'Modified';
  end
  else
  begin
    stModified.ImageIndex := -1;
    stModified.Caption := '';
  end;
  dxBarButtonSave.Enabled := Value;
end;

procedure TRibbonDemoMainForm.ShowItems(AShow: Boolean);
begin
  BarManager.LockUpdate := True;
  try
    if not AShow then
    begin
      btnLineNumber.Caption := '';
      btnColumnNumber.Caption := '';
      stModified.Caption := '';
    end;
    BarManager.Groups[0].Enabled := AShow;
  finally
    BarManager.LockUpdate := False;
  end;
end;

procedure TRibbonDemoMainForm.UpdateActionsImages;
begin
  dxBarButton7.LargeImageIndex := 18;
  dxBarButton7.ImageIndex := 18;
  dxBarLargeButton1.LargeImageIndex := 18;
  dxBarLargeButton1.ImageIndex := 18;
  dxBarButton1.LargeImageIndex := 19;
  dxBarButton1.ImageIndex := 19;
  dxBarButton3.LargeImageIndex := 20;
  dxBarButton3.ImageIndex := 20;
  dxBarButton4.LargeImageIndex := 21;
  dxBarButton4.ImageIndex := 21;
  dxBarButton5.LargeImageIndex := 22;
  dxBarButton5.ImageIndex := 22;
end;

procedure TRibbonDemoMainForm.AssignFontColorGlyph;
begin
  dxBarButtonFontColor.Glyph := rgiFontColor.Glyph;
end;

procedure TRibbonDemoMainForm.FontColorChanged(Sender: TObject);
begin
  AssignFontColorGlyph;
  dxBarButtonFontColorClick(nil);
end;

procedure TRibbonDemoMainForm.SetFontColor;
begin
  Editor.SelAttributes.Color := FColorPickerController.Color;
  FEditorUndoController.AddAction(6);
end;

procedure TRibbonDemoMainForm.Undo(Count: Integer);
begin
  FEditorUndoController.Lock;
  try
    while Count > 0 do
    begin
      SendMessage(Editor.Handle, EM_UNDO, 0, 0);
      FEditorUndoController.PopUndo;
      Dec(Count);
    end;
  finally
    FEditorUndoController.Unlock;
  end;
end;

procedure TRibbonDemoMainForm.FormActivate(Sender: TObject);
begin
  if FCanOnChange then
    Editor.OnChange(Editor)
  else
    FCanOnChange := True;
end;

procedure TRibbonDemoMainForm.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  if Editor.Modified then
    case QuerySaveFile of
      ID_YES: CanClose := SaveFile(False);
      ID_NO: CanClose := True;
      ID_CANCEL: CanClose := False;
    end;
end;

procedure TRibbonDemoMainForm.FormCreate(Sender: TObject);

  procedure InitSymbolGallery;

    procedure AddItem(AGroup: TdxRibbonGalleryGroup; ACode: Integer);

      function CreateBitmap(const AFont: string; AChar: WideChar): TcxBitmap;
      var
        AGlyphSize: Integer;
        R: TRect;
      begin
        AGlyphSize := Round(32 * DPIRatio);
        R := Rect(0, 0, AGlyphSize, AGlyphSize);
        Result := TcxBitmap.CreateSize(R);
        Result.Canvas.Brush.Color := $FAFAFA;
        Result.Canvas.FillRect(R);
        Result.Canvas.Font.Name := AFont;
        Result.Canvas.Font.Color := $5C534C;
        Result.Canvas.Font.Size := Round(16 * DPIRatio);
        DrawTextW(Result.Canvas.Handle, @AChar, 1, R, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
        Result.TransformBitmap(btmSetOpaque);
      end;

    var
      AItem: TdxRibbonGalleryGroupItem;
      AFont: string;
      ABitmap: TcxBitmap;
    begin
      AItem := AGroup.Items.Add;
      AFont := 'Times New Roman';
      AItem.Caption := AFont + ' #' + IntToStr(ACode);
      AItem.Description := AFont;
      AItem.Tag := ACode;
      ABitmap := CreateBitmap(AFont, WideChar(ACode));
      AItem.Glyph := ABitmap;
      ABitmap.Free;
    end;

    procedure PopulateGroup(AGroupIndex: Integer; AMap: array of Integer);
    var
      I: Integer;
    begin
      for I := Low(AMap) to High(AMap) do
        AddItem(rgiItemSymbol.GalleryGroups[AGroupIndex], AMap[I]);
    end;

  const
    AMathMap: array [0..7] of Integer = ($B1, $2260, $2264, $2265, $F7, $D7, $221E, $2211);
    AGreekMap: array [0..9] of integer = ($03B1, $03B2, $03B3, $03B4, $03B5, $03B6, $03B7, $03B8, $03B9, $03BA);
    ASymbolMap: array [0..2] of Integer = ($A9, $AE, $2122);
    ACurrencyMap: array [0..4] of Integer = ($20AC, $24, $A3, $A5, $20A3);
  begin
    PopulateGroup(0, AMathMap);
    PopulateGroup(1, AGreekMap);
    PopulateGroup(2, ASymbolMap);
    PopulateGroup(3, ACurrencyMap);
  end;

var
  ATextWidth: Integer;
begin
  dmCommonData.AboutFormClass := TRibbonDemoAboutForm;
  if FileExists(sDefaultDocName) then
    OpenFile(ExpandFileName(sDefaultDocName))
  else
    FileName := sDefaultDocName;

  OpenDialog.Filter := RTFFilter;
  OpenDialog.InitialDir := ExtractFilePath(ParamStr(0));
  SaveDialog.InitialDir := OpenDialog.InitialDir;
  ShowItems(True);
  UpdateActionsImages;

  FColorPickerController := TColorPickerController.Create(rgiFontColor, rgiColorTheme, dxRibbonDropDownGallery);
  FColorPickerController.OnColorChanged := FontColorChanged;
  AssignFontColorGlyph;

  InitSymbolGallery;
  SetColorScheme('Blue');

  FEditorUndoController := TRichEditUndoController.Create(rgiUndo, Editor);
  Editor.OnChange(Editor);

  ATextWidth := cxTextWidth(BarManager.Font, 'Undo 9999 Actions');
  with rgiUndo do
  begin
    GalleryOptions.ItemPullHighlighting.Active := True;
    GalleryOptions.ColumnCount := 1;

    GalleryOptions.SubMenuResizing := gsrNone;

    GalleryOptions.ItemSize.Width := ATextWidth;
    GalleryOptions.ItemSize.Height := Max(cxTextHeight(BarManager.Font), Round(21 * DPIRatio));

    GalleryGroups.Add;
  end;
  bstSelectionInfo.Width := ATextWidth;
  bstSelectionInfo.Caption := 'Cancel';
end;

procedure TRibbonDemoMainForm.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FEditorUndoController);
  FreeAndNil(FColorPickerController);
end;

procedure TRibbonDemoMainForm.dxBarButtonNewClick(Sender: TObject);
begin
  if Editor.Modified then
    case QuerySaveFile of
      ID_YES:
        if SaveFile(False) then
          MakeNewDocument;
      ID_NO:
        MakeNewDocument;
    end
  else
    MakeNewDocument;
end;

procedure TRibbonDemoMainForm.dxBarButtonOpenClick(Sender: TObject);
begin
  OpenFile('');
end;

procedure TRibbonDemoMainForm.dxBarButtonCloseClick(Sender: TObject);
begin
  Close;
end;