Einzelnen Beitrag anzeigen

Benutzerbild von Bummi
Bummi

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

AW: x Bilder einheitlich skaliert auf drittes Bild zeichen

  Alt 19. Apr 2013, 13:09
Um das ganze in guter Qualität hinzubekommen könntest Du auf GDI+ zurückgreifen,da Du aber nichts externes wolltest und TImage vermeiden willst, hätte ich folgendes anzubieten.
Delphi-Quellcode:
unit Demop;

interface

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

type
  ENotImplemeted=Class(Exception);

  TForm3 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

uses Math, pngImage, GifImg,jpeg;

Procedure SetCanvasZoomAndRotation(ACanvas: TCanvas; Zoom: Double; Angle: Double; CenterpointX, CenterpointY: Double);
var
  form: tagXFORM;
  Winkel: Double;

begin
  Winkel := DegToRad(Angle);
  SetGraphicsMode(ACanvas.Handle, GM_ADVANCED);
  SetMapMode(ACanvas.Handle, MM_ANISOTROPIC);
  form.eM11 := Zoom * cos(Winkel);
  form.eM12 := Zoom * Sin(Winkel);
  form.eM21 := Zoom * (-Sin(Winkel));
  form.eM22 := Zoom * cos(Winkel);
  form.eDx := CenterpointX;
  form.eDy := CenterpointY;
  SetWorldTransform(ACanvas.Handle, form);
end;

Procedure LoadAndPaint(FileName: String; C: TCanvas; x, y, BH: Integer;BitMapTransparent:Boolean=false);
var
  G: TGraphic;
  SC: Integer;
begin
  if UpperCase(ExtractFileExt(FileName)) = '.PNGthen
    G := TPngImage.Create
  else if UpperCase(ExtractFileExt(FileName)) = '.BMPthen
    begin
      G := TBitMap.Create;
      if BitMapTransparent then TBitMap(G).Transparent := true;
    end
  else if UpperCase(ExtractFileExt(FileName)) = '.GIFthen
    G := TGifImage.Create
  else if (UpperCase(ExtractFileExt(FileName)) = '.JPG') or (UpperCase(ExtractFileExt(FileName)) = '.JPEG') then
    G := TJpegImage.Create
  else raise ENotImplemeted.Create('Nicht berücksichtigtes Dateiformat');

  try
    G.LoadFromFile(FileName);
    SC := G.Width;
    if G.Height > G.Width then
      SC := G.Height;
    SetCanvasZoomAndRotation(C, BH / SC, 0, x, y);
    C.Draw(0, 0, G);
    SetCanvasZoomAndRotation(C , 1, 0, 0,0);
  finally
    G.Free;
  end;
end;

procedure TForm3.Button1Click(Sender: TObject);
Const
  C_Raster = 40;
var
  x, y: Integer;
  Path: String;
begin
  Path := IncludeTrailingBackSlash(ExtractFilePath(Paramstr(0)));
  x := 0;
  y := 0;
  LoadAndPaint(Path + '01.png', Canvas, x, y, C_Raster);
  Inc(x, C_Raster);
  LoadAndPaint(Path + '02.png', Canvas, x, y, C_Raster);
  Inc(x, C_Raster);
  LoadAndPaint(Path + '01.bmp', Canvas, x, y, C_Raster);
  Inc(y, C_Raster);
  Inc(x, C_Raster);
  LoadAndPaint(Path + '01.gif', Canvas, x, y, C_Raster);
  Inc(y, C_Raster);
  Inc(x, C_Raster);
  LoadAndPaint(Path + 'bbok.bmp', Canvas, x, y, C_Raster,true);

end;

end.
Miniaturansicht angehängter Grafiken
divgraph.png  
Angehängte Dateien
Dateityp: zip PaintDiv.zip (124,4 KB, 11x aufgerufen)
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