OPAQUE - Áttetsző képek

Top  Previous  Next

 

Opaque

 

(* s1,s2 bitmap-ek áttetsző kombinálása %-os arányban:

  Ha Percent=0, akkor az első bmp nem látszik, ha 50, akkor fele-fel, 100-nál

  csak az első bmp látszik *)

 

Procedure Opaque(sBMP1,sBMP2 :TBitmap; destBMP :TBitmap; Percent: integer);

var

scl1,scl2,dscl:^Byte;

y,x: integer;

w,h: integer;

begin

sBMP1.pixelformat:=pf24bit;

sBMP2.pixelformat:=pf24bit;

destBMP.pixelformat:=pf24bit;

w:=Min(sBMP1.Width,sBMP2.Width);

h:=Min(sBMP1.Height,sBMP2.Height);

if destBMP.Width<w then destBMP.Width:=w;

if destBMP.Height<h then destBMP.Height:=h;

for y:=0 to h-1 do begin

   scl1:=sBMP1.ScanLine[y];

   scl2:=sBMP2.ScanLine[y];

   dscl:=destBMP.ScanLine[y];

   for x:=0 to w*3-1 do begin

      dscl^:= Round((Percent*scl1^+(100-Percent)*scl2^)/100);

      inc(scl1);

      inc(scl2);

      inc(dscl);

   end;

end;

end;

 

Péda program:

 

 

(* Két kép áttetsző tetszőleges %-os arányban.

  A trükk arra használható, hogy képeket fedésbe hozzunk

*)

unit Unit1;

 

interface

 

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

ExtCtrls, ComCtrls, Math, StdCtrls;

 

type

TForm1 = class(TForm)

   TrackBar1: TTrackBar;

   Image1: TImage;

   Label1: TLabel;

   procedure FormCreate(Sender: TObject);

   procedure FormClose(Sender: TObject; var Action: TCloseAction);

   procedure TrackBar1Change(Sender: TObject);

private

   { Private declarations }

public

   BMP1,BMP2: TBitmap;

end;

 

var

Form1: TForm1;

 

implementation

 

{$R *.DFM}

 

(* s1,s2 bitmap-ek áttetsző kombinálása %-os arányban:

  Ha 0, akkor az első bmp nem látszik, ha 50, akkor fele-fel, 100-nál

  csak az első bmp látszik *)

Procedure Opaque(sBMP1,sBMP2 :TBitmap; destBMP :TBitmap; Percent: integer);

var

scl1,scl2,dscl:^Byte;

y,x: integer;

w,h: integer;

begin

sBMP1.pixelformat:=pf24bit;

sBMP2.pixelformat:=pf24bit;

destBMP.pixelformat:=pf24bit;

w:=Min(sBMP1.Width,sBMP2.Width);

h:=Min(sBMP1.Height,sBMP2.Height);

if destBMP.Width<w then destBMP.Width:=w;

if destBMP.Height<h then destBMP.Height:=h;

for y:=0 to h-1 do begin

   scl1:=sBMP1.ScanLine[y];

   scl2:=sBMP2.ScanLine[y];

   dscl:=destBMP.ScanLine[y];

   for x:=0 to w*3-1 do begin

      dscl^:= Round((Percent*scl1^+(100-Percent)*scl2^)/100);

      inc(scl1);

      inc(scl2);

      inc(dscl);

   end;

end;

end;

 

procedure TForm1.FormCreate(Sender: TObject);

begin

BMP1:=TBitmap.Create;

BMP2:=TBitmap.Create;

BMP1.LoadFromFile('Factory.bmp');

BMP2.LoadFromFile('Handshak.bmp');

Opaque(BMP1,BMP2,Image1.Picture.Bitmap,0);

Image1.Update;

end;

 

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

BMP1.FREE;

BMP2.FREE;

end;

 

procedure TForm1.TrackBar1Change(Sender: TObject);

begin

Opaque(BMP1,BMP2,Image1.Picture.Bitmap,TrackBar1.Position);

Image1.Repaint;

end;

 

end.