cxfontnamecombobox.pas

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

  FFontStyle := Value;
  SetFontStyleButtonsState;
end;

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

procedure TFontPreviewPanel.SetShowButtons(Value: Boolean);
begin
  if FShowButtons <> Value then
  begin
    FShowButtons := Value;
    RealignButtons;
  end;
end;

procedure TFontPreviewPanel.SetLookAndFeel(Value: TcxLookAndFeel);
begin
  FLookAndFeel.Assign(Value);
  RealignButtons;
end;

{ TcxMRUFontNameItem }

procedure TcxMRUFontNameItem.Assign(Source: TPersistent);
begin
  if Source is TcxMRUFontNameItem then
  begin
    FontName := TcxMRUFontNameItem(Source).FontName;
    Tag := TcxMRUFontNameItem(Source).Tag;
  end
  else
    inherited Assign(Source);
end;

function TcxMRUFontNameItem.IsTagStored: Boolean;
begin
  Result := FTag <> 0;
end;

procedure TcxMRUFontNameItem.SetFontName(const Value: TFontName);
begin
  if FFontName <> Value then
  begin
    FFontName := Value;
    Changed(True);
  end;
end;

{ TcxMRUFontNameItems }

constructor TcxMRUFontNameItems.Create(AOwner: TPersistent; ItemClass: TCollectionItemClass);
begin
  inherited Create(AOwner, ItemClass);
end;

destructor TcxMRUFontNameItems.Destroy;
begin
  inherited Destroy;
end;

function TcxMRUFontNameItems.GetItems(Index: Integer): TcxMRUFontNameItem;
begin
  Result := TcxMRUFontNameItem(inherited Items[Index]);
end;

procedure TcxMRUFontNameItems.SetItems(Index: Integer; const Value: TcxMRUFontNameItem);
begin
  inherited Items[Index] := Value;
end;

procedure TcxMRUFontNameItems.Update(Item: TCollectionItem);
begin
  TcxCustomFontNameComboBoxProperties(Owner).Changed;
end;

{$IFNDEF DELPHI6}
function TcxMRUFontNameItems.Owner: TPersistent;
begin
  Result := GetOwner;
end;
{$ENDIF}

function TcxMRUFontNameItems.Add: TcxMRUFontNameItem;
begin
  Result := TcxMRUFontNameItem(inherited Add);
end;

function TcxMRUFontNameItems.Insert(Index: Integer): TcxMRUFontNameItem;
begin
  Result := TcxMRUFontNameItem(inherited Insert(Index));
end;

procedure TcxMRUFontNameItems.Move(CurIndex, NewIndex: Integer);
var
  FNewFontNameItem, FOldFontNameItem: TcxMRUFontNameItem;
begin
  if CurIndex = NewIndex then Exit;
  FOldFontNameItem := Items[CurIndex];
  FNewFontNameItem := Insert(NewIndex);
  FNewFontNameItem.Assign(FOldFontNameItem);
  FOldFontNameItem.Free;
end;

function TcxMRUFontNameItems.AddMRUFontName(const AFontName: TFontName): TcxMRUFontNameItem;
begin
  Result := nil;
  if (AFontName = '') or (FindFontName(AFontName) <> nil) then Exit;
  Result := Add;
  Result.FontName := AFontName;
end;

function TcxMRUFontNameItems.InsertMRUFontName(Index: Integer;const AFontName: TFontName): TcxMRUFontNameItem;
begin
  Result := nil;
  if (AFontName = '') or (FindFontName(AFontName) <> nil) then Exit;
  Result := Insert(Index);
  Result.FontName := AFontName;
end;

function TcxMRUFontNameItems.FindFontName(const AFontName: TFontName): TcxMRUFontNameItem;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Count - 1 do
  begin
    if Items[I].FontName = AFontName then
    begin
      Result := Items[I];
      Break;
    end;
  end;
end;

{ TcxCustomFontNameComboBoxViewInfo }
procedure TcxCustomFontNameComboBoxViewInfo.Paint(ACanvas: TcxCanvas);
var
  ACurrentBitmap: TBitmap;
begin
  inherited Paint(ACanvas);
  if (FCurrentIndex <> -1) and (ftiShowInCombo in ShowFontTypeIcon) then
  begin
    if IsTrueTypeFont then
      ACurrentBitmap := FTrueTypeFontBitmap
    else
      ACurrentBitmap := FNonTrueTypeFontBitmap;
    if ACurrentBitmap <> nil then
      DrawGlyph(ACanvas, ImageRect.Left, ImageRect.Top,
        ACurrentBitmap, Enabled);
  end;
end;

procedure TcxCustomFontNameComboBoxViewInfo.Offset(DX, DY: Integer);
begin
  inherited;
  OffsetRect(ImageRect, DX, DY);
end;

{ TcxCustomFontNameComboBoxViewData }

procedure TcxCustomFontNameComboBoxViewData.Calculate(ACanvas: TcxCanvas;
  const ABounds: TRect; const P: TPoint; Button: TcxMouseButton;
  Shift: TShiftState; AViewInfo: TcxCustomEditViewInfo; AIsMouseEvent: Boolean);

  function GetIconOffset(AClientRect: TRect): TPoint;
  begin
    Result.Y := (RectHeight(AClientRect) - FTrueTypeFontBitmap.Height) div 2;
    if IsInplace then
      Result.X := IconBorderWidth - cxInplaceEditOffset
    else
      Result.X := IconBorderWidth;
  end;

  procedure CalculateImageRect(AViewInfo: TcxCustomFontNameComboBoxViewInfo);
  begin
    AViewInfo.ImageRect := AViewInfo.ClientRect;
    if FTrueTypeFontBitmap = nil then
      Exit;
    AViewInfo.ImageRect.Right :=
      AViewInfo.ImageRect.Left + FTrueTypeFontBitmap.Width;
    AViewInfo.ImageRect.Bottom :=
      AViewInfo.ImageRect.Top + FTrueTypeFontBitmap.Height;
    cxOffsetRect(AViewInfo.ImageRect,
      GetIconOffset(AViewInfo.ClientRect));
  end;

var
  AEditViewInfo: TcxCustomFontNameComboBoxViewInfo;
begin
  if IsRectEmpty(ABounds) then
  begin
    inherited;
    Exit;
  end;
  inherited Calculate(ACanvas, ABounds, P, Button, Shift, AViewInfo, AIsMouseEvent);
  if (ABounds.Right = MaxInt) or (ABounds.Bottom = MaxInt) then Exit;

  AEditViewInfo := TcxCustomFontNameComboBoxViewInfo(AViewInfo);
  AEditViewInfo.ShowFontTypeIcon := Properties.ShowFontTypeIcon;

  if (ftiShowInCombo in AEditViewInfo.ShowFontTypeIcon) then
  begin
    CalculateImageRect(AEditViewInfo);
    AEditViewInfo.TextRect.Left := AEditViewInfo.ImageRect.Right +
      IconBorderWidth + IconTextOffset;
  end;

  if not IsInplace then
    AEditViewInfo.DrawSelectionBar := False;
end;

procedure TcxCustomFontNameComboBoxViewData.DisplayValueToDrawValue(
  const ADisplayValue: TcxEditValue; AViewInfo: TcxCustomEditViewInfo);
var
  AViewInfoAccess: TcxCustomFontNameComboBoxViewInfo;
begin
  AViewInfoAccess := TcxCustomFontNameComboBoxViewInfo(AViewInfo);
  Properties.GetFontNameComboBoxDisplayValue(ADisplayValue,
    AViewInfoAccess.FCurrentIndex, AViewInfoAccess.Text);
  if PreviewMode then
    AViewInfoAccess.Text := '';
  if AViewInfoAccess.FCurrentIndex <> -1 then
    AViewInfoAccess.IsTrueTypeFont :=
      (cxftTTF in Properties.ItemTypes[AViewInfoAccess.FCurrentIndex]);
end;

procedure TcxCustomFontNameComboBoxViewData.EditValueToDrawValue(ACanvas: TcxCanvas;
  const AEditValue: TcxEditValue; AViewInfo: TcxCustomEditViewInfo);
begin
  PrepareSelection(AViewInfo);
  DisplayValueToDrawValue(AEditValue, AViewInfo);
  DoOnGetDisplayText(string(TcxCustomTextEditViewInfo(AViewInfo).Text));
end;

function TcxCustomFontNameComboBoxViewData.GetEditContentSize(ACanvas: TcxCanvas;
  const AEditValue: TcxEditValue;
  const AEditSizeProperties: TcxEditSizeProperties): TSize;
var
  FItemIndex: Integer;
begin
  Result := inherited GetEditContentSize(ACanvas, AEditValue, AEditSizeProperties);
  FItemIndex := Properties.FindItemByValue(AEditValue);
  if (FItemIndex >= 0) and (ftiShowInCombo in Properties.ShowFontTypeIcon) then
    Result.cx := Result.cx + FTrueTypeFontBitmap.Width + 4;
end;

function TcxCustomFontNameComboBoxViewData.IsComboBoxStyle: Boolean;
begin
  Result := True;
end;

function TcxCustomFontNameComboBoxViewData.GetProperties: TcxCustomFontNameComboBoxProperties;
begin
  Result := TcxCustomFontNameComboBoxProperties(FProperties);
end;

{ TcxFontNameComboBoxListBox }

function TcxFontNameComboBoxListBox.GetItemHeight(AIndex: Integer = -1): Integer;
begin
  with Edit.ActiveProperties do
  begin
    if ItemHeight > 0 then
      Result := ItemHeight
    else
    begin
      Result := inherited GetItemHeight;
      if UseOwnFont then
        Inc(Result, 4)
      else
        if Result <= FTrueTypeFontBitmap.Height then
          Result := FTrueTypeFontBitmap.Height + 4;
    end;
    if (AIndex >= 0) and Edit.IsOnMeasureItemEventAssigned then
      Edit.DoOnMeasureItem(AIndex, Canvas, Result);
    if AIndex = (FMRUFontNames.Count - 1) then
      Inc(Result, MRUDelimiterWidth);
  end;
end;

function TcxFontNameComboBoxListBox.GetItemWidth(AIndex: Integer): Integer;
var
  AFontName, ACanvasFontName: string;
  ACanvasFontCharSet: TFontCharSet;
begin
  if Edit.ActiveProperties.UseOwnFont then
  begin
    Canvas.Font.Assign(Font);
    ACanvasFontName := Canvas.Font.Name;
    ACanvasFontCharSet := Canvas.Font.Charset;
    try
      Result := 0;
      AFontName := GetItem(AIndex);
      if IsSymbolFontType(AIndex) then
      begin
        Canvas.Font.Name := 'Arial';
        Result := Canvas.TextWidth(AFontName);
        Inc(Result, ItemSymbolFontExampleOffset);
        Canvas.Font.Charset := SYMBOL_CHARSET;
      end;
      Canvas.Font.Name := AFontName;
      Inc(Result, Canvas.TextWidth(AFontName));
    finally
      Canvas.Font.Name := ACanvasFontName;
      Canvas.Font.Charset := ACanvasFontCharSet;
    end;
  end
  else
    Result := inherited GetItemWidth(AIndex);
end;

function TcxFontNameComboBoxListBox.GetItem(Index: Integer): string;
begin
  Result := Edit.ActiveProperties.LookupItems[Index];
end;

procedure TcxFontNameComboBoxListBox.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  AItemIndex: Integer;
begin
  inherited MouseUp(Button, Shift, X, Y);
  if Button <> mbLeft then
    Exit;
  AItemIndex := ItemAtPos(Point(X, Y), True);
  if AItemIndex <> -1 then
  begin
    SetCaptureControl(nil);
    ItemIndex := AItemIndex;
    Edit.CloseUp(crEnter);
  end;
end;

procedure TcxFontNameComboBoxListBox.DrawItem(Index: Integer; Rect: TRect;
  State: TOwnerDrawState);

  procedure DrawItemText;
  var
    AFlags: Longint;
    AFontBitmap: TBitmap;
    AText: string;
    ATextRect: TRect;
  begin
    ATextRect := Rect;
    if Index = Edit.ActiveProperties.FMRUFontNames.Count - 1 then
      Dec(ATextRect.Bottom, MRUDelimiterWidth);

    if cxftTTF in Edit.ActiveProperties.ItemTypes[Index] then
      AFontBitmap := FTrueTypeFontBitmap
    else
      AFontBitmap := FNonTrueTypeFontBitmap;
    if (ftiShowInList in Edit.ActiveProperties.ShowFontTypeIcon) and (AFontBitmap <> nil) then
    begin
      Canvas.Draw(ATextRect.Left + IconBorderWidth, ATextRect.Top +
        (ATextRect.Bottom - ATextRect.Top - AFontBitmap.Height) div 2, AFontBitmap);
      Inc(ATextRect.Left, AFontBitmap.Width + IconBorderWidth * 2 + IconTextOffset);
    end
    else
      Inc(ATextRect.Left, DropDownListTextOffset);

    AText := GetItem(Index);
    if Edit.ActiveProperties.UseOwnFont then
      Canvas.Font.Name := AText;
    AFlags := DrawTextBiDiModeFlags(DT_SINGLELINE or DT_LEFT or DT_NOPREFIX or DT_VCENTER);
    Canvas.Brush.Style := bsClear;
    if Edit.ActiveProperties.UseOwnFont and IsSymbolFontType(Index) then
    begin
      Canvas.Font.Name := 'Arial';
      DrawText(Canvas.Handle, PChar(AText), Length(AText),
        ATextRect, AFlags);
      Inc(ATextRect.Left, Canvas.TextWidth(AText) + ItemSymbolFontExampleOffset);
      Canvas.Font.Name := AText;
      Canvas.Font.Charset := SYMBOL_CHARSET;
      AFlags := AFlags and not DT_END_ELLIPSIS;
    end;
    DrawText(Canvas.Handle, PChar(AText), Length(AText),
      ATextRect, AFlags);
    Canvas.Brush.Style := bsSolid;
  end;

begin
  SaveCanvasParametersForFocusRect;
  try
    if DoDrawItem(Index, Rect, State) then
      Exit;
    Canvas.FillRect(Rect);
    DrawItemText;
    if Index = Edit.ActiveProperties.FMRUFontNames.Count - 1 then
      DrawMRUDelimiter(Canvas.Canvas, Rect, odSelected in State);
  finally
    RestoreCanvasParametersForFocusRect;
  end;
end;

function TcxFontNameComboBoxListBox.GetEdit: TcxCustomFontNameComboBox;
begin
  Result := TcxCustomFontNameComboBox(inherited Edit);
end;

function TcxFontNameComboBoxListBox.IsSymbolFontType(AItemIndex: Integer): Boolean;
begin
  Result := Integer(Edit.ActiveProperties.Items.Objects[AItemIndex]) and SYMBOL_FONTTYPE <> 0;
end;

{ TcxFontNameComboBoxLookupData }

destructor TcxFontNameComboBoxLookupData.Destroy;
begin
  FPanel := nil;