Kann man die Qualität von TImage verbessern?

[himitsu]

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.