ktextdrawer.pas

一个非常好的c++编译器

//      fCanvas.Brush.Color := random($ffffff);
      fCanvas.Brush.Style := bsSolid;
      fCanvas.FillRect(ARect);

      if Text<>nil then
        begin
          if Length=-1 then
            fCanvas.TextRect(ARect,X, Y, Text)
          else
            fCanvas.TextRect(ARect,X, Y, copy(Text,1,Length));

          if fakeBold then
            if Length=-1 then
              fCanvas.TextRect(ARect,X+1, Y, Text)
            else
              fCanvas.TextRect(ARect,X+1, Y, copy(Text,1,Length));
        end;
    end;
end;

function TheTextDrawer.findFont(aStyle: TFontStyles; aColor : TColor): TFont;
var
  i : integer;

begin
  result:=nil;

  for i:=0 to FontCount-1 do
    if (FontStyle[i] = aStyle) and (Fonts[i].Color = aColor) then
      begin
        result:=Fonts[i];
        break;
      end;

  if result=nil then
    begin
      result:=TFont.Create;
      result.assign(fBaseFont);
      result.style:=aStyle;
      result.color:=aColor;
      fFontList.Add(TFontHolder.Create(result,aStyle));
    end;
end;

function TheTextDrawer.GetCharHeight: Integer;
begin
  result := fCharHeight;
end;

function TheTextDrawer.GetCharWidth: Integer;
begin
  result := fCharWidth;
end;

function TheTextDrawer.getFont(index: integer): TFont;
begin
  result:=TFontHolder(fFontList[index]).font;
end;

function TheTextDrawer.getFontCount: integer;
begin
  result:=fFontList.Count;
end;

function TheTextDrawer.getFontStyle(index: integer): TFontStyles;
begin
  result:=TFontHolder(fFontList[index]).style;
end;

procedure TheTextDrawer.SetBackColor(Value: TColor);
begin
  if FBkColor <> Value then
  begin
    FBkColor := Value;

    if fCanvas<>nil then
      fCanvas.Brush.Color:=Value;
  end;
end;

procedure TheTextDrawer.SetBaseFont(Value: TFont);
begin
  if Value<>nil then
    begin
      fBaseFont.Assign(Value);
      UpdateFontMetrics;
      UpdateCurrentFont;
    end;
end;

procedure TheTextDrawer.SetBaseStyle(const Value: TFontStyles);
begin
  fBaseFont.Style := Value;
  UpdateFontMetrics;
end;

procedure TheTextDrawer.SetCharExtra(Value: Integer);
begin
  // do nothing
end;

procedure TheTextDrawer.SetForeColor(Value: TColor);
begin
  fCurrentColor:=Value;
  UpdateCurrentFont;
end;

procedure TheTextDrawer.SetStyle(Value: TFontStyles);
begin
  fCurrentStyle := Value;
  UpdateCurrentFont;
end;

procedure TheTextDrawer.TextOut(X, Y: Integer; Text: PChar;
  Length: Integer);
begin
  if fCanvas<>nil then
    begin
      fCanvas.Brush.Style := bsSolid;

      if Text<>nil then
        begin
          if Length=-1 then
            fCanvas.TextOut(X, Y, Text)
          else
            fCanvas.TextOut(X, Y, copy(Text,1,Length));


          if fakeBold then
            if Length=-1 then
              fCanvas.TextOut(X+1, Y, Text)
            else
              fCanvas.TextOut(X+1, Y, copy(Text,1,Length));
        end;
    end;
end;

procedure TheTextDrawer.UpdateCurrentFont;
begin
  fCurrentFont:=findFont(fCurrentStyle, fCurrentColor);
  QFont_setFixedPitch(fCurrentFont.Handle, TRUE);

  if fCanvas<>nil then
    begin
      fCanvas.Font.Assign(fCurrentFont);
    end;

  // Make sure that we can draw bold text even if the current font
  // doesn't want to do it
  fakeBold := (fsBold in fCurrentStyle) and not (fsBold in fCurrentFont.Style);
end;

procedure TheTextDrawer.UpdateFontMetrics;
var
  fm     : QFontMetricsH;
  ch     : WideChar;
  w      : integer;
  fi     : QFontInfoH;
  family : WideString;

begin
  fi := QFontInfo_create(fBaseFont.Handle);
  try
    // make sure that the font object is refering to the same
    // font that Qt is actually using, otherwise the width functions
    // don't seem to work properly :(
    if not QFontInfo_exactMatch(fi) then
      begin
        fBaseFont.Size := QFontInfo_pointSize(fi);
        QFontInfo_family(fi, @family);
        fBaseFont.Name := family;
      end;
  finally
    QFontInfo_destroy(fi);
  end;

  fm := QFontMetrics_create(fBaseFont.Handle);
  try
    ch := 'W';

    w := QFontMetrics_width(fm, @ch);
    fCharWidth := w;
    fCharHeight := QFontMetrics_height(fm);
  finally
    QFontMetrics_destroy(fm);
  end;

  ClearFontList;
end;

{ TCaret }

constructor TCaret.Create(AOwner: TWidgetControl; Width, Height: Integer);
begin
  inherited Create(AOwner);
  FRect.Right := Width;
  FRect.Bottom := Height;
  FOwnerCanvas := TControlCanvas.Create;
  TControlCanvas(FOwnerCanvas).Control := AOwner;
end;

destructor TCaret.Destroy;
begin
  if CaretManager.CurrentCaret = Self then
    CaretManager.CurrentCaret := nil;
  FActive := False;
  ForceInternalInvisible;
  inherited Destroy;
  FOwnerCanvas.Free;
end;

procedure TCaret.ForceInternalInvisible;
begin
  while FInternalShowCount >= 1 do InternalHide;
end;

procedure TCaret.ForceInternalVisible;
begin
  while FInternalShowCount <= 0 do InternalShow;
end;

function TCaret.GetTopLeft: TPoint;
begin
  Result := FRect.TopLeft;
end;

procedure TCaret.Hide;
begin
  dec(FShowCount);
  if FShowCount = 0 then
  begin
     FActive := False;
    ForceInternalInvisible;
  end;
end;

procedure TCaret.InternalHide;
begin
  dec(FInternalShowCount);
  if FInternalShowCount = 0 then
    Paint;
end;

procedure TCaret.InternalShow;
begin
  inc(FInternalShowCount);
  if FInternalShowCount = 1 then
    Paint;
end;

procedure TCaret.Paint;
var
  OldCopyMode: TCopyMode;
begin
  if Assigned(Owner)then
    with OwnerCanvas do
    begin
      OldCopyMode := CopyMode;
      CopyMode := cmDstInvert;
      CopyRect(FRect, OwnerCanvas, FRect);
      CopyMode := OldCopyMode;
    end;
end;

procedure TCaret.SetTopLeft(const Value: TPoint);
begin
  if (FRect.Left = Value.X) and (FRect.Top = Value.Y) then exit;

  if FActive then InternalHide;
  FRect.Right := FRect.Right + (Value.X - FRect.Left);
  FRect.Left := Value.X;
  FRect.Bottom := FRect.Bottom + (Value.Y - FRect.Top);
  FRect.Top := Value.Y;
  if FActive then
  begin
    ForceInternalVisible;
    CaretManager.ResetTimer;
  end;
end;

procedure TCaret.Show;
begin
  if FShowCount < 1 then
  begin
    inc(FShowCount);
    if FShowCount = 1 then
    begin
      FActive := True;
      ForceInternalVisible;
      CaretManager.ResetTimer;
    end;
  end;
end;

procedure TCaret.Toggle;
begin
  if Active then
    if Visible then InternalHide else InternalShow;
end;

function TCaret.Visible: Boolean;
begin
  Result := FInternalShowCount > 0;
end;

{ TFontHolder }

constructor TFontHolder.Create(aFont: TFont; aStyle: TFontStyles);
begin
  Font := aFont;
  Style:= aStyle;
end;

{ TCaretManager }

constructor TCaretManager.Create;
begin
  fBlinkTimer := TTimer.Create(nil);
  fBlinkTimer.Enabled := False;
  fBlinkTimer.Interval := QApplication_cursorFlashTime div 2;
  fBlinkTimer.OnTimer := HandleTimer;
end;

destructor TCaretManager.Destroy;
begin
  fBlinkTimer.Free;
  inherited Destroy;
end;

procedure TCaretManager.HandleTimer(Sender: TObject);
begin
  if Assigned(CurrentCaret) then
    CurrentCaret.Toggle;
end;

procedure TCaretManager.ResetTimer;
begin
  fBlinkTimer.Enabled := False;
  fBlinkTimer.Enabled := True;
end;

procedure TCaretManager.SetCurrentCaret(const Value: TCaret);
begin
  if fCurrentCaret <> Value then
  begin
    fCurrentCaret := Value;
    fBlinkTimer.Enabled := (CurrentCaret <> nil) and CurrentCaret.Active;
  end;
end;

{ TSynEditScrollBar }

constructor TSynEditScrollBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csNoFocus];
  TabStop := False;
  Visible := False;
end;

initialization
  CaretManager := TCaretManager.Create;
finalization
  CaretManager.Free;
end.