Рисуется хвост за текстом (TextOut)

[Кольша]

FillRect вроде отчищает его
UPD: Не успел BDA опередил

[artemavd]

Между какими строками нужно поместить этот код вызова?

[Кольша]

Можно сделать так кинуть две картинки на форму в одну загрузить картинку и присвоить ей(image*) visible:=false, а на другой рисовать

procedure TForm1.FormCreate(Sender: TObject);
begin
  with Image1.Canvas do
  begin
    Brush.Color:=clBlue;
    Brush.Style:=bsSolid;
    FillRect(ClipRect);
    Font.Color:=clYellow;
  end;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  with Image1.Canvas do
  begin
    FillRect(ClipRect);
draw(0,0,image*.canvas);
    TextOut(x,y,'text');
  end;
end;

Вроде так должно работать на IDE не проверял

[artemavd]

А без дополнительного изображения разве нельзя?

[Кольша]

ну если фон. не картинка а просто цвет то можно покрасить canvas, ну а если картинку том можно с ресурсами повозиться

[3D Hunter]

procedure TForm1.FormCreate(Sender: TObject);
begin
  with Image1.Canvas do
  begin
    Brush.Bitmap:=TBitmap.Create;
    with Brush.Bitmap do
    begin
      LoadFromFile('D:\1.bmp');
    end;
    FillRect(ClipRect);
    Font.Color:=clRed;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Image1.Canvas.Brush.Bitmap.Free;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  with Image1.Canvas do
  begin
    FillRect(ClipRect);
    TextOut(x,y,'text');
  end;
end;

Только пока не понял, почему фон текста не прозрачен...

[Кольша]

может Canvas.Brush.Color на ето влияет

[3D Hunter]

Не будем угадывать. Все уже проверял, не то. Если вы знаете точное решение, напишите код, буду благодарен.

[Аватар]

Не очень нравится, но похоже оно (вернее совсем не нравится, но только этого за 20 минут добился)

var Bitmap: TBitmap;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Bitmap:=TBitmap.Create;
  Bitmap.LoadFromFile('e:\1.bmp');
  Image1.Canvas.Brush.Bitmap:=Bitmap;
  Image1.Canvas.FillRect(Image1.Canvas.ClipRect);
  Image1.Canvas.Font.Color:=clRed;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Bitmap.Free;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var xStyle: TBrushStyle;
begin
  Image1.Canvas.Brush.Bitmap:=Bitmap;
  Image1.Canvas.FillRect(Image1.Canvas.ClipRect);
  Image1.Canvas.Brush.Style:=bsClear;
  Image1.Canvas.TextOut(x,y,'text');
end;

[phomm]

Можно развлечься с CopyRect'ингом (а ещё лучше блиттингом) из фонового битмапа области размером X + GetTextWidth, Y + GetTextHeight
Тогда не надо будет Филректа и переключать режим кисти, пусть всегда будет бсклиар. Да и время заливки "подложки" текста будет побыстрее (особенно при блиттинге, ибо копирект несёт в себе стретчблит)

Вот кстати мой личный Копирект на блите, ректы должны быть одноразмерные (надо будет ассерт мне ещё сюда под их проверку из EqualRect добавить)

procedure copyrect(canvdest, canvsrc: TCanvas; rectdest, rectsrc: TRect);
begin
  Assert((canvdest <> nil) or (canvsrc <> nil), strRedrawError);
  bitblt(canvdest.handle, rectdest.Left, rectdest.Top, rectdest.Right -
    rectdest.Left, rectdest.Bottom - rectdest.Top, canvsrc.Handle, rectsrc.Left,
    rectsrc.Top, SRCCOPY);
end;