Digilabel Komponente mit coolem Effekt

[padavan]

Guten Morgen Delphianer,

vor lauter Langeweile hatte ich mal ne Komponente programmiert, mit der man sich einen String anzeigen lassen kann.
Genau --> gibt´s schon, soll also einfach nur gut aussehen, und außerdem wollte ich wissen wie so was überhaupt geht.

Im Anhang also schon mal die .pas Datei mit welcher sich man die Kompo mal anschauen könnte.
Sie hat definitiv den Nachteil, dass sie nicht skalierbar ist und
sie ist von TPaintbox abgeleitet, um zu sehen, was man als String an .caption übergeben hat, muss man im .onpaint nochmal den String auf sich selbst zuweisen, oder die Form1 neu zeichen oder oder oder
(als Amateur leider nicht besser hinbekommen)

Habe mehr aus Zufall entdeckt, dass wenn man einen Screenshot von meiner Kompo macht und die dann in jpg umwandelt ein echt goiler Effekt zu Stande kommt.
Bitte mal im Anhang anschauen.

Tja, daher nun die eigentliche Frage,
hat jemand eine Idee, wie man sowas verwirklichen könnte, also das es immer so ausschaut, nicht aus schlecht konvertiertes jpg?

Grüße
Padavan

PS:
Der Screenshot stammt übrgigens von meinem "Dreamplayer", die Komponente welche ich meine ist im Screenshot sichtbar mit : "Talking Head - Psycho Killer"

[Corpsman]

Du hast geschrieben

Delphi-Quellcode:

Procedure TDigilabel.setOffset;
Begin
  If Offset Mod 3 = 0 Then Begin
    fOffset := Offset;
    setcaption(caption);
  End;
End;

und in deiner Create Function wnderst du dich warum es nicht geht Offset = -9 zu machen.

Ich kann dir sagen wieso. Der Mod Befehl geht nur für Positibve Zahlen.

Delphi-Quellcode:

Procedure TDigilabel.setOffset;
var tmp:Integer;
Begin
  tmp:=abs(offset);
  If tmp Mod 3 = 0 Then Begin
    fOffset := Offset;
    setcaption(caption);
  End;
End;

wäre da schon besser.

Deine Kombo testen konnte ich aber nicht. Da ich sie nicht installieren wollte und folgender Code nicht aussreicht um sie auf dem Formular an zu zeigen.

Delphi-Quellcode:

Unit Unit1;

Interface

Uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Digilabel;

Type
  TForm1 = Class(TForm)
    Procedure FormCreate(Sender: TObject);
    Procedure FormClose(Sender: TObject; Var Action: TCloseAction);
  private
    { Private-Deklarationen }
    bla: TDigilabel;
  public
    { Public-Deklarationen }
  End;

Var
  Form1: TForm1;

Implementation

{$R *.DFM}

Procedure TForm1.FormCreate(Sender: TObject);
Begin
  bla := TDigilabel.create(self);
  bla.parent := Form1;
  bla.caption := 'Test';
  bla.Visible := true;
  bla.Left := 10;
  bla.Top := 10;

End;

Procedure TForm1.FormClose(Sender: TObject; Var Action: TCloseAction);
Begin
  bla.free;
End;

End.

[Edit]

Delphi-Quellcode:

Procedure TDigilabel.Muster(Farbe: TColor);
Var
  x, y: integer;
Begin
  For x := 0 To width Do
    If x Mod 3 = 0 Then
      For y := 0 To height Do
        If y Mod 3 = 0 Then Begin
          canvas.Pixels[x - 2, y + 1] := Farbe;
          canvas.Pixels[x - 1, y + 1] := Farbe;
          canvas.Pixels[x - 2, y + 2] := Farbe;
          canvas.Pixels[x - 1, y + 2] := Farbe;
        End;

mach das lieber mit Scanline Canvas.pixels ist etwas arg langsam.

Dito bei

Procedure TDigilabel.Digit(vonLinks: integer; vonOben: integer);

[padavan]

Hallo Corpsman,

viele Dank für die Hinweise (scanline, -9). Werde ich berücksichtigen.
Das war zwar nicht meine eigentliche Frage, aber definitiv interessant......!




Das mit dem Test sollte so schon gehen, das war die Sache mit dem nochmal frisch zeichnen.
So hatte ich das immer zu Testen realisiert:

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Digilabel, ComCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    ComboBox_Fontcolor: TComboBox;
    TrackBar_Offset: TTrackBar;
    Button1: TButton;
    procedure Edit1Change(Sender: TObject);
    procedure ComboBox_FontcolorChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure TrackBar_OffsetChange(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Digilabel: TDigilabel;
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  // Dynamisch erzeugen damit schneller getestet werden kann
  Digilabel := TDigilabel.Create(self);
  Digilabel.Parent := self;
  Digilabel.Name := 'Digilabel';
  Digilabel.Left := 30;
  Digilabel.Top := 20;

  Digilabel.width := 500;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  Digilabel.caption := Edit1.Text;
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
  Digilabel.caption := Edit1.Text;
end;



end.

noch besser, das ganze Testprojekt im Anhang..

[Corpsman]

Also wenn ich dich Richtig verstehe willst du das deine Kombo Geglättet ausgibt ?

Das geht eigentlich recht einfach.

Du machst 2 schleifen die du nach dem Zeichnen deiner Buschtaben über das Bild jagst.

Delphi-Quellcode:

// Pseudo Code

For x := 1 to Bildbreite-1 do

  For y := 1 to Bildhöhe-1 do

    p := Farbwert_pixel[x-1,y-1] + Farbwert_pixel[x,y-1] +Farbwert_pixel[x+1,y-1] +
         Farbwert_pixel[x-1,y] + Farbwert_pixel[x,y] +Farbwert_pixel[x+1,y] +
         Farbwert_pixel[x-1,y+1] + Farbwert_pixel[x,y+1] +Farbwert_pixel[x+1,y+1];
    p:= p / 9;
    Canvas.pixels[x,y] := p;
  end;
end;

Mir ist klar das man p in die 3 RGB Komponenten aufspalten mus, ich finde gerade nur mein Glätten sample nicht.

Mit Scanline geht das natürlich auch wunderbar.

[Edit]

Delphi-Quellcode:

procedure TForm1.TrackBar_OffsetChange(Sender: TObject);
begin
  if Trackbar_Offset.Position mod 3 = 0 then     // Optional
    Digilabel.Offset := Trackbar_Offset.Position;
end;

ist natürlich nicht so sinnvoll weil du ja zwei mal auf Mod 3 = 0 prüfst

da kannst gleich

Delphi-Quellcode:

procedure TForm1.TrackBar_OffsetChange(Sender: TObject);
begin
//  if Trackbar_Offset.Position mod 3 = 0 then     // Optional
    Digilabel.Offset := Trackbar_Offset.Position * 3;
end;

machen

[padavan]

Mensch Glätten war genau das richtige.
Dazu habe ich folgende Codes gefunden:

// bezogen auf mein Projekt....
// Pixel --> funzt, aber sehr langsam

Delphi-Quellcode:

var x, y: integer;
  r, b, g: byte;
begin
  with Digilabel.canvas do
  begin
    for x:=1 to Digilabel.Width-1 do
      for Y:=1 to Digilabel.height-1 do
      begin
        r:=(GetRValue(Pixels[x-1,y-1])+
          GetRValue(Pixels[x,y-1])+
          GetRValue(Pixels[x+1,y-1])+
          GetRValue(Pixels[x-1,y])+
          GetRValue(Pixels[x+1,y])+
          GetRValue(Pixels[x-1,y+1])+
          GetRValue(Pixels[x,y+1])+
          GetRValue(Pixels[x+1,y+1])+
          GetRValue(Pixels[x,y])) div 9;
        g:=(GetGValue(Pixels[x-1,y-1])+
          GetGValue(Pixels[x,y-1])+
          GetGValue(Pixels[x+1,y-1])+
          GetGValue(Pixels[x-1,y])+
          GetGValue(Pixels[x+1,y])+
          GetGValue(Pixels[x-1,y+1])+
          GetGValue(Pixels[x,y+1])+
          GetGValue(Pixels[x+1,y+1])+
          GetGValue(Pixels[x,y])) div 9;
        b:=(GetBValue(Pixels[x-1,y-1])+
          GetBValue(Pixels[x,y-1])+
          GetBValue(Pixels[x+1,y-1])+
          GetBValue(Pixels[x-1,y])+
          GetBValue(Pixels[x+1,y])+
          GetBValue(Pixels[x-1,y+1])+
          GetBValue(Pixels[x,y+1])+
          GetBValue(Pixels[x+1,y+1])+
          GetBValue(Pixels[x,y])) DIV 9;
        Pixels[x,y]:=RGB(r,g,b);
      end;
  end;

// Scanline --> soll laut "Hersteller" sehr schnell sein, funzt aber leider nicht

Delphi-Quellcode:

type
  TRGBTripleArray = array[0..32768] of TRGBTriple;
  // 32768 = maximale Anzahl der Pixel in der Breite eines Bildes (also eine "ScanLine")
  pRGBTripleArray = ^TRGBTripleArray; // Pointer auf TRGBTripleArray



procedure TForm1.Button3Click(Sender: TObject);

  procedure Antialiasing(const DC: TCanvas; const Rectangle: TRect);
  var
    cx, cy: Smallint;
    r, g, b: Byte;
    Row1: pRGBTripleArray;
    Row2: pRGBTripleArray;
    Row3: pRGBTripleArray;
    TEMP: TBitmap;
    CurRect: TRect;
  begin
    TEMP := TBitmap.Create;
    try
      with TEMP do begin
        Width := Rectangle.Right - Rectangle.Left;
        Height := Rectangle.Bottom - Rectangle.Top;
        CurRect := Rect(0, 0, Width, Height);
        PixelFormat := pf24Bit;
        Canvas.CopyRect(CurRect, DC, Rectangle);
        with Canvas do begin
          for cy := 1 to (Height - 2) do begin
            Row1 := ScanLine[cy - 1];
            Row2 := ScanLine[cy];
            Row3 := ScanLine[cy + 1];

            for cx := 1 to (Width - 2) do begin
              r := (Row1[cx - 1].rgbtRed+Row1[cx].rgbtRed+
              Row1[cx + 1].rgbtRed+
              Row2[cx - 1].rgbtRed+
              Row2[cx + 1].rgbtRed+
              Row2[cx - 1].rgbtRed+
              Row3[cx].rgbtRed+
              Row3[cx + 1].rgbtRed+
              Row3[cx].rgbtRed) div 9;

              g := (Row1[cx - 1].rgbtGreen+
              Row1[cx].rgbtGreen+
              Row1[cx + 1].rgbtGreen+
              Row2[cx - 1].rgbtGreen+
              Row2[cx + 1].rgbtGreen+
              Row2[cx - 1].rgbtGreen+
              Row3[cx].rgbtGreen+
              Row3[cx + 1].rgbtGreen+
              Row3[cx].rgbtGreen) div 9;

              b := (Row1[cx - 1].rgbtBlue+
              Row1[cx].rgbtBlue+
              Row1[cx + 1].rgbtBlue+
              Row2[cx - 1].rgbtBlue+
              Row2[cx + 1].rgbtBlue+
              Row2[cx - 1].rgbtBlue+
              Row3[cx].rgbtBlue+
              Row3[cx + 1].rgbtBlue+
              Row3[cx].rgbtBlue) div 9;
              Row2[cx].rgbtBlue := b;
              Row2[cx].rgbtGreen := g;
              Row2[cx].rgbtRed := r;
            end;
          end;
        end;
        DC.CopyRect(Rectangle, Canvas, CurRect);
      end;
    finally
      TEMP.Free;
    end;
  end;

begin
  Antialiasing(Digilabel.Canvas,Digilabel.BoundsRect);
end;

[dizzy]

Jpeg macht sicherlich kein Blur. Das soll heissen, dass du den "goilen Effekt" kaum darüber reproduzieren können wirst. (->jpeg)
Wesentlich dafür, dass das Bild da so aussieht ist, dass der Hintergrund und Text sehr farb-/intensitätsähnlich sind.

[padavan]

Hallo Dizzy,

das jpg sah nach dem Konvertieren nur so aus, wie ich meine Komponente gerne hätte (nämlich echt goil).
Schon klar, dass mich jpg nicht weiterbringt.

Falls ich dich dahingehend falsch verstanden haben sollte, nur zur Klarstellung,
ich habe kein jpg, was ich anpacken will, sondern "hart" gemalte Pixels auf der Paintbox....

Das mit dem Glätten funktioniert sogar schon ganz gut, leider nur die erste Variante.
Und die ist wirklich grottenlangsam.
Falls jemand die zweite Variante mal testen könnte, wäre echt nett, denn ich weiß nicht,
was ich da falsch mache.

[padavan]

Guten Morgen,

also noch mal zu diesem Thema.

Mit folgendem Code, habe ich das was ich ursprünglich wollte auch hinbekommen:

Delphi-Quellcode:

  procedure Antialiasing(const DC: TCanvas; const Rectangle: TRect; wiederhol: integer);

  type
    TRGBTripleArray = array[0..32768] of TRGBTriple;
    // 32768 = maximale Anzahl der Pixel in der Breite eines Bildes (also eine "ScanLine")
    pRGBTripleArray = ^TRGBTripleArray; // Pointer auf TRGBTripleArray

  var
    cx, cy: Smallint;
    r, g, b: Byte;
    Row1: pRGBTripleArray;
    Row2: pRGBTripleArray;
    Row3: pRGBTripleArray;
    TEMP: TBitmap;
    CurRect: TRect;

    i: shortint;
  begin
    TEMP := TBitmap.Create;
    try

      for i := 0 to wiederhol do
      begin
        with TEMP do begin
          Width := Rectangle.Right - Rectangle.Left;
          Height := Rectangle.Bottom - Rectangle.Top;
          CurRect := Rect(0, 0, Width, Height);
          PixelFormat := pf24Bit;
          Canvas.CopyRect(CurRect, DC, Rectangle);
          with Canvas do begin
            for cy := 1 to (Height - 2) do begin
              Row1 := ScanLine[cy - 1];
              Row2 := ScanLine[cy];
              Row3 := ScanLine[cy + 1];

              for cx := 1 to (Width - 2) do begin
                r := (Row1[cx - 1].rgbtRed+Row1[cx].rgbtRed+
                Row1[cx + 1].rgbtRed+
                Row2[cx - 1].rgbtRed+
                Row2[cx + 1].rgbtRed+
                Row2[cx - 1].rgbtRed+
                Row3[cx].rgbtRed+
                Row3[cx + 1].rgbtRed+
                Row3[cx].rgbtRed) div 9;

                g := (Row1[cx - 1].rgbtGreen+
                Row1[cx].rgbtGreen+
                Row1[cx + 1].rgbtGreen+
                Row2[cx - 1].rgbtGreen+
                Row2[cx + 1].rgbtGreen+
                Row2[cx - 1].rgbtGreen+
                Row3[cx].rgbtGreen+
                Row3[cx + 1].rgbtGreen+
                Row3[cx].rgbtGreen) div 9;

                b := (Row1[cx - 1].rgbtBlue+
                Row1[cx].rgbtBlue+
                Row1[cx + 1].rgbtBlue+
                Row2[cx - 1].rgbtBlue+
                Row2[cx + 1].rgbtBlue+
                Row2[cx - 1].rgbtBlue+
                Row3[cx].rgbtBlue+
                Row3[cx + 1].rgbtBlue+
                Row3[cx].rgbtBlue) div 9;
                Row2[cx].rgbtBlue := b;
                Row2[cx].rgbtGreen := g;
                Row2[cx].rgbtRed := r;
              end;
            end;
          end;
          DC.CopyRect(Rectangle, Canvas, CurRect);
        end;
      end;
    finally
      TEMP.Free;
    end;
  end;

Der Aufruf dazu:

Delphi-Quellcode:

    Antialiasing(Form1.canvas, Digilabel.BoundsRect, 1);

wobei Digilabel natürlich meine Anzeige Komponente ist.

Nun habe ich das ja quasi in meinem Projekt umgesetzt, das ist aber doof, ordentlicher wäre ja,
das die Komponente selbst die Eigenschaft schon mitbringt.
Ich habe die Eigenschaft mal "smooth" genannt.
Wird ein Wert für smooth größer 0 angegeben, so soll die Eigenschaft ziehen.

So sieht das nun in der Komponente aus:

Delphi-Quellcode:

//dto. wie oben

allerdings am Aufruf haperts:

Delphi-Quellcode:

    Antialiasing(Form1.canvas, self.BoundsRect, 1);

denn hier habe ich ja nun keine Form1.
Habe es also so versucht, aber ohne Erfolg:

Delphi-Quellcode:

    Antialiasing(self.canvas, self.BoundsRect, 1);

Kann mir jemand sagen, wie ich das in Griff bekomme.

So ein Verzweiflungsversuch habe ich auchschon gestartet:

Delphi-Quellcode:

  Antialiasing(Parent.Brush.Create.Bitmap.Canvas, Digilabel.BoundsRect, 1);

Hüüüüüüülfeeee!!!
:gruebel: :wall:



Edit:

das Problem ist übrigens nicht, dass was abstürzt, oder es eine Exception gäbe,
nein, es funktioniert halt nicht mit

Delphi-Quellcode:

Antialiasing(self.canvas, self.BoundsRect, 1);

[padavan]

hat sich erledigt,
hab´s hinbekommen, obwohl das mehr Glücksache war...

Delphi-Quellcode:

    Antialiasing(application.MainForm.Canvas, self.BoundsRect, smooth);  // smooth z.B. "1"

Grüße ans Team
Padavan