ribbonnotepaddemomain.pas

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

          aDark25: AColor := Dark(AColorMap[AMapIndex], 75);
          aDark50: AColor := Dark(AColorMap[AMapIndex], 50);
          aDark75: AColor := Dark(AColorMap[AMapIndex], 25);
        else {aDark90}
          AColor := Dark(AColorMap[I], 10);
        end;
        AnAccentColorScheme[I][AMapIndex] := AColor;
      end;
    end;

  var
    I: Integer;
  begin
    for I := Low(AColorMap) to High(AColorMap) do
      if GetBrightness(ColorToRGB(AColorMap[I])) < 20 then
        CreateAccent([aLight50, aLight35, aLight25, aLight15, aLight5], I)
      else
        if GetBrightness(ColorToRGB(AColorMap[I])) < 230 then
          CreateAccent([aLight80, aLight60, aLight60, aDark25, aDark50], I)
        else
          CreateAccent([aDark10, aDark25, aDark50, aDark75, aDark90], I)
  end;

var
  I: Integer;
  AColorMap: TColorMap;
  AnAccentColorScheme: array [0..AnAccentCount-1] of TColorMap;
begin
  BarManager.BeginUpdate;
  try
    FThemeColorsGroup.Items.Clear;
    AColorMap := AColorMaps[FColorMapItem.SelectedGroupItem.Index].Map;
    CreateColorRow(FThemeColorsGroup, AColorMap);

    FAccentColorsGroup.Items.Clear;
    GetAccentColorScheme(AColorMap, AnAccentColorScheme);
    for I := Low(AnAccentColorScheme) to High(AnAccentColorScheme) do
      CreateColorRow(FAccentColorsGroup, AnAccentColorScheme[I]);
  finally
    BarManager.EndUpdate;
  end;
end;

procedure TColorPickerController.BuildStandardColorGallery;
begin
  BarManager.BeginUpdate;
  try
    FStandardColorsGroup.Items.Clear;
    CreateColorRow(FStandardColorsGroup, AStandardColorMap);
  finally
    BarManager.EndUpdate;
  end;
end;

procedure TColorPickerController.BuildColorSchemeGallery;
const
  ASystemColorCount = 2;
  AGlyphOffset = 1;
var
  I, J: Integer;
  ABitmap, AColorBitmap: TcxBitmap;
  ARect: TRect;
  AGroupItem: TdxRibbonGalleryGroupItem;
  AThemeColorCount: Integer;
begin
  BarManager.BeginUpdate;
  try
    AThemeColorCount := SchemeColorCount - ASystemColorCount;
    ABitmap := TcxBitmap.CreateSize(FColorGlyphSize * AThemeColorCount + (AThemeColorCount - 1) * AGlyphOffset, FColorGlyphSize);
    try
      for I := High(AColorMaps) downto Low(AColorMaps) do
      begin
        AGroupItem := FColorMapItem.GalleryGroups[0].Items.Insert(0);
        for J := Low(AColorMaps[I].Map) + ASystemColorCount to High(AColorMaps[I].Map) do
        begin
          AColorBitmap := CreateColorBitmap(AColorMaps[I].Map[J]);
          try
            ARect := cxRectOffset(AColorBitmap.ClientRect, (AColorBitmap.Width + AGlyphOffset) * (J - ASystemColorCount), 0);
            ABitmap.CopyBitmap(AColorBitmap, ARect, cxNullPoint);
          finally
            AColorBitmap.Free;
          end;
        end;
        AGroupItem.Glyph := ABitmap;
        AGroupItem.Caption := AColorMaps[I].Name;
      end;
      AGroupItem.Selected := True;
    finally
      ABitmap.Free;
    end;
  finally
    BarManager.EndUpdate;
  end;
end;

procedure TColorPickerController.ColorChanged;
var
  AGlyph: TcxBitmap;
begin
  AGlyph := CreateColorBitmap(Color, Round(16 * DPIRatio));
  try
    FColorItem.Glyph := AGlyph;
  finally
    AGlyph.Free;
  end;

  if Assigned(OnColorChanged) then
    OnColorChanged(Self);
end;

procedure TColorPickerController.ColorMapChanged;

  procedure FillGlyph(AGlyph: TcxBitmap);
  var
    ARect: TRect;
    ADC: HDC;
  begin
    ARect := Rect(0, 0, AGlyph.Width div 2, AGlyph.Height div 2);
    ADC := AGlyph.Canvas.Handle;
    FillRectByColor(ADC, ARect, AColorMaps[FColorMapItem.SelectedGroupItem.Index].Map[2]);
    FillRectByColor(ADC, cxRectOffset(ARect, cxRectWidth(ARect), 0), AColorMaps[FColorMapItem.SelectedGroupItem.Index].Map[3]);
    FillRectByColor(ADC, cxRectOffset(ARect, 0, cxRectHeight(ARect)), AColorMaps[FColorMapItem.SelectedGroupItem.Index].Map[4]);
    FillRectByColor(ADC, cxRectOffset(ARect, cxRectWidth(ARect), cxRectHeight(ARect)), AColorMaps[FColorMapItem.SelectedGroupItem.Index].Map[5]);
    FrameRectByColor(ADC, AGlyph.ClientRect, clGray);
    AGlyph.TransformBitmap(btmSetOpaque);
  end;

var
  AGlyph: TcxBitmap;
begin
  BarManager.BeginUpdate;
  try
    AGlyph := TcxBitmap.CreateSize(16, 16);
    FillGlyph(AGlyph);
    FColorMapItem.Glyph := AGlyph;
    AGlyph.SetSize(32, 32);
    FillGlyph(AGlyph);
    FColorMapItem.LargeGlyph := AGlyph;
    AGlyph.Free;
  finally
    BarManager.EndUpdate(False);
  end
end;

function TColorPickerController.GetBarManager: TdxBarManager;
begin
  Result := FColorItem.BarManager;
end;

function TColorPickerController.GetRibbon: TdxCustomRibbon;
begin
  Result := FColorDropDownGallery.Ribbon;
end;

procedure TColorPickerController.SetColor(Value: TColor);
begin
  if FColor <> Value then
  begin
    FColor := Value;
    ColorChanged;
  end;
end;

procedure TColorPickerController.ColorItemClick(Sender: TdxRibbonGalleryItem; AItem: TdxRibbonGalleryGroupItem);
begin
  FNoColorButton.Down := False;
  if FColorItem.SelectedGroupItem <> nil then
    SetColor(FColorItem.SelectedGroupItem.Tag);
end;

procedure TColorPickerController.ColorMapItemClick(Sender: TdxRibbonGalleryItem; AItem: TdxRibbonGalleryGroupItem);
begin
  BuildThemeColorGallery;
  ColorMapChanged;
end;

procedure TColorPickerController.NoColorButtonClick(Sender: TObject);
begin
  if FColorItem.SelectedGroupItem <> nil then
    FColorItem.SelectedGroupItem.Selected := False;
  SetColor(clNone);
end;

procedure TColorPickerController.MoreColorsClick(Sender: TObject);
begin
  FColorDialog.Color := Color;
  if FColorDialog.Execute then
  begin
    FCustomColorsGroup.Header.Visible := True;
    AddColorItem(FCustomColorsGroup, FColorDialog.Color).Selected := True;
  end;
end;

procedure TColorPickerController.ColorDialogSetupButtonClick(Sender: TObject);
var
  RemoveHorizontalPadding, RemoveVerticalPadding: Boolean;
begin
  RemoveHorizontalPadding := FColorItem.GalleryOptions.SpaceBetweenItemsHorizontally = -1;
  RemoveVerticalPadding := FColorItem.GalleryGroups[1].Options.SpaceBetweenItemsVertically = -1;
  if ColorDialogSetupForm.GetSettings(RemoveHorizontalPadding,
    RemoveVerticalPadding) then
  begin
    FColorItem.GalleryOptions.SpaceBetweenItemsHorizontally :=
      -Ord(RemoveHorizontalPadding);
    FColorItem.GalleryGroups[1].Options.SpaceBetweenItemsVertically :=
      -Ord(RemoveVerticalPadding);
  end;
end;

type
  TClipboardAccess = class(TClipboard);

procedure TRibbonDemoMainForm.rgiItemSymbolGroupItemClick(
  Sender: TdxRibbonGalleryItem; AItem: TdxRibbonGalleryGroupItem);

  procedure InsertSymbol(AChar: WideChar);
  var
    S: WideString;
  begin
    Editor.SelAttributes.Name := AItem.Description;
    with TClipboardAccess(Clipboard) do
    begin
      Open;
      try
        S := AChar;
        SetBuffer(CF_UNICODETEXT, PWideChar(S)^, (Length(S) + 1) * SizeOf(WideChar));
      finally
        Close;
      end;
    end;
    Editor.PasteFromClipboard;
  end;

begin
  InsertSymbol(WideChar(AItem.Tag));
end;

{ TRichEdit }

type
  TStringsArray = array of string;

var
  FRichEditLibrary: HMODULE = 0;

procedure TRichEdit.CreateParams(var Params: TCreateParams);

  procedure InitRichEditClassNames(var ARichEditClassNames: TStringsArray);
  const
    RichEditClassNamesCount = 5;
  begin
    SetLength(ARichEditClassNames, RichEditClassNamesCount);
    ARichEditClassNames[0] := 'RICHEDIT';
    ARichEditClassNames[1] := 'RICHEDIT20';
    ARichEditClassNames[2] := 'RICHEDIT30';
    ARichEditClassNames[3] := 'RICHEDIT41';
    ARichEditClassNames[4] := 'RICHEDIT50';
  end;

var
  ARichClassName: string;
  AWndClass: TWndClass;
  I: Integer;
  ARichEditClassNames: TStringsArray;
begin
  inherited;

  if FRichEditLibrary <> 0 then
  begin
    InitRichEditClassNames(ARichEditClassNames);
    for I := High(ARichEditClassNames) downto Low(ARichEditClassNames) do
    begin
      ARichClassName := ARichEditClassNames[I] + 'A';
      if GetClassInfo(HInstance, PChar(ARichClassName), AWndClass) then
        Break;
      ARichClassName := ARichEditClassNames[I];
      if GetClassInfo(HInstance, PChar(ARichClassName), AWndClass) then
        Break;
    end;
    if GetClassInfo(HInstance, PChar(ARichClassName), AWndClass) then
      CreateSubClass(Params, PChar(ARichClassName));
  end;
end;

procedure LoadRichDll;

  procedure InitRichEditDLLNames(var ARichEditDLLNames: TStringsArray);
  const
    RichEditDLLNamesCount = 3;
  begin
    SetLength(ARichEditDLLNames, RichEditDLLNamesCount);
    ARichEditDLLNames[0] :=  'Riched32.dll';
    ARichEditDLLNames[1] :=  'Riched20.dll';
    ARichEditDLLNames[2] :=  'Msftedit.dll';
  end;

var
  ARichEditDLLNames: TStringsArray;
  I: Integer;
begin
  InitRichEditDLLNames(ARichEditDLLNames);
  for I := High(ARichEditDLLNames) downto Low(ARichEditDLLNames) do
  begin
    FRichEditLibrary := LoadLibrary(PChar(ARichEditDLLNames[I]));
    if FRichEditLibrary <> 0 then
      Break;
  end;
end;

constructor TRichEditUndoController.Create(AGalleryItem: TdxRibbonGalleryItem;
  AEditor: TRichEdit);
begin
  inherited Create;
  FGalleryItem := AGalleryItem;
  FEditor := AEditor;
end;

procedure TRichEditUndoController.AnalyseMessage;
var
  AMessageID: Integer;
begin
  if FIsLocked then Exit;
  AMessageID := SendMessage(FEditor.Handle, EM_GETUNDONAME, 0, 0);
  if (AMessageID > 1) or (AMessageID = 1) and (AMessageID <> FLastMessageID) then
    AddAction(AMessageID);
end;

procedure TRichEditUndoController.Lock;
begin
  FIsLocked := True;
  FLastMessageID := 0;
end;

procedure TRichEditUndoController.UnLock;
begin
  FIsLocked := False;
end;

procedure TRichEditUndoController.AddAction(AnActionID: Integer);
const
  RichEditAction: array[0..6] of string = ('Unknown', 'Typing', 'Delete',
    'Drug And Drop', 'Cut', 'Paste', 'Color Change');
begin
  if (AnActionID <> 6) or (FEditor.GetSelLength <> 0) then
    PushUndo(RichEditAction[AnActionID]);
  FLastMessageID := AnActionID;
end;

procedure TRichEditUndoController.PopUndo;
var
  AGroup: TdxRibbonGalleryGroup;
begin
  AGroup := FGalleryItem.GalleryGroups[0];
  if AGroup.Items.Count > 0 then
    AGroup.Items.Delete(0);
end;

procedure TRichEditUndoController.PushUndo(AnAction: string);
var
  AGroup: TdxRibbonGalleryGroup;
begin
  AGroup := FGalleryItem.GalleryGroups[0];
  AGroup.Items.Insert(0);
  AGroup.Items[0].Caption := AnAction;
end;

procedure TRibbonDemoMainForm.rgiUndoHotTrackedItemChanged(
  APrevHotTrackedGroupItem,
  ANewHotTrackedGroupItem: TdxRibbonGalleryGroupItem);
var
  ACount: Integer;
  AString: string;
begin
  if ANewHotTrackedGroupItem <> nil then
  begin
    ACount := ANewHotTrackedGroupItem.Index + 1;
    bstSelectionInfo.Caption := 'Undo ' + IntToStr(ACount);
    if ACount = 1 then
      AString := ' Action'
    else
      AString := ' Actions';
    bstSelectionInfo.Caption := bstSelectionInfo.Caption + AString;
  end
  else
    bstSelectionInfo.Caption := 'Cancel';
end;

procedure TRibbonDemoMainForm.rgiUndoGroupItemClick(
  Sender: TdxRibbonGalleryItem; AItem: TdxRibbonGalleryGroupItem);
begin
  Undo(AItem.Index + 1);
end;

initialization
  LoadRichDll;

finalization
  if FRichEditLibrary <> 0 then
    FreeLibrary(FRichEditLibrary);

end.