ktextdrawer.pas

DBDesigner 4 is a database design system that integrates database design, modelling, creation and ma

begin
  fBaseFont := TFont.Create;
  fFontList := TList.Create;

  BaseFont:=ABaseFont;
  BaseStyle:=CalcExtentBaseStyle;
end;

destructor TheTextDrawer.Destroy;
begin
  fBaseFont.Free;
  ClearFontList;
  fFontList.Free;

  inherited Destroy;
end;

procedure TheTextDrawer.EndDrawing;
begin
  if FDrawingCount>0 then
    dec(FDrawingCount);

  if FDrawingCount=0 then
    fCanvas:=nil;
end;

procedure TheTextDrawer.ExtTextOut(X, Y: Integer; fuOptions: UINT;
  const ARect: TRect; Text: PChar; Length: Integer);
begin
  if fCanvas<>nil then
    begin
//      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 }

procedure TCaret.Blink(b: boolean);
begin
  Visible := b and Active;
end;

constructor TCaret.Create(AParent: TWidgetControl);
begin
  inherited Create(AParent);
  Visible := False;
  ControlStyle := [csOpaque];
  Cursor := AParent.Cursor;
  Parent := AParent;
end;

destructor TCaret.Destroy;
begin
  if CaretManager.CurrentCaret = self then
    CaretManager.CurrentCaret := nil;
  inherited Destroy;
end;

procedure TCaret.SetActive(const Value: boolean);
begin
  if fActive <> Value then
  begin
    fActive := Value;
    Visible := Value;
  end;
end;

procedure TCaret.Paint;
var
  iBounds: TRect;
begin
  iBounds := BoundsRect; { we're painting on Parent's Canvas... }
  Canvas.CopyMode := cmDstInvert;
  Canvas.CopyRect( iBounds, Canvas, iBounds );
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.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 CurrentCaret<>nil then
  begin
    fCaretVisible := not fCaretVisible;
    CurrentCaret.Blink( fCaretVisible );
  end;
end;

procedure TCaretManager.ResetCaret;
begin
  CurrentCaret.Visible := True;
  fCaretVisible := True;
  { restart timer }
  fBlinkTimer.Enabled := False;
  fBlinkTimer.Enabled := True;
end;

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

{ TSynEditScrollBar }

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

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