generowanie ładnego tekstu :: 4programmers.net

cjv

2011-02-08T07:18:43+01:00

Rejestracja: dni
Ostatnio: dni
Postów: 16

0

Witam!:) Nie oczekuję tu rozwiązania, bo podejrzewam że łatwe ono nie jest, no i sam wolę do tego dojść, ale potrzebuję Waszej opinii.
Myślicie że w naszym kochanym Delphim bezpośrednio z programu jest możliwe wygenerowanie takiego teksu:
user image

Nie jest to najlepszej jakości grafika, ale da się zrozumieć.

Ogólnie zastosowanie mojej czcionki w programie nie jest problemem, tylko jak zrobić tą białą otoczkę?(ja ją zrobiłem w photoshopie)
Takie pośrednie wyjście to wymyśliłem że będę robił dwa labele, jeden większy koloru białego i on będzie otoczką, a na nim mniejszy czerwony- ale to jest wyjście jeśli nie będziecie mieć lepszych pomysłów:)

Miłego dnia!:)

[losowa nazwa]

2011-02-08T07:27:45+01:00

Rejestracja: dni
Ostatnio: dni
Postów: 1398

0

Znalezc komponent, ktory oferuje taka funkcjonalnosc
Rysowac samemu na jakims canvasie napis a potem dorysowac obwiednie liter (jakimkolwiek algorytmem -> Google lub sam wymysl)

Opi

2011-02-08T08:56:54+01:00

Rejestracja: dni
Ostatnio: dni
Postów: 1034

0

Możesz spróbować zastosować dwa TLabel. Jeden pogrubiony biały pod spód. Drugi czerwony normalny na wierzch. Czcionkę i rozmiar ten sam zastosuj ten sam. Inaczej nie będzie się zgadzać ułożenie liter.

Sposób z Canvasem na pewno jest najlepszym wyjściem, ale trzeba zastosować dodatkowe wygładzanie, aby uzyskać efekt jak na zdjęciu.
Tu masz przykład.

Kopiuj

begin
 Form1.Color := clBlack;
 Form1.DoubleBuffered := True;
 Form1.Refresh;
 with Form1.Canvas do
  begin
   Font.Name   := 'Tahoma';
   Font.Size   := 36;
   Font.Style  := Font.Style + [fsBold];
   Pen.Width   := 3;  //tu zwiększasz obramowanie
   Pen.Color   := clWhite; //tu zmieniasz kolor obramowania
   Brush.Style := bsClear;
   BeginPath(Handle);
   TextOut(25, 25, '4programmers.net');
   EndPath(Handle);
   Brush.Style := bsSolid;
   Brush.Color := clRed; //tu zmieniasz kolor czcionki
   StrokeAndFillPath(Handle)
  end;
end;

Azarien

2011-02-08T09:30:01+01:00

Rejestracja: dni
Ostatnio: dni

1

Myślicie że w naszym kochanym Delphim bezpośrednio z programu jest możliwe wygenerowanie takiego teksu:

Delphi jest językiem kompletnym w sensie Turinga (czyli pozwala na zaimplementowanie każdego algorytmu możliwego do zaimplementowania)
Delphi pozwala na wyświetlanie grafiki lub generowanie plików graficznych
ergo, jest możliwe wygenerowanie takiego tekstu. Nie ma powodu, aby nie było!

Jeden pogrubiony biały pod spód. Drugi czerwony normalny na wierzch.
Pogrubienie raczej działa lewo-prawo, ale nie góra-dół.

Misiekd

2011-02-08T09:31:22+01:00

Rejestracja: dni
Ostatnio: dni
Postów: 7923

0

pooglądaj sobie gr32 albo gdi+

Opi

2011-02-08T09:46:28+01:00

Rejestracja: dni
Ostatnio: dni
Postów: 1034

0

Z AntiAliasing, ale nie powiem... nie wygląda schludnie...

Kopiuj

uses Math;

procedure AntiAliasRect(Bmp: TBitmap; Rect: TRect);
var
 x, y: Integer;
 p0, p1, p2: pByteArray;
begin
 Rect.Left   := Max(1, Rect.Left);
 Rect.Top    := Max(1, Rect.Top);
 Rect.Right  := Min(Bmp.Width-2, Rect.Right);
 Rect.Bottom := Min(Bmp.Height-2, Rect.Bottom);
 Bmp.PixelFormat := pf24bit;

 for y := Rect.Top to Rect.Bottom do
   begin
    p0 := Bmp.ScanLine[y-1];
    p1 := Bmp.scanline[y];
    p2 := Bmp.ScanLine[y+1];

    for x := Rect.Left to Rect.Right do
      begin
       p1[x*3]   := (p0[x*3] + p2[x*3] + p1[(x-1)*3] + p1[(x+1)*3]) shr 2;
       p1[x*3+1] := (p0[x*3+1] + p2[x*3+1] + p1[(x-1)*3+1] + p1[(x+1)*3+1]) shr 2;
       p1[x*3+2] := (p0[x*3+2] + p2[x*3+2] + p1[(x-1)*3+2] + p1[(x+1)*3+2]) shr 2;
      end;
   end;
end;

procedure TForm6.Button1Click(Sender: TObject);
const
 TestText = '4programmers.net';
var
 Can: TCanvas;
 R: TRect;
 Bmp: TBitmap;
begin
 Can := Image1.Canvas;
 with Can do
   begin
    Font.Size   := 36;
    Font.Color  := clRed;
    Font.Style  := Font.Style + [fsBold];
    Font.Name   := 'Arial'; //wymaga TrueType!
    Brush.Color := clBlack;
    Brush.Style := bsSolid;
    Pen.Color   := clWhite;
    Pen.Style   := psSolid;
    Pen.Width   := 2;
    FillRect(TPaintBox(Sender).ClientRect);

    {Uncomment the following line to see the text output rect in black}
    Brush.Color := clBlack;

    {This draws the interior of the letters}
    TextOut(0, 0, TestText);
   end;

 {Uncomment the following block to remove the frame drawn around the text by StrokePath }
 R.TopLeft     := Point(0, 0);
 R.BottomRight := TPoint(Can.TextExtent(TestText));
 InflateRect(R, -1, -1);
 IntersectClipRect(Can.Handle, R.Left, R.Top, R.Right, R.Bottom);

 {This draws an outline around the letters}
 with Can do
  begin
   BeginPath(Handle);
   Pen.Width := 3;
   TextOut(0, 0, TestText);
   EndPath(Handle);
   StrokePath(Handle);
  end;

 Bmp := Image1.Picture.Bitmap;
 AntiAliasRect(Bmp, Rect(0, 0, Bmp.Width, Bmp.Height));
end;

cimak

2011-02-08T18:32:27+01:00

Rejestracja: dni
Ostatnio: dni
Postów: 1668

0

na szybko i przy cienkich otoczkach mozna tez tak, choc antialiasing by sie przydal..:

Kopiuj

procedure TForm1.Button1Click(Sender: TObject);
var x,y:integer;
    s:string;
    distance:byte;
    c:TCanvas;
    xx,yy:integer;
begin
  c:=Image1.canvas;
  c.Font:=Font;//czcionka form1, latwiej w object inspectorze ustawic;]
  c.Font.Size:=44;

  c.Brush.Color:=clBlack;
  c.FillRect(c.ClipRect);
  c.Brush.Style:=bsClear;

  x:=25;
  y:=25;
  distance:=2;
  s:='www.programmers.net';

  {otoczka}
  c.Font.Color:=clWhite;
  for xx:=-distance to distance do
    for yy:=-distance to distance do
      c.TextOut(x+xx,y+yy, s);
  {napis}
  c.Font.Color:=clred;
  c.TextOut(x,y, s);
end;

cjv

2011-02-08T19:01:16+01:00

Rejestracja: dni
Ostatnio: dni
Postów: 16

0

dobra! spróbuję każdy sposób i pokażę co mi wyszło:) Dzięki wielkie;]