cxfontnamecombobox.pas

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

  inherited Destroy;
end;

function TcxFontNameComboBoxLookupData.CanResizeVisualArea(var NewSize: TSize;
  AMaxHeight: Integer = 0; AMaxWidth: Integer = 0): Boolean;
var
  AFontPreviewPanelHeight: Integer;
begin
  if TcxCustomFontNameComboBoxProperties(ActiveProperties).FontPreview.Visible then
    AFontPreviewPanelHeight := cxFontPreviewPanelDefaultHeight
  else
    AFontPreviewPanelHeight := 0;
  Result := (AMaxHeight = 0) or (AMaxHeight > AFontPreviewPanelHeight);
  if Result then
  begin
    if AMaxHeight > 0 then
      Dec(AMaxHeight, AFontPreviewPanelHeight);
    NewSize.cy := NewSize.cy - AFontPreviewPanelHeight;
    Result := inherited CanResizeVisualArea(NewSize, AMaxHeight);
    NewSize.cy := NewSize.cy + AFontPreviewPanelHeight;
  end;
end;

function TcxFontNameComboBoxLookupData.GetVisualAreaPreferredSize(AMaxHeight: Integer; AWidth: Integer = 0): TSize;
var
  AScrollWidth, AWidthDelta: Integer;
begin
  Result := inherited GetVisualAreaPreferredSize(AMaxHeight, AWidth);
  if TcxCustomFontNameComboBoxProperties(ActiveProperties).FontPreview.Visible then
    Result.cy := Result.cy + cxFontPreviewPanelDefaultHeight;
  if (ftiShowInCombo in  TcxCustomFontNameComboBoxProperties(ActiveProperties).ShowFontTypeIcon) then
    AWidthDelta := FTrueTypeFontBitmap.Width + IconBorderWidth * 2 + IconTextOffset
  else
    AWidthDelta := DropDownListTextOffset;
  AScrollWidth := List.ScrollWidth;
  List.ScrollWidth := 0;
  List.ScrollWidth := AScrollWidth + AWidthDelta;
  Result.cx := Result.cx + AWidthDelta;
end;

procedure TcxFontNameComboBoxLookupData.Initialize(AVisualControlsParent: TWinControl);
begin
  inherited Initialize(AVisualControlsParent);
  if TcxCustomFontNameComboBoxProperties(ActiveProperties).FontPreview.Visible and
    Assigned(AVisualControlsParent) and AVisualControlsParent.HandleAllocated then
  begin
    if not Assigned(FPanel) then
    begin
      FPanel := TFontPreviewPanel.Create(AVisualControlsParent);
      FPanel.FontPreview := TcxCustomFontNameComboBoxProperties(ActiveProperties).FontPreview;
      FPanel.LookAndFeel.MasterLookAndFeel := TcxCustomFontNameComboBox(Edit).PopupControlsLookAndFeel;
    end;

    FPanel.Locked := True;
    try
      FPanel.Edges := [bBottom];
      FPanel.Caption := GetPreviewText;
      FPanel.FontName := GetFontName;
      FPanel.Height := cxFontPreviewPanelDefaultHeight;
      with TcxCustomFontNameComboBoxProperties(ActiveProperties) do
      begin
        FPanel.FontStyle := FontPreview.FontStyle;
        FPanel.Color := FontPreview.Color;
        FPanel.ShowEndEllipsis := FontPreview.ShowEndEllipsis and
          (FontPreview.PreviewType <> cxfpFontName);
        FPanel.Alignment := FontPreview.Alignment;
        FPanel.WordWrap := FontPreview.WordWrap and (FontPreview.PreviewType <> cxfpFontName);
        FPanel.ShowButtons := FontPreview.ShowButtons;
      end;
      FPanel.Parent := AVisualControlsParent;
      FPanel.Visible := True;
    finally
      FPanel.Locked := False;
    end;
  end
  else
    if Assigned(FPanel) then FPanel.Visible := False;
end;

procedure TcxFontNameComboBoxLookupData.PositionVisualArea(const AClientRect: TRect);
var
  R: TRect;
begin
  inherited PositionVisualArea(AClientRect);
  R := AClientRect;
  if TcxCustomFontNameComboBoxProperties(ActiveProperties).FontPreview.Visible and
    Assigned(FPanel) and FPanel.HandleAllocated then
  begin
    FPanel.SetBounds(R.Left, R.Top, R.Right - R.Left,
      cxFontPreviewPanelDefaultHeight);
    FPanel.RealignButtons;
    Inc(R.Top, FPanel.Height);
  end;
  List.SetBounds(R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top);
end;

function TcxFontNameComboBoxLookupData.GetListBoxClass: TcxCustomEditListBoxClass;
begin
  Result := TcxFontNameComboBoxListBox;
end;

procedure TcxFontNameComboBoxLookupData.HandleSelectItem(Sender: TObject);
begin
  inherited HandleSelectItem(Sender);
  if Assigned(FPanel) and FPanel.HandleAllocated then
  begin
    FPanel.Locked := True;
    try
      if ItemIndex >= 0 then
        FPanel.FontName := GetFontName;
      with TcxCustomFontNameComboBoxProperties(ActiveProperties) do
        if FontPreview.PreviewType <> cxfpFullAlphabet then
          FPanel.Caption := GetPreviewText;
    finally
      FPanel.Locked := False;
    end;
  end;
end;

procedure TcxFontNameComboBoxLookupData.InternalChangeCurrentMRUFontNamePosition;
var
  FIndex: Integer;
begin
  if ItemIndex > (TcxCustomFontNameComboBoxProperties(ActiveProperties).FMRUFontNames.Count - 1) then
  begin
    FIndex := Items.IndexOf(Items[ItemIndex]);
    if FIndex >= 0 then
      InternalSetCurrentKey(FIndex);
  end;
end;

function TcxFontNameComboBoxLookupData.GetPreviewText: string;
begin
  with TcxCustomFontNameComboBoxProperties(ActiveProperties) do
    case FontPreview.PreviewType of
      cxfpCustom: Result := TcxCustomFontNameComboBoxProperties(ActiveProperties).FontPreview.PreviewText;
      cxfpFullAlphabet: Result := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz 1234567890';
      else
        Result := GetFontName;
    end;
end;

function TcxFontNameComboBoxLookupData.GetFontName: string;
begin
  if ItemIndex = -1 then
    Result := ''
  else
    Result := Items[ItemIndex];
end;

{ TcxCustomFontNameComboBoxProperties }

constructor TcxCustomFontNameComboBoxProperties.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner);
  DropDownListStyle := lsFixedList;
  FMaxMRUFonts := 10;
  FFontTypes := [cxftTTF, cxftRaster, cxftDevice, cxftFixed, cxftSymbol];
  FUseOwnFont := False;
  FShowFontTypeIcon := [ftiShowInCombo, ftiShowInList];
  FMRUFontNames := TcxMRUFontNameItems.Create(Self, TcxMRUFontNameItem);
  FFontPreview := TcxFontPreview.Create(Self);
  FLoadFontComplete := True;
  LoadFontNames;
end;

destructor TcxCustomFontNameComboBoxProperties.Destroy;
begin
  FreeAndNil(FFontPreview);
  FreeAndNil(FMRUFontNames);
  ShutDownFontLoader;
  inherited;
end;

procedure TcxCustomFontNameComboBoxProperties.Assign(Source: TPersistent);
begin
  if Source is TcxCustomFontNameComboBoxProperties then
  begin
    BeginUpdate;
    try
      inherited Assign(Source);
      with Source as TcxCustomFontNameComboBoxProperties do
      begin
        Self.UseOwnFont := UseOwnFont;
        Self.FontTypes := FontTypes;
        Self.ShowFontTypeIcon := ShowFontTypeIcon;
        Self.FontPreview := FontPreview;
        Self.MaxMRUFonts := MaxMRUFonts;
        Self.OnAddedMRUFont := OnAddedMRUFont;
        Self.OnMovedMRUFont := OnMovedMRUFont;
        Self.OnDeletedMRUFont := OnDeletedMRUFont;
        Self.OnLoadFontComplete := OnLoadFontComplete;
        Self.MRUFontNames.Assign(MRUFontNames);
      end;
    finally
      EndUpdate;
    end
  end
  else
    inherited Assign(Source);
end;

function TcxCustomFontNameComboBoxProperties.CompareDisplayValues(
  const AEditValue1, AEditValue2: TcxEditValue): Boolean;
var
  AItemIndex1, AItemIndex2: Integer;
  AText1, AText2: string;
begin
  GetFontNameComboBoxDisplayValue(AEditValue1, AItemIndex1, AText1);
  GetFontNameComboBoxDisplayValue(AEditValue2, AItemIndex2, AText2);
  Result := AItemIndex1 = AItemIndex2;
end;

class function TcxCustomFontNameComboBoxProperties.GetContainerClass: TcxContainerClass;
begin
  Result := TcxFontNameComboBox;
end;

procedure TcxCustomFontNameComboBoxProperties.GetFontNameComboBoxDisplayValue(
  const AEditValue: TcxEditValue; out AItemIndex: Integer; out AText: string);
begin
  if not LoadFontComplete then
  begin
    AItemIndex := -1;
    AText := cxGetResourceString(@scxLoadingFonts);
  end
  else
  begin
    AItemIndex := FindItemByValue(AEditValue);
    if AItemIndex = -1 then
      AText := ''
    else
      AText := Items[AItemIndex];
  end;
  CheckCharsRegister(AText, CharCase);
end;

function TcxCustomFontNameComboBoxProperties.FindLookupText(
  const AText: string): Boolean;
begin
  Result := not LoadFontComplete or inherited FindLookupText(AText);
end;

class function TcxCustomFontNameComboBoxProperties.GetLookupDataClass: TcxInterfacedPersistentClass;
begin
  Result := TcxFontNameComboBoxLookupData;
end;

class function TcxCustomFontNameComboBoxProperties.GetViewDataClass: TcxCustomEditViewDataClass;
begin
  Result := TcxCustomFontNameComboBoxViewData;
end;

class function TcxCustomFontNameComboBoxProperties.GetViewInfoClass: TcxContainerViewInfoClass;
begin
  Result := TcxCustomFontNameComboBoxViewInfo;
end;

procedure TcxCustomFontNameComboBoxProperties.ShutDownFontLoader;
begin
  if Assigned(FFontLoader) then
  begin
    FFontLoader.OnCompleteThread := nil;
    FFontLoader.OnDestroyThread := nil;
    FFontLoader.Terminate;
    FFontLoader := nil;
  end;
end;

function TcxCustomFontNameComboBoxProperties.GetFontItems: TStrings;
begin
  Result := Items;
end;

function TcxCustomFontNameComboBoxProperties.GetFontTypes: TcxFontTypes;
begin
  Result := FFontTypes;
end;

procedure TcxCustomFontNameComboBoxProperties.SetFontTypes(Value: TcxFontTypes);
begin
  if FFontTypes <> Value then begin
    FFontTypes := Value;
    FMRUFontNames.Clear;
    LoadFontNames;
    Changed;
  end;
end;

procedure TcxCustomFontNameComboBoxProperties.SetMaxMRUFonts(Value: Byte);
var
  FOldMaxMRUFonts: Byte;
begin
  if FMaxMRUFonts <> Value then
  begin
    FOldMaxMRUFonts := FMaxMRUFonts;
    FMaxMRUFonts := Value;
    if FOldMaxMRUFonts > Value then
    begin
      DeleteOverMRUFonts;
      Changed;
    end;
  end;
end;

function TcxCustomFontNameComboBoxProperties.GetUseOwnFont: Boolean;
begin
  Result := FUseOwnFont;
end;

procedure TcxCustomFontNameComboBoxProperties.SetUseOwnFont(Value: Boolean);
begin
  if FUseOwnFont <> Value
  then begin
    FUseOwnFont := Value;
    Changed;
  end;
end;

procedure TcxCustomFontNameComboBoxProperties.SetShowFontTypeIcon(Value: TcxShowFontIconTypes);
begin
  if FShowFontTypeIcon <> Value then
  begin
    FShowFontTypeIcon := Value;
    Changed;
  end;
end;

function TcxCustomFontNameComboBoxProperties.FindItemByValue(const AEditValue: TcxEditValue): Integer;
begin
  if not LoadFontComplete then
    Result := -1
  else
    if IsVarEmpty(AEditValue) then
      Result := -1
    else
      Result := Items.IndexOf(VarToStr(AEditValue));
end;

function TcxCustomFontNameComboBoxProperties.GetItemTypes(Index: Integer): TcxFontTypes;
begin
  Result := RealFontTypeToCxTypes(Integer(Items.Objects[Index]));
end;

procedure TcxCustomFontNameComboBoxProperties.SetFontPreview(Value: TcxFontPreview);
begin
  FontPreview.Assign(Value);
  Changed;
end;

procedure TcxCustomFontNameComboBoxProperties.LoadFontNames;
begin
  { Prepare to ShutDown FontLoader}
  if (not FLoadFontComplete) or (Assigned(FFontLoader)) then
  begin
    if Assigned(FFontLoader) then FFontLoader.OnCompleteThread := nil;
    ShutDownFontLoader;
  end;
  FLoadFontComplete := False;
  FFontLoader := TcxFontLoader.Create(FFontTypes);
  FFontLoader.OnCompleteThread := FontLoaderCompleteHandler;
  FFontLoader.OnDestroyThread := FontLoaderDestroyHandler;
  FFontLoader.Resume;
end;

procedure TcxCustomFontNameComboBoxProperties.Update(AProperties: TcxCustomEditProperties);
begin
  if (AProperties is TcxCustomFontNameComboBoxProperties) and
    FLoadFontComplete then
      with TcxCustomFontNameComboBoxProperties(AProperties) do
      begin
        Items.Assign(Self.Items);
        MRUFontNames.Assign(Self.MRUFontNames);
      end;
end;

procedure TcxCustomFontNameComboBoxProperties.FontLoaderCompleteHandler(Sender: TObject);
begin
  Items.BeginUpdate;
  try
    Items.Clear;
    if Assigned(Sender) then Items.Assign((Sender as TcxFontLoader).FontList);
  finally
    Items.EndUpdate;
  end;
  FLoadFontComplete := True;
  if Assigned(FOnInternalLoadFontComplete) then FOnInternalLoadFontComplete(Self);
  if Assigned(OnLoadFontComplete) then OnLoadFontComplete(Self);
  Changed;
end;

procedure TcxCustomFontNameComboBoxProperties.FontLoaderDestroyHandler(Sender: TObject);
begin
  FFontLoader.OnCompleteThread := nil;
  FFontLoader.OnDestroyThread := nil;
  FFontLoader := nil;
  FLoadFontComplete := True;
end;

function TcxCustomFontNameComboBoxProperties.AddMRUFontName(const AFontName: TFontName): TcxMRUFontNameAction;
var
  FIndex: Integer;
begin
  Result := mfaNone;
  if MaxMRUFonts = 0 then Exit;
  Result := mfaInvalidFontName;
  FIndex := Items.IndexOf(AFontName);
  if FIndex < 0 then Exit;
  {If this font exists in MRU list, do not add, only move to first position}
  if FMRUFontNames.Fi