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

📄 jvofficecolorpanel.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 3 页
字号:

      Self.FAutoCaption := AutoCaption;
      Self.FOtherCaption := OtherCaption;
      Self.FAutoHint := AutoHint;
      Self.FOtherHint := OtherHint;
      Self.FAutoColor := AutoColor;

      Self.FRightClickSelect :=  RightClickSelect;
      Self.FSelectIfPopup := SelectIfPopup;
    end
  else
    inherited Assign(Source);
end;

procedure TJvOfficeColorPanelProperties.Changed(PropName: string);
begin
  if Assigned(FOnPropertiesChanged) then
    FOnPropertiesChanged(Self, PropName);
end;

procedure TJvOfficeColorPanelProperties.CreateDefaultText;
begin
  FAutoCaption := RsAutoCaption;
  FOtherCaption := RsOtherColorCaption;
end;

function TJvOfficeColorPanelProperties.GetStringValue(const Index: Integer): string;
begin
  case Index of
    Tag_AutoCaption:
      Result := FAutoCaption;
    Tag_OtherCaption:
      Result := FOtherCaption;
    Tag_AutoHint:
      Result := FAutoHint;
    Tag_OtherHint:
      Result := FOtherHint;
  end;
end;

procedure TJvOfficeColorPanelProperties.SetAutoColor(const Value: TColor);
begin
  if FAutoColor<>Value then
  begin
    FAutoColor := Value;
    Changed(cAutoColor);
  end;
end;

procedure TJvOfficeColorPanelProperties.SetMeasure(const Index, Value: Integer);
var
  MeasureItem: PInteger;
  MeasureConst: Integer;
  LName: string;
begin
  case Index of
    Tag_TopMargin:
      begin
        MeasureItem := @FTopMargin;
        MeasureConst := MinTopMargin;
        LName := 'TopMargin';
      end;
    Tag_BottomMargin:
      begin
        MeasureItem := @FBottomMargin;
        MeasureConst := MinBottomMargin;
        LName := 'BottomMargin';
      end;
    Tag_HorizontalMargin:
      begin
        MeasureItem := @FHorizontalMargin;
        MeasureConst := MinHorizontalMargin;
        LName := 'HorizontalMargin';
      end;
    Tag_ColorSpace:
      begin
        MeasureItem := @FColorSpace;
        MeasureConst := MinColorSpace;
        LName := 'ColorSpace';
      end;
    Tag_ColorSpaceTop:
      begin
        MeasureItem := @FColorSpaceTop;
        MeasureConst := MinColorSpaceTop;
        LName := 'ColorSpaceTop';
      end;
    Tag_ColorSpaceBottom:
      begin
        MeasureItem := @FColorSpaceBottom;
        MeasureConst := MinColorSpaceBottom;
        LName := 'ColorSpaceBottom';
      end;
    Tag_ColorSize:
      begin
        MeasureItem := @FColorSize;
        MeasureConst := MinColorSize;
        LName := 'ColorSize';
      end;
    Tag_ButtonHeight:
      begin
        MeasureItem := @FButtonHeight;
        MeasureConst := MinButtonHeight;
        LName := 'ButtonHeight';
      end;
  else
    Exit;
  end;
  if MeasureItem^ = Value then
    Exit;

  MeasureItem^ := Value;
  if MeasureItem^ < MeasureConst then
    MeasureItem^ := MeasureConst;
  Changed(LName);
end;

procedure TJvOfficeColorPanelProperties.SetShowAutoButton(const Value: Boolean);
begin
  if FShowAutoButton <> Value then
  begin
    FShowAutoButton := Value;
    Changed(cShowAutoButton);
  end;
end;

procedure TJvOfficeColorPanelProperties.SetShowColorHint(const Value: Boolean);
begin
  if FShowColorHint <> Value then
  begin
    FShowColorHint := Value;
    Changed(cShowColorHint);
  end;
end;

procedure TJvOfficeColorPanelProperties.SetShowOtherButton(const Value: Boolean);
begin
  if FShowOtherButton <> Value then
  begin
    FShowOtherButton := Value;
    Changed(cShowOtherButton);
  end;
end;

procedure TJvOfficeColorPanelProperties.SetStringValue(const Index: Integer;
  const Value: string);
begin
  case Index of
    Tag_AutoCaption:
      if FAutoCaption <> Value then
      begin
        FAutoCaption := Value;
        Changed(cAutoCaption);
      end;
    Tag_OtherCaption:
      if FOtherCaption <> Value then
      begin
        FOtherCaption := Value;
        Changed(cOtherCaption);
      end;
    Tag_AutoHint:
      if FAutoHint <> Value then
      begin
        FAutoHint := Value;
        Changed(cAutoHint);
      end;
    Tag_OtherHint:
      if FAutoHint <> Value then
      begin
        FOtherHint := Value;
        Changed(cOtherHint);
      end;
  end;
end;

procedure TJvOfficeColorPanelProperties.SetRightClickSelect(
  const Value: Boolean);
begin
  FRightClickSelect := Value;
  Changed('RightClickSelect');
end;

procedure TJvOfficeColorPanelProperties.SetSelectIfPopup(
  const Value: Boolean);
begin
  FSelectIfPopup := Value;
  Changed('SelectIfPopup');
end;

//=== { TJvSubColorButton } ==================================================

constructor TJvSubColorButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FEdgeWidth := 4;
end;

function TJvSubColorButton.GetEdgeWidth: Integer;
begin
  Result := Height div 5;
end;

procedure TJvSubColorButton.Paint;
var
  B, X, Y: Integer;
  FColor: TColor;
begin
  if not Visible then
    Exit;
  inherited Paint;

  if Enabled then
    FColor := ButtonColor
  else
    FColor := clGray;
  if EdgeWidth >= 0 then
    B := EdgeWidth
  else
    B := Height div 5;
  with Canvas do
  begin
    if not Glyph.Empty then
    begin
      Glyph.Transparent := True;
      X := (Width div 2) - 9 + Integer(FState in [TJvButtonState(bsDown)]);
      Y := (Height div 2) + 4 + Integer(FState in [TJvButtonState(bsDown)]);
      Pen.Color := FColor;
      Brush.Color := FColor;
      Brush.Style := bsSolid;
      Rectangle(X, Y, X + 17, Y + 4);
    end
    else
    begin
      if Caption = '' then
      begin
        Pen.Color := clGray;
        Brush.Color := FColor;
        Brush.Style := bsSolid;
        Rectangle(B, B, Width - B, Height - B);
      end
      else
      begin
        Pen.Color := clGray;
        Brush.Style := bsClear;
        Polygon([Point(B - 1, B - 1), Point(Width - (B - 1), B - 1),
          Point(Width - (B - 1), Height - (B - 1)), Point(B - 1, Height - (B - 1))]);
        Pen.Color := clGray;
        Brush.Color := FColor;
        Brush.Style := bsSolid;
        Rectangle(B + 1, B + 1, Height, Height - B);
      end;
    end;
  end;
end;

procedure TJvSubColorButton.SetEdgeWidth(const Value: Integer);
begin
  if FEdgeWidth <> Value then
  begin
    FEdgeWidth := Value;
    Repaint;
  end;
end;

//=== { TJvCustomOfficeColorPanel } ==========================================

constructor TJvCustomOfficeColorPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csAcceptsControls];
  FInited := False;
  FSelectedColor := clBlack;
  {$IFDEF VCL}
  FColorDialogOptions := [];
  {$ENDIF VCL}
  FClickColorButton := cbctNone;

  FProperties := TJvOfficeColorPanelProperties.Create;
  FProperties.OnPropertiesChanged := PropertiesChanged;

  FAutoButton := TJvSubColorButton.Create(Self);

  with FAutoButton do
  begin
    Parent := Self;
    GroupIndex := 1;
    Tag := MaxColorButtonNumber + 1;
    Down := True;
    AllowAllUp := True;
    ButtonColor := FProperties.AutoColor;
    Hint := ColorToString(ButtonColor);
    Visible := False;
    OnClick := ColorButtonClick;
    OnMouseUp := RedirectToColorButtonClick;
  end;

  FOtherButton := TJvSubColorButton.Create(Self);
  with FOtherButton do
  begin
    Parent := Self;
    GroupIndex := 1;
    Tag := MaxColorButtonNumber + 2;
    ButtonColor := clDefault;
    Hint := ColorToString(ButtonColor);
    AllowAllUp := True;
    Visible := False;
    OnClick := ColorButtonClick;
    OnMouseUp := RedirectToColorButtonClick;
  end;

  FColorDialog := TJvOfficeColorDialog.Create(Self);
  {$IFDEF VCL}
  FColorDialog.Options := FColorDialogOptions;
  {$ENDIF VCL}

//  Font.Name := 'MS Shell Dlg 2';
  FAutoButton.Flat := True;
  FOtherButton.Flat := True;
  Flat := True;
  SetWordStyle(True);

  MakeColorButtons;

  FInited := True;
end;

destructor TJvCustomOfficeColorPanel.Destroy;
begin
  FProperties.Free;
  inherited Destroy;
end;

procedure TJvCustomOfficeColorPanel.SetButton(Button: TControl);
begin
  FOwner := Button;
end;

procedure TJvCustomOfficeColorPanel.MakeColorButtons;
var
  I: Integer;
begin
  for I := 0 to MaxColorButtonNumber - 1 do
  begin
    FColorButtons[I].Free;
    FColorButtons[I] := TJvSubColorButton.Create(Self);
    with FColorButtons[I] do
    begin
      Parent := Self;
      GroupIndex := 1;
      AllowAllUp := True;
      ButtonColor := SubColorButtonColors[I];
      Tag := I;
      Flat := True;
      Hint := ColorToString(ButtonColor);
      OnClick := ColorButtonClick;
      OnMouseUp := RedirectToColorButtonClick;
    end;
  end;
  Invalidate;
end;

procedure TJvCustomOfficeColorPanel.AdjustColorButtons;
var
  I: Integer;
  ButtonLine: Integer;

⌨️ 快捷键说明

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