AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Multimedia Delphi Kann man die Qualität von TImage verbessern?

Kann man die Qualität von TImage verbessern?

Ein Thema von Popov · begonnen am 11. Sep 2012 · letzter Beitrag vom 12. Sep 2012
Antwort Antwort
Popov
(Gast)

n/a Beiträge
 
#1

Kann man die Qualität von TImage verbessern?

  Alt 11. Sep 2012, 16:59
Nur eine kurze Frage, und zwar interessiert es mich ob man die Qualität des TImage beim skalieren verbessern/ändern kann. Bekanntlich wird hier "hart" skaliert. Mich interessieren an der Stelle keine anderen Komponente oder Quellcode um es selbst zu machen. Um das geht es hier nicht.

Mich interessiert es nur ob man durch Tricks die Skalier-Art des TImage ändern kann.
  Mit Zitat antworten Zitat
Benutzerbild von DeddyH
DeddyH

Registriert seit: 17. Sep 2006
Ort: Barchfeld
27.568 Beiträge
 
Delphi 12 Athens
 
#2

AW: Kann man die Qualität von TImage verbessern?

  Alt 11. Sep 2012, 17:02
Kann man, siehe MSDN-Library durchsuchenSetStretchBltMode.
Detlef
"Ich habe Angst vor dem Tag, an dem die Technologie unsere menschlichen Interaktionen übertrumpft. Die Welt wird eine Generation von Idioten bekommen." (Albert Einstein)
Dieser Tag ist längst gekommen
  Mit Zitat antworten Zitat
Popov
(Gast)

n/a Beiträge
 
#3

AW: Kann man die Qualität von TImage verbessern?

  Alt 11. Sep 2012, 17:30
Kann es gerade nicht testen.

SetStretchBltMode kenne ich, nur wußte ich nicht, dass es auch bei TImage funktioniert.
  Mit Zitat antworten Zitat
Benutzerbild von DeddyH
DeddyH

Registriert seit: 17. Sep 2006
Ort: Barchfeld
27.568 Beiträge
 
Delphi 12 Athens
 
#4

AW: Kann man die Qualität von TImage verbessern?

  Alt 11. Sep 2012, 17:54
Naja, nicht direkt im TImage, aber man kann es auf die enthaltene Grafik anwenden. Wobei es natürlich schöner wäre, wenn es eine entsprechende Property gäbe, aber so eine ist mir auch nicht bekant.
Detlef
"Ich habe Angst vor dem Tag, an dem die Technologie unsere menschlichen Interaktionen übertrumpft. Die Welt wird eine Generation von Idioten bekommen." (Albert Einstein)
Dieser Tag ist längst gekommen
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#5

AW: Kann man die Qualität von TImage verbessern?

  Alt 11. Sep 2012, 18:57
TImage ist doch nur ein Container um Grafiken anzuzeigen. Die Qualität hängt von den Grafiken ab, Auflösung, Format (BMP, JPEG, ...), Größe...
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Benutzerbild von Bummi
Bummi

Registriert seit: 15. Jun 2010
Ort: Augsburg Bayern Süddeutschland
3.470 Beiträge
 
Delphi XE3 Enterprise
 
#6

AW: Kann man die Qualität von TImage verbessern?

  Alt 11. Sep 2012, 19:56
Ich habe hier noch einen alten Fetzen Code rumliegen, müsste umgebaut (TBitmap statt TImage und nicht aus/in Datei etc.) und resourcensicher gemacht werden, skaliert aber sehr sauber ... benötigt GDI+
Delphi-Quellcode:
{-----------------------------------------------------------------------------
  Procedure: ScaleOneImage
  Author:    Thomas Wassermann
  Date:      21-Nov-2006
  Arguments: Const source,dest:String;DestWidth,DestHeight:Integer
  Result:    None
  Remarks:  None
-----------------------------------------------------------------------------}

Procedure ScaleOneImage(Const source,dest:String;DestWidth,DestHeight:Integer;Qual:Integer=92;WithOutMargins:Boolean=false;BgColor:TColor=ClWhite;DoNotUpScale:Boolean=false);
var
  HDCImage:TImage;
  graphics : TGPGraphics;
  image: TGPImage;
  width, height: UINT;
  faktor:Double;
  destx,desty:Double;
  rct:TGPRectF;
  Ext:String;
begin

  Ext := UpperCase(StringReplace(ExtractFileExt(dest),'.','',[]));
  image:= TGPImage.Create(source);
  width := image.GetWidth;
  height := image.GetHeight;


  if ((width=DestWidth) and (height=DestHeight)) or (DoNotUpScale and ((width<=DestWidth) and (height<=DestHeight))) then
    begin
       image.Free;
       CopyFile(Pchar(Source),PChar(Dest),false);
    end
else
    begin
        if (DestWidth / width) < (DestHeight/Height) then faktor := (DestWidth / width) else faktor:= (DestHeight/Height);
        HDCImage:=TImage.Create(nil);
        if WithOutMargins then
          begin
          HDCImage.Width := Trunc(faktor * width);
          HDCImage.Height := Trunc(faktor * height);
          destx := 0;
          desty := 0;
          end
        else
          begin
          HDCImage.Width:=DestWidth;
          HDCImage.Height:=DestHeight;
          destx := (DestWidth - faktor * width) / 2;
          desty := (DestHeight - faktor * Height) / 2
          end;
        if BgColor<>clWhite then
          begin
            HDCImage.Canvas.Brush.Color:=BgColor;
            HDCImage.Canvas.Fillrect(Rect(0,0,HDCImage.Width,HDCImage.Height));
          end;
        graphics := TGPGraphics.Create(HDCImage.Canvas.Handle);
        graphics.SetInterpolationMode(InterpolationModeHighQualityBicubic);
        {
        rct.x :=  destx ;
        rct.Y :=  desty * 1.0;
        rct.Width := faktor * width;
        rct.Height  := faktor * height;
        graphics.SetClip(rct);
        }

        graphics.DrawImage(
          image,
          MakeRect(destx, desty , faktor * width, faktor * height), // destination rectangle
          0, 0, // upper-left corner of source rectangle
          width, // width of source rectangle
          height, // height of source rectangle
          UnitPixel);
        image.Free;
        HDCImage.invalidate;
        if ext = 'BMPthen HDCImage.Picture.Bitmap.SaveToFile(dest)
        else SaveBMPasJPG(dest,HDCImage.Picture.Bitmap,qual);
        graphics.Free;
        HDCImage.Free;
    end;

end;
Thomas Wassermann H₂♂
Das Problem steckt meistens zwischen den Ohren
DRY DRY KISS
H₂ (wenn bei meinen Snipplets nichts anderes angegeben ist Lizenz: WTFPL)
  Mit Zitat antworten Zitat
Popov
(Gast)

n/a Beiträge
 
#7

AW: Kann man die Qualität von TImage verbessern?

  Alt 12. Sep 2012, 20:17
TImage ist doch nur ein Container um Grafiken anzuzeigen. Die Qualität hängt von den Grafiken ab, Auflösung, Format (BMP, JPEG, ...), Größe...
Ich meine nicht die Qualität der Grafik selbst oder allgemein des TImage, sondern der Eigenschaft Scale bei TImage. Ist sie True, wird die Grafik bei Resize der Komponente automatisch angepaßt. Nur ist die Qualität dabei nicht so besonders gut. In der Regel kompensiere ich das über eine separate Routine. Nur betrachte ich es auf die Dauer als lästig. Scale von TImage ist ja praktisch, nur die Qualität ist bescheiden. Ich hoffte es gibt einen Trick.

@Bummi

Danke für den Code, nur geht es um TImage. Aber trotz dem danke für den Code. In der nächsten Zeit fange ich ein Grafikprojekt an, dann wird sich zuerst GDI+ ausführlich gangeguckt.
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.519 Beiträge
 
Delphi 12 Athens
 
#8

AW: Kann man die Qualität von TImage verbessern?

  Alt 12. Sep 2012, 20:26
Natürlich könnte man versuchen da etwas zu machen.

Du mußt nur rausbekommen wie/wo TImage zeichnet und dann ersetzt du den Code, welcher diese Skalierung nicht so schön übernimmt.
> Komponente ableiten und den besseren Code einbauen, welche dann das Zeichnen übernimmt.

procedure Paint; override;
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests

Geändert von himitsu (12. Sep 2012 um 20:30 Uhr)
  Mit Zitat antworten Zitat
Medium

Registriert seit: 23. Jan 2008
3.679 Beiträge
 
Delphi 2007 Enterprise
 
#9

AW: Kann man die Qualität von TImage verbessern?

  Alt 12. Sep 2012, 21:18
@GDI+: Wenn du schon eine neue API lernst, dann würde ich was aktuelleres nehmen. Zumindest für neue Projekte, wo man nicht an 1001 Stellen ändern müsste. Ein großer Nachteil von GDI+ ist, dass es z.B. spätestens ab Win7 (unter Aero) nicht mehr hardwarebeschleunigt wird. Ich habe die genaue Quelle nicht mehr, aber in den Tiefen des MSDN war auch seitens MS die Empfehlung statt auf (das quasi deprecated) GDI+ besser auf Direct2D zu setzen.
Will man das nicht, so stellt auch die Bei Google suchenGraphics32 eine immens mächtige (und flotte) Alternative dar, die sogar mit fix und fertigen VCL Kompos daher kommt. Nachteil: Es ist "nur" eine Lib, kein OS-Feature, und da wird wohl ausser hier und da etwas Handassembliertes MMX/SSE auch keine Beschleunigung verwendet. (Es ist aber in sich schon vergleichsweise zügig.)
"When one person suffers from a delusion, it is called insanity. When a million people suffer from a delusion, it is called religion." (Richard Dawkins)
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.519 Beiträge
 
Delphi 12 Athens
 
#10

AW: Kann man die Qualität von TImage verbessern?

  Alt 12. Sep 2012, 22:42
Wenn ich's richtig gesehn hab, dann sind das vermutlich die kombinierten Codes für D7 bis XE3.
Delphi-Quellcode:
unit Unit11;

interface

uses
  {$IF CompilerVersion >= 22}
  Winapi.Windows, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.ExtCtrls, Winapi.UxTheme;
  {$ELSE}
  Windows, Classes, Graphics, Controls, ExtCtrls, UxTheme;
  {$IFEND}

type
  TImage2 = class(TImage)
  protected
    procedure Paint; override;
  end;
  TGraphicControlHack = class(TGraphicControl);

procedure register;

implementation

procedure register;
begin
  RegisterComponents('Zusätzlich', [TImage2]);
end;

procedure TImage2.Paint;
var
  DrawingCanvas: TCanvas;
  BlockDrawing: PBoolean;
  Save: Boolean;
  {$IF CompilerVersion > 15} // über D7
  PaintOnGlass: Boolean;
  MemDC: HDC;
  Rect: TRect;
  PaintBuffer: HPAINTBUFFER;
  {$IF CompilerVersion <= 18} // bis D2007
  LForm: TCustomForm;
  {$IFEND}
  {$IFEND}
begin
  DrawingCanvas := TGraphicControlHack(Self).Canvas; // (inherited Canvas) , allerdings von der vor-vorherigen Klasse, denn TImage hat dieses Anzeige-Canvas verdeckt und enthält nun das Zugriffs-Canvas auf das interne Bild
  BlockDrawing := PBoolean(PByte(@Transparent) + 1); // private FDrawing
  if csDesigning in ComponentState then
  begin
    DrawingCanvas.Pen.Style := psDash;
    DrawingCanvas.Brush.Style := bsClear;
    DrawingCanvas.Rectangle(0, 0, Width, Height);
  end;
  Save := BlockDrawing^;
  BlockDrawing^ := True;
  try
    {$IF CompilerVersion > 15}
    {$IF CompilerVersion <= 18}
    PaintOnGlass := DwmCompositionEnabled and not (csDesigning in ComponentState);
    if PaintOnGlass then
    begin
      LForm := GetParentForm(Self);
      PaintOnGlass := (LForm <> nil) and LForm.GlassFrame.FrameExtended and LForm.GlassFrame.IntersectsControl(Self);
    end;
    {$ELSE}
    PaintOnGlass := (csGlassPaint in ControlState) and (Picture.Graphic <> nil)
      and not Picture.Graphic.SupportsPartialTransparency;
    {$IFEND}
    if PaintOnGlass then
    begin
      Rect := DestRect;
      PaintBuffer := BeginBufferedPaint(DrawingCanvas.Handle, Rect, BPBF_TOPDOWNDIB, nil, MemDC);
      try
        DrawingCanvas.Handle := MemDC;
        DrawingCanvas.StretchDraw(DestRect, Picture.Graphic);
        BufferedPaintMakeOpaque(PaintBuffer, {$IF CompilerVersion <= 18}@{$IFEND}Rect);
      finally
        EndBufferedPaint(PaintBuffer, True);
      end;
    end
    else
    {$IFEND}
    begin
      DrawingCanvas.StretchDraw(DestRect, Picture.Graphic);
    end;
  finally
    BlockDrawing^ := Save;
  end;
end;

end.
Jetzt muß nur noch jemand die beiden DrawingCanvas.StretchDraw(DestRect, Picture.Graphic); ersetzen
und Testen ob es wirklich funktioniert.
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 11:09 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz