Kirjautuminen

Haku

Tehtävät

Keskustelu: Koodit: Pascal: Aaltoileva kuva

zacura [07.07.2004 11:03:28]

#

Perinteinen tehoste jossa kuva näyttä heijastuvan aaltoilevan veden pinnasta. Esittelee miten bittikarttaan voi piirtää nopeasti käyttämällä ScanLine ominaisuutta.

Binary: http://koti.mbnet.fi/~tommyr/files/aalto.zip (210 kt)

*** _main.dfm
object Form1: TForm1
  Left = 192
  Top = 107
  Width = 783
  Height = 540
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Image1: TImage
    Left = 8
    Top = 40
    Width = 375
    Height = 198
    AutoSize = True
  end
  object Button1: TButton
    Left = 8
    Top = 8
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Timer1: TTimer
    Enabled = False
    Interval = 100
    OnTimer = Timer1Timer
    Left = 88
    Top = 8
  end
  object OpenDialog1: TOpenDialog
    Left = 120
    Top = 8
  end
end
*** _main.pas
unit _main;

interface

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

const
  STRENGTH_X = 2.50;
  STRENGTH_Y = 2.50;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Timer1: TTimer;
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    procedure Wave;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  phase: Double;

implementation

{$R *.dfm}

procedure TForm1.Wave;
var
  pix_s,pix_t: PByteArray;
  x,y,nx,ny: Integer;
  buffer: TBitmap;
begin
  // Luodaan piirtopuskuri
  buffer := TBitmap.Create;
  with Image1.Picture.Bitmap do
  begin
    // Asetetaan puskurin ominaisuudet
    buffer.Width := Width;
    buffer.Height := Height;
    buffer.PixelFormat := pf24bit;
    for y := 0 to Height-1 do
    begin
      // Pointteri puskuriin
      pix_t := buffer.ScanLine[y];
      for x := 0 to Width-1 do
      begin
        // Lasketaan uudet koordinaatit
        nx := (Round(x+STRENGTH_X*sin((x+y)/5+phase))+Width) mod Width;
        ny := (Round(y+STRENGTH_Y*cos((x+y)/5+phase))+Height) mod Height;
        // Pointteri alkuperäiseen kuvaan;
        pix_s := ScanLine[Height-ny-1];

        // Piirretään pixeli
        pix_t[x*3] := pix_s[nx*3];              //Sininen
        pix_t[x*3+1] := pix_s[nx*3+1];          //Vihreä
        pix_t[x*3+2] := pix_s[nx*3+2];          //Punainen

      end;
    end;
    // Blitataan puskuri formille
    BitBlt(Form1.Canvas.Handle,Image1.Left,Image1.Top+Image1.Height,Width,Height,buffer.Canvas.Handle,0,0,SRCCOPY);
  end;
  buffer.Free;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 Wave;
 // Siirretään aaltoja
 phase := phase+0.5;
 if phase > 2*Pi then phase := phase-2*Pi;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 if OpenDialog1.Execute then
   if UpperCase(ExtractFileExt(OpenDialog1.FileName)) = '.BMP' then
   begin
     Image1.Picture.LoadFromFile(OpenDialog1.FileName);
     // Varmistetaan että kuva on 24 bittinen
     Image1.Picture.Bitmap.PixelFormat := pf24bit;
     Timer1.Enabled := True;
   end
   else
     MessageDlg('Valitse BMP-tiedosto', mtError, [mbOk], 0);
end;

end.

rndprogy [07.07.2004 20:41:59]

#

Ei tuo exe ainakaan näytä aaltoilevan. Latasin siihen bmp kuvan vai pitääkö jotain muuta vielä tehdä?

Antti Laaksonen [07.07.2004 21:02:30]

#

Ohjelma näyttää kaksi kuvaa: alkuperäisen ja sen alapuolella aaltoilevan. Jos lataamasi kuva on iso, alempi kuva ei välttämättä näy ikkunan kokoa suurentamatta.

rndprogy [07.07.2004 21:08:52]

#

Oli tosiaan liian iso kuva. Nyt näkyy.

sooda [08.07.2004 14:29:47]

#

Kaunis efekti.

zigilii [11.07.2004 12:23:48]

#

Todella hieno!

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Tietoa sivustosta