Ein Bild als Kugel darstellen

[SirThornberry]

Hallo,

ich hab vor einem Bild einen Kugeleffekt zu verleigen. Also so als würde man ein Bild um eine Kugel wickeln. Leider weiß ich überhaupt nicht wo ich ansetzen soll oder wo ich eventuell schon eine fertige Lösung finde.

[chaosben]

Hi ho!

So aus dem Hut würde ich sagen: Nimm dir eine 3D-Engine, kreiere eine Kugel und leg dein Bild als Textur darauf.
Ja, das ist schnell in einem Satz gesagt, aber wahrscheinlich eine Heidenarbeit.

*such*

Falls es keine ganze Kugel sein muss, kanst du ja auch mal die Hemesphere-Buttons probieren (bzw. Sourcen ansehen). Screenshots von den Demos anbei.

[tigerman33]

Hallo,

solche Abbildungen schreien normalerweise direkt nach Matrizen. Dann bleibt natürlich nur noch, die richtige Matrix zu finden...

Ich würde empfehlen mal nach "Fischauge" zu suchen. Da müsste sich sicherlich was finden lassen. Interessiert mich jetzt auch--ich glaub da werd ich heute nachmittag mal direkt googlen.

Muss jetzt aber los...Vorlesung

[MisterNiceGuy]

Willst du denn als Ausgabe eine 3D-Animation erhalten oder einfach ein 2D-Bild?

[SirThornberry]

erstmal will ich ein 2D bild erhalten. Ob das später eine Animation werden soll würde ich erstmal verneinen, aber nicht generell ausschließen. Vorerst geht es mir erstmal nur darum mehrere Kugelbilder zu erzeugen und auf einem anderen Bild zusammen zu setzen.
Werd auch mal nach Fischauge suchen, vielleicht findet sich da was.
Hab auch schon bischen rumprobiert mit Sinus/Cosinus zeugs um einen Kreis zu erhalten und die Werte dann zu verwenden für den Schatten bzw. wie weit zu stretchen ist. (Also je mehr der Halbkreis auf der X-Achse ausschlägt destso weniger Schatten etc.)

[turboPASCAL]

Also ich habe da einen Sourcecode der das einen Lupeneffekt berechnet.
Kann aber den Uhrheberlink nicht mehr finden. (..doch ist in der Readme)
Eigentlich ist das nur ein Eeffekt, wenn man mit den Parameter ein wenig
spiel kommt man schon hin.

Oder suchst du die exakte Vohrgehensweise om das Bild auf eine Kugel zu rechnen ?

[SirThornberry]

na toll, jetzt hab ich mir den halben Tag den Kopf zerbrochen und rumprobiert und auch soweit das ganze hinbekommen (siehe beispielprojekt im Anhang). Ist ist zwar nicht ganz eine Kugel aber die Darstellung als hätte man einen Globus (genau das wollte ich eigentlich hinn bekommen).
Bin jetzt eigentlich so weit das ich nur noch die Schatteneffekte hinzu fügen muss.

@turboPASCAL: eigentlich stimmt der Effekt schon. Wenn man bei dem Teil was vom auto am höchsten absteht, die lupe leicht hin und her bewegt ist das schon der rotierende effekt einer kugel. Die kugel kommt ja dadurch zu stande das der Teile der zentral liegt normal-groß ist (bzw. vergrößert) und je weiter es dem rand zu geht destso kleiner (nach hinten verzerrt) wird es.

[turboPASCAL]

Ha, das ist ja toll. Kann ich den Soursecode mal bekommen ?
So ein Programm, da juckt mich immer in den Fingern...

Zitat:

@turboPASCAL: eigentlich stimmt der Effekt schon. Wenn man bei [...]

Desswegen dachte ich er könnte dir behilflich sein...

[SirThornberry]

Vorab kann ich schon sagen das es nicht so elegant gelöst ist wie in deinem Beispiel da bei mir nur auf der X-Achse gestretcht wird (das auskommentierte wäre die Variante nur auf der Y-Achse zu stretchen). Ich werde wohl versuchen das von dir gepostete so abzuwandeln das "pixels" weg fällt (dazu gibts ja pointer so das nicht ständig nen changed ausgelöst wird).

Den Sourcecode einzeln zu posten ist bissl schwer (da bissl verteilt), deswegen gleich mein ganzes Object als Unit:

Delphi-Quellcode:

unit uKugelPicObj;

interface

uses
  windows, graphics;

type
  TKugelPicObj = class(TObject)
  private
    fPicOrigin: TBitmap;
    fPicStretched: TBitmap;
    fPicTmp      : TBitmap;
    fBallSize    : DWord;
    fRotationX   : Extended;
    fSizes       : Array of DWord;
    procedure FCalcNewSize;
    procedure FOnPicChanged(Sender: TObject);
    procedure FRefreshStretchedPic;
    procedure FRefreshTmpPic;
    procedure FSetPicture(APic: TBitmap);
    procedure FSetRotation(AType: Integer; ARotation: Extended);
    procedure FSetSize(ASize: DWord);
  public
    constructor Create;
    destructor Destroy; override;

    property Picture: TBitmap read fPicOrigin write FSetPicture;
    property RotationX: Extended Index 0 read fRotationX write FSetRotation;
    property Size: DWord read fBallSize write FSetSize;

    function DrawBall(ADst: TBitmap): Boolean;
  end;

implementation

{==============================================================================}

constructor TKugelPicObj.Create;
begin
  inherited Create;
  fBallSize           := 100;
  fPicOrigin          := TBitmap.Create;
  fPicOrigin.OnChange := FOnPicChanged;
  fPicStretched       := TBitmap.Create;
  fPicTmp             := TBitmap.Create;
  fRotationX          := 0;
  FCalcNewSize;
end;

{==============================================================================}

destructor TKugelPicObj.Destroy;
begin
  fPicTmp.Free;
  fPicStretched.Free;
  fPicOrigin.Free;
  inherited Destroy;
end;

{==============================================================================}

function TKugelPicObj.DrawBall(ADst: TBitmap): Boolean;
var LCount,
    LPosition: Integer;
    LSize    : DWord;
begin
  if (fPicOrigin.Width > 0) and (fPicOrigin.Height > 0) then
  begin
    ADst.Width := fBallSize;
    ADst.Height := fBallSize;
    SetStretchBltMode(ADst.Canvas.Handle, STRETCH_HALFTONE);
    SetBrushOrgEx(ADst.Canvas.Handle, 0, 0, nil);

    for LCount := 0 to fBallSize - 1 do
    begin
      LSize := fSizes[LCount];
      LPosition := (fBallSize - LSize) div 2;

      //StretchBlt(ADst.Canvas.Handle, LCount, LPosition, 1, LSize,
      //           fPicTmp.Canvas.Handle, LCount, 0, 1, fPicTmp.Height, SRCCOPY);

      StretchBlt(ADst.Canvas.Handle, LPosition, LCount, LSize, 1,
                 fPicTmp.Canvas.Handle, 0, LCount, fPicTmp.Width, 1, SRCCOPY);
    end;
    result := True;
  end else
    result := False;
end;

{==============================================================================}

procedure TKugelPicObj.FCalcNewSize;
var LCount,
    LHalfBallSize: Integer;
begin
  LHalfBallSize := Trunc(fBallSize / 2);
  SetLength(fSizes, fBallSize);
  for LCount := 0 to fBallSize - 1 do
  begin
    if (LCount > LHalfBallSize) then
      fSizes[LCount] := Round(Sqrt(Sqr(LHalfBallSize) - Sqr(LCount - LHalfBallSize))) * 2
    else
      fSizes[LCount] := Round(Sqrt(Sqr(LHalfBallSize) - Sqr(LHalfBallSize - LCount))) * 2;
  end;
  FRefreshStretchedPic;
end;

{==============================================================================}

procedure TKugelPicObj.FOnPicChanged(Sender: TObject);
begin
  FRefreshStretchedPic;
end;

{==============================================================================}

procedure TKugelPicObj.FRefreshStretchedPic;
begin
  if (fPicOrigin.Width = 0) or (fPicOrigin.Height = 0) then
    fPicStretched.Assign(fPicOrigin)
  else begin
    fPicStretched.Width  := fBallSize;
    fPicStretched.Height := fBallSize;
    SetStretchBltMode(fPicStretched.Canvas.Handle, STRETCH_HALFTONE);
    SetBrushOrgEx(fPicStretched.Canvas.Handle, 0, 0, nil);
    StretchBlt(fPicStretched.Canvas.Handle, 0, 0, fBallSize, fBallSize,
               fPicOrigin.Canvas.Handle, 0, 0, fPicOrigin.Width, fPicOrigin.Height, SRCCOPY);
  end;
  FRefreshTmpPic;
end;

{==============================================================================}

procedure TKugelPicObj.FRefreshTmpPic;
var LLeft: Integer;
begin
  if (fPicStretched.Width > 0) and (fPicStretched.Height > 0) then
  begin
    fPicTmp.Width  := fPicStretched.Width;
    fPicTmp.Height := fPicStretched.Height;

    LLeft := Round((fPicTmp.Width) / 360 * fRotationX);

    BitBlt(fPicTmp.Canvas.Handle, 0, 0, fPicTmp.Width - LLeft, fPicTmp.Height,
           fPicStretched.Canvas.Handle, LLeft, 0, SRCCOPY);

    BitBlt(fPicTmp.Canvas.Handle, fPicTmp.Width - LLeft, 0, fPicTmp.Width, fPicTmp.Height,
           fPicStretched.Canvas.Handle, 0, 0, SRCCOPY);
  end;
end;

{==============================================================================}

procedure TKugelPicObj.FSetPicture(APic: TBitmap);
begin
  if (APic <> fPicOrigin) then
  begin
    if (APic = nil) then
    begin
      fPicOrigin.Width  := 0;
      fPicOrigin.Height := 0;
    end else
      fPicOrigin.Assign(APic);
  end;
end;

{==============================================================================}

procedure TKugelPicObj.FSetRotation(AType: Integer; ARotation: Extended);
  procedure LSetVal(var ACurrVal: Extended);
  begin
    if ARotation <> ACurrVal then
    begin
      while (ARotation >= 360) do
        ARotation := ARotation - 360;
      while (ARotation < 0) do
        ARotation := ARotation + 360;
      ACurrVal := ARotation;
      FRefreshTmpPic;
    end;
  end;
begin
  case AType of
    0: LSetVal(fRotationX);
  end;
end;

{==============================================================================}

procedure TKugelPicObj.FSetSize(ASize: DWord);
begin
  if ASize < 1 then
    ASize := 1;
  if ASize <> fBallSize then
  begin
    fBallSize := ASize;
    FCalcNewSize;
  end;
end;

{==============================================================================}

end.

Das mit den jucken in den Fingern kenn ich. Denn das ganze mit dem Kugel brauch ich nicht wirklich, bin nur auf die Idee gekommen als ich gestern das Sterne-Projekt gesehen hab und dann den Screensaver von Galileo wo auch planeten ihre Bahnen ziehen). War also nen reines fingerjuck-projekt

[turboPASCAL]

Jupp, ich guck mir halt gern solch einen Code an um die Herangehensweise zu untersuchen wie ein Probleb gelöst wurden ist. Solche Berechnungen sind immer sehr interessant, auch wenn ich nicht immer alles Verstehe. Gucken kostet ja nix und lernen kann man immer.