{$R *.DFM}procedure TBitmapForm.Open1Click(Sender: TObject); begin if OpenDialog1.Execute then begin Image1.Picture.LoadFromFile (OpenDialog1.FileName); Caption := 'Image Viewer - ' + OpenDialog1.FileName; end; end;procedure TBitmapForm.Exit1Click(Sender: TObject); begin Close; end;procedure TBitmapForm.AboutImageViewer1Click(Sender: TObject); begin MessageDlg ('Image Viewer is an example' + #13'of the book "Mastering Delphi"' + #13'written by Marco Cant?, mtInformation, [mbOk], 0); end;procedure TBitmapForm.ColorDepth1Click(Sender: TObject); var strDepth: String; begin case Image1.Picture.Bitmap.PixelFormat of pfDevice: strDepth := 'Device'; pf1bit: strDepth := '1-bit'; pf4bit: strDepth := '4-bit'; pf8bit: strDepth := '8-bit'; pf15bit: strDepth := '15-bit'; pf16bit: strDepth := '16-bit'; pf24bit: strDepth := '24-bit'; pf32bit: strDepth := '32-bit'; pfCustom: strDepth := 'Custom'; end; MessageDlg ('Bitmap color depth: ' + strDepth, mtInformation, [mbOK], 0); end;procedure TBitmapForm.GenerateSlow1Click(Sender: TObject); var Bmp: TBitmap; I, J: Integer; T: Cardinal; begin // get the image and modify it Bmp := Image1.Picture.Bitmap; Bmp.PixelFormat := pf24bit; Bmp.Width := 256; Bmp.Height := 256; T := GetTickCount; // change every pixel for I := 0 to Bmp.Height - 1 do for J := 0 to Bmp.Width - 1 do Bmp.Canvas.Pixels [I, J] := RGB (I*J mod 255, I, J); Caption := 'Image Viewer - Memory Image (MSecs: ' + IntToStr (GetTickCount - T) + ')'; end;procedure TBitmapForm.GenerateFast1Click(Sender: TObject); var Bmp: TBitmap; I, J: Integer; T: Cardinal; Line: PByteArray; begin // get the image and modify it Bmp := Image1.Picture.Bitmap; Bmp.PixelFormat := pf24bit; Bmp.Width := 256; Bmp.Height := 256; T := GetTickCount; // change every pixel, line by line for I := 0 to Bmp.Height - 1 do begin Line := PByteArray (Bmp.ScanLine [I]); for J := 0 to Bmp.Width - 1 do begin Line [J*3] := J; Line [J*3+1] := I*J mod 255; Line [J*3+2] := I; end; end; // refresh the video Image1.Invalidate; Caption := 'Image Viewer - Memory Image (MSecs: ' + IntToStr (GetTickCount - T) + ')'; end;procedure TBitmapForm.ScrollPanel1Click(Sender: TObject); begin PanelScroll.Visible := not PanelScroll.Visible; ScrollPanel1.Checked := PanelScroll.Visible; end;procedure TBitmapForm.TrackBar1Change(Sender: TObject); begin nLines := TrackBar1.Position; TrackBar1.Hint := IntToStr (TrackBar1.Position); end;procedure TBitmapForm.BtnGoClick(Sender: TObject); var W, H, I, J, LineBytes: Integer; Line: PByteArray; Bmp: TBitmap; R: TRect; begin // set the user interface fCancel := False; BtnGo.Enabled := False; BtnCancel.Enabled := True; // get the bitmap of the image and resize it Bmp := Image1.Picture.Bitmap; W := Bmp.Width; H := Bmp.Height; // allocate enough memory for one line LineBytes := Abs (Integer (Bmp.ScanLine [1]) - Integer (Bmp.ScanLine [0])); Line := AllocMem (LineBytes); // scroll how many itmes as there are lines for I := 0 to H - 1 do begin // exit the for loop if Cancel was pressed if fCancel then Break; // copy the first line Move ((Bmp.ScanLine [0])^, Line^, LineBytes); // for every line for J := 1 to H - 1 do begin // move line to the previous one Move ((Bmp.ScanLine [J])^, (Bmp.ScanLine [J-1])^, LineBytes); // every nLines update the output if (J mod nLines = 0) then begin R := Rect (0, PanelScroll.Height + J-nLines, W, PanelScroll.Height + J); InvalidateRect (Handle, @R, False); UpdateWindow (Handle); end; end; // move back the first line to the end Move (Line^, (Bmp.ScanLine [Bmp.Height - 1])^, LineBytes); // update the final portion of the bitmap R := Rect (0, PanelScroll.Height + H - nLines, W, PanelScroll.Height + H); InvalidateRect (Handle, @R, False); UpdateWindow (Handle); // let the program handle other messages Application.ProcessMessages; end; // reset the UI BtnGo.Enabled := True; BtnCancel.Enabled := False; end;procedure TBitmapForm.BtnCancelClick(Sender: TObject); begin fCancel := True; end;procedure TBitmapForm.FormCreate(Sender: TObject); begin TrackBar1Change (self); end;end.//dfm object BitmapForm: TBitmapForm Left = 245 Top = 131 Width = 475 Height = 385 Caption = 'Bitmap Draw' Color = clBtnFace Font.Charset = ANSI_CHARSET Font.Color = clWindowText Font.Height = -13 Font.Name = 'Arial' Font.Style = [] Menu = MainMenu1 OldCreateOrder = True OnCreate = FormCreate PixelsPerInch = 96 TextHeight = 16 object Image1: TImage Left = 0 Top = 49 Width = 467 Height = 290 Align = alClient end object PanelScroll: TPanel Left = 0 Top = 0 Width = 467 Height = 49 Align = alTop ParentShowHint = False ShowHint = True TabOrder = 0 Visible = False object Label1: TLabel Left = 216 Top = 16 Width = 41 Height = 16 Caption = 'Speed:' end object TrackBar1: TTrackBar Left = 264 Top = 9 Width = 150 Height = 31 Max = 210 Min = 10 Orientation = trHorizontal PageSize = 40 Frequency = 20 Position = 110 SelEnd = 0 SelStart = 0 TabOrder = 0 TickMarks = tmBottomRight TickStyle = tsAuto OnChange = TrackBar1Change end object BtnCancel: TBitBtn Left = 104 Top = 11 Width = 75 Height = 25 Caption = '&Cancel' Enabled = False TabOrder = 1 OnClick = BtnCancelClick Kind = bkCancel end object BtnGo: TBitBtn Left = 16 Top = 11 Width = 75 Height = 25 Caption = '&Go' TabOrder = 2 OnClick = BtnGoClick Kind = bkIgnore end end object MainMenu1: TMainMenu Left = 24 Top = 56 object File1: TMenuItem Caption = '&File' object Open1: TMenuItem Caption = '&Open...' OnClick = Open1Click end object N1: TMenuItem Caption = '-' end object Exit1: TMenuItem Caption = '&Exit' OnClick = Exit1Click end end object Options1: TMenuItem Caption = '&Options' object ColorDepth1: TMenuItem Caption = 'Color &Depth' OnClick = ColorDepth1Click end object GenerateSlow1: TMenuItem Caption = '&Generate (Slow)' OnClick = GenerateSlow1Click end object GenerateFast1: TMenuItem Caption = 'Generate (&Fast)' OnClick = GenerateFast1Click end object ScrollPanel1: TMenuItem Caption = 'Scroll Panel' OnClick = ScrollPanel1Click end end object Help1: TMenuItem Caption = '&Help' object AboutImageViewer1: TMenuItem Caption = '&About Bitmap Draw...' OnClick = AboutImageViewer1Click end end end object OpenDialog1: TOpenDialog Filter = 'Bitmap (*.bmp)|*.bmp' Options = [ofHideReadOnly, ofPathMustExist, ofFileMustExist] Left = 24 Top = 104 end end
我有,转载:) 《程序春秋》2001/11期上有一套,我给你部分,其他的你自己去找好了! //百叶窗 proceder (Form1:TForm;Image1:TImage;left,top,movestep,fangxiang:integer); var i,j,mm,step : integer; begin mm:=0; step:=Image1.height div movestep; while mm<step do begin inc(mm); case fangxiang of 0:for i:=0 to movestep-1 do Form1.canvas.copyrect(rect(left,top+step*i,left+Image1.Width,top+step*i+mm), Image1.Canvas,rect(0,step*i,Image1.Width,step*i+mm)); 1:for i:=0 to movestep do Form1.canvas.copyrect(rect(left,top+step*i-mm,left+Image1.Width, top+step*i), Image1.Canvas,rect(0,step*i-mm,Image1.Width,step*i)); end; for i:=0 to 10000 do for j:=0 to 250 do;//setp time end; Image1.Left:=Left; Image1.Toop:=top; Image1.Visible:=true; end;
同仁.用TIMER+CANVAS+COPYRECT()的思路我查过,可以实现一部分花样显示,但还有更多的不能实现,比如实现图像的由远到近,或由近到远连续的画面显示,或整个图片中分为很多小块
,随机逐渐显示出来,
和原图做什么and或者or,xor等运算,不知图片间如何做这些运算,函数或格式是什么?
unit BmpForm;interfaceuses
Windows, Classes, Graphics, Forms, Controls, Menus,
Dialogs, StdCtrls, ExtCtrls, SysUtils, ComCtrls, Buttons;type
TBitmapForm = class(TForm)
MainMenu1: TMainMenu;
File1: TMenuItem;
Open1: TMenuItem;
N1: TMenuItem;
Exit1: TMenuItem;
Help1: TMenuItem;
AboutImageViewer1: TMenuItem;
OpenDialog1: TOpenDialog;
Options1: TMenuItem;
Image1: TImage;
ColorDepth1: TMenuItem;
GenerateSlow1: TMenuItem;
GenerateFast1: TMenuItem;
ScrollPanel1: TMenuItem;
PanelScroll: TPanel;
TrackBar1: TTrackBar;
BtnCancel: TBitBtn;
BtnGo: TBitBtn;
Label1: TLabel;
procedure Open1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure AboutImageViewer1Click(Sender: TObject);
procedure ColorDepth1Click(Sender: TObject);
procedure GenerateSlow1Click(Sender: TObject);
procedure GenerateFast1Click(Sender: TObject);
procedure ScrollPanel1Click(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure BtnGoClick(Sender: TObject);
procedure BtnCancelClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
nLines: Integer;
fCancel: Boolean;
public
{ Public declarations }
end;var
BitmapForm: TBitmapForm;implementation
{$R *.DFM}procedure TBitmapForm.Open1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
Image1.Picture.LoadFromFile (OpenDialog1.FileName);
Caption := 'Image Viewer - ' + OpenDialog1.FileName;
end;
end;procedure TBitmapForm.Exit1Click(Sender: TObject);
begin
Close;
end;procedure TBitmapForm.AboutImageViewer1Click(Sender: TObject);
begin
MessageDlg ('Image Viewer is an example'
+ #13'of the book "Mastering Delphi"'
+ #13'written by Marco Cant?,
mtInformation, [mbOk], 0);
end;procedure TBitmapForm.ColorDepth1Click(Sender: TObject);
var
strDepth: String;
begin
case Image1.Picture.Bitmap.PixelFormat of
pfDevice: strDepth := 'Device';
pf1bit: strDepth := '1-bit';
pf4bit: strDepth := '4-bit';
pf8bit: strDepth := '8-bit';
pf15bit: strDepth := '15-bit';
pf16bit: strDepth := '16-bit';
pf24bit: strDepth := '24-bit';
pf32bit: strDepth := '32-bit';
pfCustom: strDepth := 'Custom';
end;
MessageDlg ('Bitmap color depth: ' + strDepth,
mtInformation, [mbOK], 0);
end;procedure TBitmapForm.GenerateSlow1Click(Sender: TObject);
var
Bmp: TBitmap;
I, J: Integer;
T: Cardinal;
begin
// get the image and modify it
Bmp := Image1.Picture.Bitmap;
Bmp.PixelFormat := pf24bit;
Bmp.Width := 256;
Bmp.Height := 256; T := GetTickCount;
// change every pixel
for I := 0 to Bmp.Height - 1 do
for J := 0 to Bmp.Width - 1 do
Bmp.Canvas.Pixels [I, J] := RGB (I*J mod 255, I, J);
Caption := 'Image Viewer - Memory Image (MSecs: ' +
IntToStr (GetTickCount - T) + ')';
end;procedure TBitmapForm.GenerateFast1Click(Sender: TObject);
var
Bmp: TBitmap;
I, J: Integer;
T: Cardinal;
Line: PByteArray;
begin
// get the image and modify it
Bmp := Image1.Picture.Bitmap;
Bmp.PixelFormat := pf24bit;
Bmp.Width := 256;
Bmp.Height := 256; T := GetTickCount;
// change every pixel, line by line
for I := 0 to Bmp.Height - 1 do
begin
Line := PByteArray (Bmp.ScanLine [I]);
for J := 0 to Bmp.Width - 1 do
begin
Line [J*3] := J;
Line [J*3+1] := I*J mod 255;
Line [J*3+2] := I;
end;
end;
// refresh the video
Image1.Invalidate;
Caption := 'Image Viewer - Memory Image (MSecs: ' +
IntToStr (GetTickCount - T) + ')';
end;procedure TBitmapForm.ScrollPanel1Click(Sender: TObject);
begin
PanelScroll.Visible := not PanelScroll.Visible;
ScrollPanel1.Checked := PanelScroll.Visible;
end;procedure TBitmapForm.TrackBar1Change(Sender: TObject);
begin
nLines := TrackBar1.Position;
TrackBar1.Hint := IntToStr (TrackBar1.Position);
end;procedure TBitmapForm.BtnGoClick(Sender: TObject);
var
W, H, I, J, LineBytes: Integer;
Line: PByteArray;
Bmp: TBitmap;
R: TRect;
begin
// set the user interface
fCancel := False;
BtnGo.Enabled := False;
BtnCancel.Enabled := True; // get the bitmap of the image and resize it
Bmp := Image1.Picture.Bitmap;
W := Bmp.Width;
H := Bmp.Height; // allocate enough memory for one line
LineBytes := Abs (Integer (Bmp.ScanLine [1]) -
Integer (Bmp.ScanLine [0]));
Line := AllocMem (LineBytes); // scroll how many itmes as there are lines
for I := 0 to H - 1 do
begin
// exit the for loop if Cancel was pressed
if fCancel then
Break;
// copy the first line
Move ((Bmp.ScanLine [0])^, Line^, LineBytes);
// for every line
for J := 1 to H - 1 do
begin
// move line to the previous one
Move ((Bmp.ScanLine [J])^, (Bmp.ScanLine [J-1])^, LineBytes);
// every nLines update the output
if (J mod nLines = 0) then
begin
R := Rect (0, PanelScroll.Height + J-nLines,
W, PanelScroll.Height + J);
InvalidateRect (Handle, @R, False);
UpdateWindow (Handle);
end;
end;
// move back the first line to the end
Move (Line^, (Bmp.ScanLine [Bmp.Height - 1])^, LineBytes);
// update the final portion of the bitmap
R := Rect (0, PanelScroll.Height + H - nLines,
W, PanelScroll.Height + H);
InvalidateRect (Handle, @R, False);
UpdateWindow (Handle);
// let the program handle other messages
Application.ProcessMessages;
end;
// reset the UI
BtnGo.Enabled := True;
BtnCancel.Enabled := False;
end;procedure TBitmapForm.BtnCancelClick(Sender: TObject);
begin
fCancel := True;
end;procedure TBitmapForm.FormCreate(Sender: TObject);
begin
TrackBar1Change (self);
end;end.//dfm
object BitmapForm: TBitmapForm
Left = 245
Top = 131
Width = 475
Height = 385
Caption = 'Bitmap Draw'
Color = clBtnFace
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Arial'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = True
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 16
object Image1: TImage
Left = 0
Top = 49
Width = 467
Height = 290
Align = alClient
end
object PanelScroll: TPanel
Left = 0
Top = 0
Width = 467
Height = 49
Align = alTop
ParentShowHint = False
ShowHint = True
TabOrder = 0
Visible = False
object Label1: TLabel
Left = 216
Top = 16
Width = 41
Height = 16
Caption = 'Speed:'
end
object TrackBar1: TTrackBar
Left = 264
Top = 9
Width = 150
Height = 31
Max = 210
Min = 10
Orientation = trHorizontal
PageSize = 40
Frequency = 20
Position = 110
SelEnd = 0
SelStart = 0
TabOrder = 0
TickMarks = tmBottomRight
TickStyle = tsAuto
OnChange = TrackBar1Change
end
object BtnCancel: TBitBtn
Left = 104
Top = 11
Width = 75
Height = 25
Caption = '&Cancel'
Enabled = False
TabOrder = 1
OnClick = BtnCancelClick
Kind = bkCancel
end
object BtnGo: TBitBtn
Left = 16
Top = 11
Width = 75
Height = 25
Caption = '&Go'
TabOrder = 2
OnClick = BtnGoClick
Kind = bkIgnore
end
end
object MainMenu1: TMainMenu
Left = 24
Top = 56
object File1: TMenuItem
Caption = '&File'
object Open1: TMenuItem
Caption = '&Open...'
OnClick = Open1Click
end
object N1: TMenuItem
Caption = '-'
end
object Exit1: TMenuItem
Caption = '&Exit'
OnClick = Exit1Click
end
end
object Options1: TMenuItem
Caption = '&Options'
object ColorDepth1: TMenuItem
Caption = 'Color &Depth'
OnClick = ColorDepth1Click
end
object GenerateSlow1: TMenuItem
Caption = '&Generate (Slow)'
OnClick = GenerateSlow1Click
end
object GenerateFast1: TMenuItem
Caption = 'Generate (&Fast)'
OnClick = GenerateFast1Click
end
object ScrollPanel1: TMenuItem
Caption = 'Scroll Panel'
OnClick = ScrollPanel1Click
end
end
object Help1: TMenuItem
Caption = '&Help'
object AboutImageViewer1: TMenuItem
Caption = '&About Bitmap Draw...'
OnClick = AboutImageViewer1Click
end
end
end
object OpenDialog1: TOpenDialog
Filter = 'Bitmap (*.bmp)|*.bmp'
Options = [ofHideReadOnly, ofPathMustExist, ofFileMustExist]
Left = 24
Top = 104
end
end
《程序春秋》2001/11期上有一套,我给你部分,其他的你自己去找好了!
//百叶窗
proceder (Form1:TForm;Image1:TImage;left,top,movestep,fangxiang:integer);
var
i,j,mm,step : integer;
begin
mm:=0;
step:=Image1.height div movestep;
while mm<step do
begin
inc(mm);
case fangxiang of
0:for i:=0 to movestep-1 do
Form1.canvas.copyrect(rect(left,top+step*i,left+Image1.Width,top+step*i+mm),
Image1.Canvas,rect(0,step*i,Image1.Width,step*i+mm));
1:for i:=0 to movestep do
Form1.canvas.copyrect(rect(left,top+step*i-mm,left+Image1.Width,
top+step*i), Image1.Canvas,rect(0,step*i-mm,Image1.Width,step*i));
end;
for i:=0 to 10000 do
for j:=0 to 250 do;//setp time
end;
Image1.Left:=Left;
Image1.Toop:=top;
Image1.Visible:=true;
end;