AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Algorithmen, Datenstrukturen und Klassendesign Delphi x Bilder einheitlich skaliert auf drittes Bild zeichen

x Bilder einheitlich skaliert auf drittes Bild zeichen

Ein Thema von QStorm · begonnen am 19. Apr 2013 · letzter Beitrag vom 23. Apr 2013
 
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.
Angehängte Grafiken
Dateityp: png DivGraph.png (29,7 KB, 26x aufgerufen)
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
 

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 08:07 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz