fctext.pas

一套及时通讯的原码

  begin
    FEnabled := Value;
    FText.Callbacks.AdjustBounds;
    FText.CallInvalidate;
  end;
end;

procedure TfcShadowEffects.SetXOffset(Value: Integer);
begin
  if FXOffset <> Value then
  begin
    FXOffset := Value;
    FText.Callbacks.AdjustBounds;
    FText.CallInvalidate;
  end;
end;

procedure TfcShadowEffects.SetYOffset(Value: Integer);
begin
  if FYOffset <> Value then
  begin
    FYOffset := Value;
    FText.Callbacks.AdjustBounds;
    FText.CallInvalidate;
  end;
end;

// TfcExtrudeEffects

constructor TfcExtrudeEffects.Create(Text: TfcText);
begin
  inherited Create;
  FText := Text;

  FDepth := 10;
  FOrientation := fcBottomRight;
end;

procedure TfcDisabledColors.AssignTo(Dest: TPersistent);
begin
  with Dest as TfcDisabledColors do
  begin
     HighlightColor:= self.HighlightColor;
     ShadeColor:= self.ShadeColor;
  end;
end;

procedure TfcExtrudeEffects.AssignTo(Dest: TPersistent);
begin
  with Dest as TfcExtrudeEffects do
  begin
    Depth := self.Depth;
    Enabled := self.Enabled;
    FarColor := self.FarColor;
    NearColor := self.NearColor;
    Orientation := self.Orientation;
    Striated := self.Striated;
  end;
end;

function TfcExtrudeEffects.EffectiveDepth(CheckOrient: Boolean): TSize;
begin
  result := fcSize(Depth, Depth);
  if Enabled then with OFFSETCOORD[FText.ExtrudeEffects.Orientation] do
  begin
    if CheckOrient then
      result := fcSize(Depth * Abs(x), Depth * Abs(y));
  end else result := fcSize(0,0);
end;

procedure TfcExtrudeEffects.SetDepth(Value: Integer);
begin
  if FDepth <> Value then
  begin
    FDepth := Value;
    FText.Callbacks.AdjustBounds;
    FText.CallInvalidate;
  end;
end;

procedure TfcExtrudeEffects.SetEnabled(Value: Boolean);
begin
  if FEnabled <> Value then
  begin
    FEnabled := Value;
    FText.Callbacks.AdjustBounds;
    FText.CallInvalidate;
  end;
end;

procedure TfcExtrudeEffects.SetFarColor(Value: TColor);
begin
  if FFarColor <> Value then
  begin
    FFarColor := Value;
    FText.CallInvalidate;
  end;
end;

procedure TfcExtrudeEffects.SetNearColor(Value: TColor);
begin
  if FNearColor <> Value then
  begin
    FNearColor := Value;
    FText.CallInvalidate;
  end;
end;

procedure TfcExtrudeEffects.SetOrientation(Value: TfcOrientation);
begin
  if FOrientation <> Value then
  begin
    FOrientation := Value;
    FText.Callbacks.AdjustBounds;
    FText.CallInvalidate;
  end;
end;

procedure TfcExtrudeEffects.SetStriated(Value: Boolean);
begin
  if FStriated <> Value then
  begin
    FStriated := Value;
    FText.CallInvalidate;
  end;
end;

constructor TfcText.Create(ACallbacks: TfcTextCallbacks; ACanvas: TCanvas; AFont: TFont);
begin
  inherited Create;
  FCallbacks := ACallbacks;

  FCanvas := ACanvas;
  FFont := AFont;
  FPaintBitmap := nil;
  FPaintCanvas:= nil;

  FExtrudeEffects := TfcExtrudeEffects.Create(self);
  FHighlightColor := clBtnHighlight;
  FLineSpacing := 5;
  FOptions := [toShowAccel];
  FShadeColor := clBtnShadow;
  FShadow := TfcShadowEffects.Create(self);
  FDisabledColors := TfcDisabledColors.Create(self);

  FFlags := DT_NOCLIP;
end;

destructor TfcText.Destroy;
begin
  FExtrudeEffects.Free;
  FShadow.Free;
  FDisabledColors.Free;
  FPaintBitmap.Free;
  FPaintBitmap := nil;
  FPaintCanvas := nil;
  inherited;
end;

procedure TfcText.AssignTo(Dest: TPersistent);
begin
  with Dest as TfcText do
  begin
    // 4/16/03 - Following items Missing preoviuosly
    Alignment:= self.Alignment;
    DisabledColors.Assign(self.DisabledColors);
    DoubleBuffered:= self.DoubleBuffered;
    WordWrap:= self.WordWrap;
    VAlignment:= self.VAlignment;
    /// End missing items

    ExtrudeEffects.Assign(self.ExtrudeEffects);
    HighlightColor := self.HighlightColor;
    LineSpacing := self.LineSpacing;
    Options := self.Options;
    OutlineColor := self.OutlineColor;
    Rotation := self.Rotation;
    ShadeColor := self.ShadeColor;
    Shadow.Assign(self.Shadow);
    Style := self.Style;
    Text := self.Text;
  end;
end;

function TfcText.GetAngle: Extended;
begin
  result := DegToRad(Rotation);
end;

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

procedure TfcText.SetLineSpacing(Value: Integer);
begin
  if Value <> FLineSpacing then
  begin
    FLineSpacing := Value;
    Callbacks.AdjustBounds;
    CallInvalidate;
  end;
end;

procedure TfcText.SetHighlightColor(Value: TColor);
begin
  if FHighlightColor <> Value then
  begin
    FHighlightColor := Value;
    CallInvalidate;
  end;
end;

procedure TfcText.SetOptions(Value: TfcTextOptions);
begin
  if Value <> FOptions then
  begin
    FOptions := Value;
    fcAdjustFlag(not (toShowAccel in FOptions), FFlags, DT_NOPREFIX);
    fcAdjustFlag(toShowEllipsis in FOptions, FFlags, DT_END_ELLIPSIS);
    Callbacks.AdjustBounds;
    CallInvalidate;
  end;
end;

procedure TfcText.SetOutlineColor(Value: TColor);
begin
  if Value <> FOutlineColor then
  begin
    FOutlineColor := Value;
    CallInvalidate;
  end;
end;

procedure TfcText.SetRotation(Value: Integer);
begin
  if (Value < 0) then FRotation := 360 - (Abs(Value) mod 360)
  else FRotation := Value mod 360;
  Callbacks.AdjustBounds;
  CallInvalidate;
end;

procedure TfcText.SetScaledFont(Value: Boolean);
begin
  if FScaledFont <> Value then
  begin
    FScaledFont := Value;
    CallInvalidate;
  end;
end;

procedure TfcText.SetShadeColor(Value: TColor);
begin
  if FShadeColor <> Value then
  begin
    FShadeColor := Value;
    CallInvalidate;
  end;
end;

procedure TfcText.SetStyle(Value: TfcTextStyle);
begin
  if Value <> FStyle then
  begin
    FStyle := Value;
    Callbacks.AdjustBounds;
    CallInvalidate;
  end;
end;

procedure TfcText.SetText(Value: string);
begin
  if Value <> FText then
  begin
    FText := Value;
//    CallInvalidate;
  end;
end;

procedure TfcText.SetTextRect(Value: TRect);
begin
  FTextRect := Value;
end;

procedure TfcText.SetVAlignment(Value: TfcVAlignment);
begin
  if FVAlignment <> Value then
  begin
    FVAlignment := Value;
    CallInvalidate;
  end;
end;

procedure TfcText.SetWordWrap(Value: Boolean);
begin
  if FWordWrap <> Value then
  begin
    FWordWrap := Value;
    fcAdjustFlag(WordWrap, FFlags, DT_WORDBREAK);
    CallInvalidate;
  end;
end;

function TfcText.GetLogFont: TLogFont;
const TRUETYPE: array[Boolean] of Integer = (OUT_TT_PRECIS, OUT_TT_ONLY_PRECIS);
begin
  with result do begin
    lfHeight := Font.Height;
    if ScaledFont then lfHeight := fcTrunc(lfHeight * (Screen.PixelsPerInch / 96));
    lfWidth := 0;
    lfEscapement := Rotation * 10;
    lfOrientation := Rotation * 10;

    if fsBold in Font.Style then lfWeight := FW_BOLD else lfWeight := FW_NORMAL;
    if fsItalic in Font.Style then lfItalic := 1 else lfItalic := 0;
    if fsUnderline in Font.Style then lfUnderline := 1 else lfUnderline := 0;
    if fsStrikeOut in Font.Style then lfStrikeout := 1 else lfStrikeout := 0;

    lfCharSet := ANSI_CHARSET;              {Default}

    if Font.CharSet <> DEFAULT_CHARSET then
       lfCharSet := Font.CharSet; { 6/4/99 - Use font's charset }

    lfOutPrecision := TRUETYPE[Rotation <> 0];
    lfClipPrecision := CLIP_DEFAULT_PRECIS; {Default}
    lfQuality := PROOF_QUALITY;             {Windows gets a better one if available}
    lfPitchAndFamily := VARIABLE_PITCH;     {Default}
    StrPCopy(lfFaceName, Font.Name);        {Canvas's font name}
  end;
end;

function TfcText.CalcTextSize(IgnoreRect: Boolean): TSize;
var Angle: Extended;
    TextSize: TSize;
begin
  Angle := self.Angle;
  TextSize := GetTextSize;

  // Correct for Extrusion
  with ExtrudeEffects.EffectiveDepth(False) do
    result := fcSize(
    TextSize.cx + cx,
    TextSize.cy + cy);

  with Shadow.EffectiveOffset do begin
    inc(result.cx, x);
    inc(result.cy, y);
  end;

  // Correct for Outline
  if Style = fclsOutline then begin
    inc(result.cx, 2);
    inc(result.cy, 2);
  end;

  // Correct for Rotation
  with result do
    result := fcSize(
      fcTrunc(cx * Abs(Cos(Angle)) + cy * Abs(Sin(Angle))),
      fcTrunc(cx * Abs(Sin(Angle)) + cy * Abs(Cos(Angle))));

//  IgnoreRect := False;

  // Correct for TextRect
  if not IgnoreRect then
    with result do result := fcSize(
      fcMin(cx, fcRectWidth(TextRect)),
      fcMin(cy, fcRectHeight(TextRect)));
end;

function TfcText.CalcRect(IgnoreRect: Boolean): TRect;
var Angle: Extended;
    TextSize: TSize;
begin
  Angle := Self.Angle;

  result.Left := TextRect.Left + fcRectWidth(TextRect) div 2;   // Place initial position in
  result.Top := TextRect.Top + fcRectHeight(TextRect) div 2;    // dead center.

  with Shadow.EffectiveOffset do
  begin
    dec(result.Left, x div 2);                 // Correct for shadow offsets.
    dec(result.Top, y div 2);
  end;

  with ExtrudeEffects.EffectiveDepth(False) do begin
    dec(result.Left, cx div 2); // Correct for extrusion
    dec(result.Top, cy div 2);
  end;

  // Now correct for rotation
  TextSize := GetTextSize;//CalcTextSize(IgnoreRect);
  with TextSize do
  begin
    dec(result.Left, fcTrunc(Cos(Angle) * cx) div 2);
    inc(result.Top, fcTrunc(Sin(Angle) * cx) div 2);
    dec(result.Top, fcTrunc(Cos(Angle) * cy) div 2);
    dec(result.Left, fcTrunc(Sin(Angle) * cy) div 2);
  end;

  with CalcTextSize(IgnoreRect), result do
    result := Rect(Left, Top, Left + cx, Top + cy);

  // Make sure the point is at least at (0, 0);
//  with result do
//    OffsetRect(result, Abs(fcMin(0, Left)), Abs(fcMin(0, Top)));
  with TextRect do
    OffsetRect(result, Abs(fcMin(0, result.Left - Left)), Abs(fcMin(0, result.Top - Top)));
end;