cxfontnamecombobox.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 2,058 行 · 第 1/5 页

        Self.PreviewText := PreviewText;
        Self.Alignment := Alignment;
        Self.ShowEndEllipsis := ShowEndEllipsis;
        Self.Color := Color;
        Self.WordWrap := WordWrap;
        Self.ShowButtons := ShowButtons;
        Self.OnButtonClick := OnButtonClick;
      end;
    finally
      EndUpdate;
    end
  end
  else
    inherited Assign(Source);
end;

function TcxFontPreview.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

procedure TcxFontPreview.Changed;
begin
  if FUpdateCount = 0 then
  begin
    if Assigned(FOnChanged) and not IsDestroying then
      FOnChanged(Self);
    FModified := False;
  end
  else
    FModified := True;
end;

procedure TcxFontPreview.BeginUpdate;
begin
  Inc(FUpdateCount);
end;

procedure TcxFontPreview.EndUpdate;
begin
  if FUpdateCount <> 0 then
  begin
    Dec(FUpdateCount);
    if FModified then Changed;
  end;
end;

function TcxFontPreview.IsDestroying: Boolean;
begin
  Result := FIsDestroying;
end;

procedure TcxFontPreview.SetFontStyle(Value: TFontStyles);
begin
  if FFontStyle <> Value then
  begin
    FFontStyle := Value;
    Changed;
  end;
end;

procedure TcxFontPreview.SetVisible(Value: Boolean);
begin
  if FVisible <> Value then
  begin
    FVisible := Value;
    Changed;
  end;
end;

procedure TcxFontPreview.SetPreviewType(Value: TcxFontPreviewType);
begin
  if FPreviewType <> Value then
  begin
    FPreviewType := Value;
    Changed;
  end;
end;

procedure TcxFontPreview.SetPreviewText(Value: TCaption);
begin
  if FPreviewText <> Value then
  begin
    FPreviewText := Value;
    Changed;
  end;
end;

procedure TcxFontPreview.SetAlignment(Value: TAlignment);
begin
  if FAlignment <> Value then
  begin
    FAlignment := Value;
    Changed;
  end;
end;

procedure TcxFontPreview.SetShowEndEllipsis(Value: Boolean);
begin
  if FShowEndEllipsis <> Value then
  begin
    FShowEndEllipsis := Value;
    Changed;
  end;
end;

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

procedure TcxFontPreview.SetWordWrap(Value: Boolean);
begin
  if FWordWrap <> Value then
  begin
    FWordWrap := Value;
    Changed;
  end;
end;

procedure TcxFontPreview.SetShowButtons(Value: Boolean);
begin
  if FShowButtons <> Value then
  begin
    FShowButtons := Value;
    Changed;
  end;
end;
{ TcxFontPreview }

{ TcxFontPanelButton }
procedure TcxFontPanelButton.WndProc(var Message: TMessage);
begin
  inherited;
  case Message.Msg of
    WM_LBUTTONDOWN, WM_LBUTTONUP: Dispatch(Message);
  end;
end;

{ TFontPreviewPanel }

constructor TFontPreviewPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
    csSetCaption, csOpaque, csDoubleClicks, csReplicatable];
  Width := 100;
  Height := 40;
  FAlignment := taCenter;
  FShowEndEllipsis := True;
  FShowButtons := True;
  FEdges := [bLeft, bTop, bRight, bBottom];
  FBorderColor := clWindowFrame;
  FWordWrap := False;
  FFontStyle := [];
  Color := clWindow;
  UseDockManager := True;
  FcxCanvas := TcxCanvas.Create(Canvas);
  FLookAndFeel := TcxLookAndFeel.Create(Self);
  CreateButtons;
end;

destructor TFontPreviewPanel.Destroy;
begin
  FreeAndNil(FStrikeOutButton);
  FreeAndNil(FUnderLineButton);
  FreeAndNil(FItalicButton);
  FreeAndNil(FBoldButton);
  FreeAndNil(FLookAndFeel);
  FreeAndNil(FcxCanvas);
  inherited;
end;

procedure TFontPreviewPanel.CreateButtons;

  procedure InitButton(AButton: TcxFontPanelButton; const AButtonSize: TSize);
  begin
    AButton.Font.Name := 'Arial';
    AButton.Font.Size := 8;
    AButton.Height := AButtonSize.cx;
    AButton.LookAndFeel.MasterLookAndFeel := LookAndFeel;
    AButton.UseSystemPaint := True;
    AButton.Width := AButtonSize.cy;
    AButton.Parent := Self;
    AButton.OnClick := FontButtonsClickHandler;
  end;

var
  AButtonSize: TSize;
begin
  FBoldButton := TcxFontPanelButton.Create(Self);

  FBoldButton.Font.Name := 'Arial';
  FBoldButton.Font.Size := 8;
  AButtonSize.cx := NonCanvasTextWidth(FBoldButton.Font, 'B') + 8;
  AButtonSize.cy := NonCanvasTextHeight(FBoldButton.Font) + 2;

  FBoldButton.Caption := 'B';
  FBoldButton.Tag := 0;
  InitButton(FBoldButton, AButtonSize);

  FItalicButton := TcxFontPanelButton.Create(Self);
  FItalicButton.Caption := 'I';
  FItalicButton.Tag := 1;
  InitButton(FItalicButton, AButtonSize);

  FUnderLineButton := TcxFontPanelButton.Create(Self);
  FUnderLineButton.Caption := 'U';
  FUnderLineButton.Tag := 2;
  InitButton(FUnderLineButton, AButtonSize);

  FStrikeOutButton := TcxFontPanelButton.Create(Self);
  FStrikeOutButton.Caption := 'S';
  FStrikeOutButton.Tag := 3;
  InitButton(FStrikeOutButton, AButtonSize);
end;

procedure TFontPreviewPanel.RealignButtons;
begin
  FBoldButton.Visible := ShowButtons;
  FItalicButton.Visible := ShowButtons;
  FUnderLineButton.Visible := ShowButtons;
  FStrikeOutButton.Visible := ShowButtons;
  if ShowButtons = True then
  begin
    FBoldButton.Top := Height - FBoldButton.Height - 2;
    FItalicButton.Top := FBoldButton.Top;
    FUnderLineButton.Top := FBoldButton.Top;
    FStrikeOutButton.Top := FBoldButton.Top;

    FStrikeOutButton.Left := Width - FStrikeOutButton.Width - 1;
    FUnderLineButton.Left := FStrikeOutButton.Left - FUnderLineButton.Width - 1;
    FItalicButton.Left := FUnderLineButton.Left - FItalicButton.Width - 1;
    FBoldButton.Left := FItalicButton.Left - FBoldButton.Width - 1;
  end;
end;

procedure TFontPreviewPanel.SetFontStyleButtonsState;
begin
  if (fsBold in FFontStyle) then
  begin
    FBoldButton.Colors.Normal := GetLightSelColor;
    FBoldButton.Font.Style := [fsBold];
  end
  else
  begin
    FBoldButton.Colors.Normal := clDefault;
    FBoldButton.Font.Style := [];
  end;
  if (fsItalic in FFontStyle) then
  begin
    FItalicButton.Colors.Normal := GetLightSelColor;
    FItalicButton.Font.Style := [fsBold];
  end
  else
  begin
    FItalicButton.Colors.Normal := clDefault;
    FItalicButton.Font.Style := [];
  end;
  if (fsUnderLine in FFontStyle) then
  begin
    FUnderLineButton.Colors.Normal := GetLightSelColor;
    FUnderLineButton.Font.Style := [fsBold];
  end
  else
  begin
    FUnderLineButton.Colors.Normal := clDefault;
    FUnderLineButton.Font.Style := [];
  end;
  if (fsStrikeOut in FFontStyle) then
  begin
    FStrikeOutButton.Colors.Normal := GetLightSelColor;
    FStrikeOutButton.Font.Style := [fsBold];
  end
  else
  begin
    FStrikeOutButton.Colors.Normal := clDefault;
    FStrikeOutButton.Font.Style := [];
  end;
end;

procedure TFontPreviewPanel.Paint;
var
  FRect: TRect;
begin
  FRect := GetClientRect;
  with cxCanvas do
  begin
    Brush.Color := Color;
    FillRect(FRect);
    DrawComplexFrame(FRect, FBorderColor, FBorderColor, FEdges);
    InflateRect(FRect, -2, -2);
    Brush.Style := bsClear;
    CalculateFont(FRect);
    cxDrawText(Canvas.Handle, Caption, FRect, GetTextFlag(DT_NOPREFIX));
  end;
end;

procedure TFontPreviewPanel.CalculateFont(const ARect: TRect);
var
  FTextRect: TRect;
begin
  if FontName = '' then
    Canvas.Font.Name := 'Arial'
  else
    Canvas.Font.Name := FontName;
  Canvas.Font.Size := 8;
  Canvas.Font.Style := CalculateFontStyle;
  if Trim(Caption) = '' then Exit;
  FTextRect := Rect(ARect.Left, ARect.Top, ARect.Right - 1, ARect.Top + 1);
  while (RectHeight(FTextRect) <= RectHeight(ARect)) and
        (RectWidth(FTextRect) <= RectWidth(ARect)) do
  begin
    DrawText(Canvas.Handle, PChar(Caption),
      Length(Caption), FTextRect, GetTextFlag(DT_CALCRECT or DT_NOPREFIX));
    if (RectHeight(FTextRect) <= RectHeight(ARect)) and
      (RectWidth(FTextRect) <= RectWidth(ARect)) then
        Canvas.Font.Size := Canvas.Font.Size + 1
    else
      if Canvas.Font.Size > 8 then
        Canvas.Font.Size := Canvas.Font.Size - 1;
  end;
end;

function TFontPreviewPanel.GetTextFlag(const AStartFlag: Longint): Longint;
const
  ShowEndEllipsisArray: array[Boolean] of Integer = (0, DT_END_ELLIPSIS);
  WordWrapArray: array[Boolean] of Integer = (0, DT_WORDBREAK);
begin
  Result := AStartFlag or SystemAlignmentsHorz[Alignment] or DT_VCENTER or
    ShowEndEllipsisArray[ShowEndEllipsis] or WordWrapArray[WordWrap];
end;

function TFontPreviewPanel.CalculateFontStyle: TFontStyles;
begin
  Result := FFontStyle;
end;

procedure TFontPreviewPanel.FontButtonsClickHandler(Sender: TObject);
begin
  case (TComponent(Sender).Tag) of
    0: if (fsBold in FFontStyle) then
         FFontStyle := FFontStyle - [fsBold]
       else
         FFontStyle := FFontStyle + [fsBold];
    1: if (fsItalic in FFontStyle) then
         FFontStyle := FFontStyle - [fsItalic]
       else
         FFontStyle := FFontStyle + [fsItalic];
    2: if (fsUnderLine in FFontStyle) then
         FFontStyle := FFontStyle - [fsUnderLine]
       else
         FFontStyle := FFontStyle + [fsUnderLine];
    3: if (fsStrikeOut in FFontStyle) then
         FFontStyle := FFontStyle - [fsStrikeOut]
       else
         FFontStyle := FFontStyle + [fsStrikeOut];
  end;

  FontPreview.FontStyle := FFontStyle;
  if Assigned(FontPreview.OnButtonClick) then
    FontPreview.OnButtonClick(Self, TcxFontButtonType((Sender as TComponent).Tag));

  if TcxFontPanelButton(Sender).Colors.Normal <> clDefault then
  begin
    TcxFontPanelButton(Sender).Colors.Normal := clDefault;
    TcxFontPanelButton(Sender).Font.Style := [];
  end else
  begin
    TcxFontPanelButton(Sender).Colors.Normal := GetLightSelColor;
    TcxFontPanelButton(Sender).Font.Style := [fsBold];
  end;

  Invalidate;
end;

procedure TFontPreviewPanel.SetLocked(Value: Boolean);
begin
  FLocked := Value;
  if FLocked = False then Invalidate;
end;

procedure TFontPreviewPanel.SetAlignment(Value: TAlignment);
begin
  FAlignment := Value;
  if FLocked = False then Invalidate;
end;

procedure TFontPreviewPanel.SetShowEndEllipsis(Value: Boolean);
begin
  FShowEndEllipsis := Value;
  if FLocked = False then Invalidate;
end;

procedure TFontPreviewPanel.SetEdges(Value: TcxBorders);
begin
  FEdges := Value;
  if FLocked = False then Invalidate;
end;

procedure TFontPreviewPanel.SetFontName(Value: string);
begin
  FFontName := Value;
  if FLocked = False then Invalidate;
end;

procedure TFontPreviewPanel.SetFontStyle(Value: TFontStyles);
begin