Динамическая картинка

Интерфейс:

Код программы:

unit Main;

interface

uses

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

Dialogs, ExtCtrls, UParallelogramme, ComCtrls, StdCtrls, Math, ShellAPI;

type

TMainForm = class(TForm)

ImgPanel: TPanel;

Img: TImage;

RotationTimer: TTimer;

ButtonPanel: TPanel;

SpeedLbl: TLabel;

SpeedBar: TTrackBar;

MinLbl: TLabel;

MaxLbl: TLabel;

MiddleLbl: TLabel;

SepBevel: TBevel;

ChooseBitmapLbl: TLabel;

BitmapList: TComboBox;

SepBevel2: TBevel;

PauseBtn: TButton;

QuitBtn: TButton;

procedure FormCreate(Sender: TObject);

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

procedure RotationTimerTimer(Sender: TObject);

procedure SpeedBarChange(Sender: TObject);

procedure BitmapListChange(Sender: TObject);

procedure PauseBtnClick(Sender: TObject);

procedure QuitBtnClick(Sender: TObject);

procedure HyperlinkLblClick(Sender: TObject);

private

{ Dйclarations privйes }

public

{ Dйclarations publiques }

procedure ChangeBitmap;

procedure ShowRectangle;

end;

var

MainForm: TMainForm;

Rect: TParallelogramme;

Angle: Integer;

Bitmap: TBitmap;

Speed: Integer;

implementation

{$R *.dfm}

procedure TMainForm.ChangeBitmap;

Var

Points: array [0..3] of TPoint;

begin

RotationTimer.Enabled:= False;

Angle:= 0;

Bitmap:= TBitmap.Create;

Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\' + BitmapList.Text + '.bmp');

Points[0].X:= (Img.ClientWidth div 2) - (Bitmap.Width div 2);

Points[0].Y:= (Img.ClientHeight div 2) - (Bitmap.Height div 2);

Points[1].X:= Points[0].X + Bitmap.Width;

Points[1].Y:= Points[0].Y;

Points[2].X:= Points[1].X;

Points[2].Y:= Points[1].Y + Bitmap.Height;

Points[3].X:= Points[0].X;

Points[3].Y:= Points[0].Y + Bitmap.Height;

if Assigned(Rect) then Rect.Free;

Rect:= TParallelogramme.Create(Points);

Img.Picture:= nil;

RotationTimer.Enabled:= True;

end;

procedure TMainForm.FormCreate(Sender: TObject);

begin

InitSCA;

Speed:= 3;

DoubleBuffered:= True;

ImgPanel.DoubleBuffered:= True;

ButtonPanel.DoubleBuffered:= True;

ChangeBitmap;

end;

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

begin

Bitmap.Free;

Rect.Free;

end;

function Clamp(Value: Integer): Integer;

begin

if Value > 359 then Value:= 0;

Result:= Value;

end;

procedure TMainForm.RotationTimerTimer(Sender: TObject);

begin

Inc(Angle, Speed);

Clamp(Angle);

Rect.Rotate(Speed);

ShowRectangle;

end;

procedure TMainForm.ShowRectangle;

Var

Pts: array [0..2] of TPoint;

begin

Pts[0]:= Rect.Points[1];

Pts[1]:= Rect.Points[2];

Pts[2]:= Rect.Points[0];

with Img.Canvas, Rect do

begin

FillRect(Img.ClientRect);

PlgBlt(Handle, Pts, Bitmap.Canvas.Handle, 0, 0, Bitmap.Width, Bitmap.Height, 0, 0, 0);

end;

end;

procedure TMainForm.SpeedBarChange(Sender: TObject);

begin

Speed:= SpeedBar.Position;

end;

procedure TMainForm.BitmapListChange(Sender: TObject);

begin

ChangeBitmap;

end;

procedure TMainForm.PauseBtnClick(Sender: TObject);

begin

RotationTimer.Enabled:= not RotationTimer.Enabled;

case RotationTimer.Enabled of

False: PauseBtn.Caption:= 'Reprendre';

True: PauseBtn.Caption:= 'Pause';

end;

end;

procedure TMainForm.QuitBtnClick(Sender: TObject);

begin

Close;

end;

procedure TMainForm.HyperlinkLblClick(Sender: TObject);

begin

ShellExecute(Handle, 'open', 'http://www.delphifr.com', nil, nil, SW_SHOWNORMAL);

end;

end. unit Main;

interface

uses

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

Dialogs, ExtCtrls, UParallelogramme, ComCtrls, StdCtrls, Math, ShellAPI;

type

TMainForm = class(TForm)

ImgPanel: TPanel;

Img: TImage;

RotationTimer: TTimer;

ButtonPanel: TPanel;

SpeedLbl: TLabel;

SpeedBar: TTrackBar;

MinLbl: TLabel;

MaxLbl: TLabel;

MiddleLbl: TLabel;

SepBevel: TBevel;

ChooseBitmapLbl: TLabel;

BitmapList: TComboBox;

SepBevel2: TBevel;

PauseBtn: TButton;

QuitBtn: TButton;

procedure FormCreate(Sender: TObject);

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

procedure RotationTimerTimer(Sender: TObject);

procedure SpeedBarChange(Sender: TObject);

procedure BitmapListChange(Sender: TObject);

procedure PauseBtnClick(Sender: TObject);

procedure QuitBtnClick(Sender: TObject);

procedure HyperlinkLblClick(Sender: TObject);

private

{ Dйclarations privйes }

public

{ Dйclarations publiques }

procedure ChangeBitmap;

procedure ShowRectangle;

end;

var

MainForm: TMainForm;

Rect: TParallelogramme;

Angle: Integer;

Bitmap: TBitmap;

Speed: Integer;

implementation

{$R *.dfm}

procedure TMainForm.ChangeBitmap;

Var

Points: array [0..3] of TPoint;

begin

RotationTimer.Enabled:= False;

Angle:= 0;

Bitmap:= TBitmap.Create;

Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\' + BitmapList.Text + '.bmp');

Points[0].X:= (Img.ClientWidth div 2) - (Bitmap.Width div 2);

Points[0].Y:= (Img.ClientHeight div 2) - (Bitmap.Height div 2);

Points[1].X:= Points[0].X + Bitmap.Width;

Points[1].Y:= Points[0].Y;

Points[2].X:= Points[1].X;

Points[2].Y:= Points[1].Y + Bitmap.Height;

Points[3].X:= Points[0].X;

Points[3].Y:= Points[0].Y + Bitmap.Height;

if Assigned(Rect) then Rect.Free;

Rect:= TParallelogramme.Create(Points);

Img.Picture:= nil;

RotationTimer.Enabled:= True;

end;

procedure TMainForm.FormCreate(Sender: TObject);

begin

InitSCA;

Speed:= 3;

DoubleBuffered:= True;

ImgPanel.DoubleBuffered:= True;

ButtonPanel.DoubleBuffered:= True;

ChangeBitmap;

end;

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

begin

Bitmap.Free;

Rect.Free;

end;

function Clamp(Value: Integer): Integer;

begin

if Value > 359 then Value:= 0;

Result:= Value;

end;

procedure TMainForm.RotationTimerTimer(Sender: TObject);

begin

Inc(Angle, Speed);

Clamp(Angle);

Rect.Rotate(Speed);

ShowRectangle;

end;

procedure TMainForm.ShowRectangle;

Var

Pts: array [0..2] of TPoint;

begin

Pts[0]:= Rect.Points[1];

Pts[1]:= Rect.Points[2];

Pts[2]:= Rect.Points[0];

with Img.Canvas, Rect do

begin

FillRect(Img.ClientRect);

PlgBlt(Handle, Pts, Bitmap.Canvas.Handle, 0, 0, Bitmap.Width, Bitmap.Height, 0, 0, 0);

end;

end;

procedure TMainForm.SpeedBarChange(Sender: TObject);

begin

Speed:= SpeedBar.Position;

end;

procedure TMainForm.BitmapListChange(Sender: TObject);

begin

ChangeBitmap;

end;

procedure TMainForm.PauseBtnClick(Sender: TObject);

begin

RotationTimer.Enabled:= not RotationTimer.Enabled;

case RotationTimer.Enabled of

False: PauseBtn.Caption:= 'Reprendre';

True: PauseBtn.Caption:= 'Pause';

end;

end;

procedure TMainForm.QuitBtnClick(Sender: TObject);

begin

Close;

end;

procedure TMainForm.HyperlinkLblClick(Sender: TObject);

begin

ShellExecute(Handle, 'open', 'http://www.delphifr.com', nil, nil, SW_SHOWNORMAL);

end;

end.

Обработка строк

Интерфейс:

Код программы:

unit Unit15;

interface

uses

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

Dialogs, StdCtrls,stringsFunct;

type

TForm15 = class(TForm)

editMath: TEdit;

lbl1: TLabel;

lbl2: TLabel;

edtCredit: TEdit;

lbl3: TLabel;

edtResult: TEdit;

btnCalculate: TButton;

btnCheck: TButton;

lbl4: TLabel;

procedure lbl2Click(Sender: TObject);

procedure btnCalculateClick(Sender: TObject);

procedure btnCheckClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form15: TForm15;

implementation

{$R *.dfm}

procedure TForm15.btnCalculateClick(Sender: TObject);

var

mass:TMathArray;

mathset:set of Char;

s:string;

i,j,eng,rus,time,data,palindrom:Integer;

begin

eng:=0;rus:=0;time:=0;data:=0;palindrom:=0;

if MathOrNot(editMath.Text)=True then

begin

StrToArray(editMath.Text,mass);

edtResult.Text:=editMath.Text;

edtResult.Text:='Результат вычислений: '+calculate(InBrackets(mass));

end

else

begin

mass:=WordDivide(editMath.Text);

for i:=1 to n do

begin

if EnglishWord(mass[i]) then

eng:=eng+1;

if RussianWord(mass[i]) then

rus:=rus+1;

if TimeTest(mass[i]) then

time:=time+1;

if DataTest(mass[i]) then

data:=data+1;

if PalindromTest(mass[i]) then

Palindrom:=palindrom+1;

end;

end;

mmo1.Text:='В веденном тексте содержится '+#13#10+inttostr(eng)+' английских слов, '+#13#10+inttostr(rus)+' русских слов, '+#13#10+inttostr(time)+' значений времени, '+#13#10+inttostr(data)+' значений даты, '+#13#10+inttostr(palindrom)+' слов и чисел палиндромов';

//edtResult.Text:= 'Текст первого поля: '+editMath.Text

end;

procedure TForm15.btnCheckClick(Sender: TObject);

begin

if CreditOrNot(edtCredit.Text)=True then

if CreditTest(edtCredit.Text)=True then

edtResult.Text:='Введен верный номер кредитной карты'

else

edtResult.Text:='Введен неверный номер кредитной карты';

if ISBNOrNot(edtCredit.Text)=True then

if ISBNTest(edtCredit.Text)=True then

edtResult.Text:='Введен верный ISBN'

else

edtResult.Text:='Введен неверный ISBN';

if (ISBNOrNot(edtCredit.Text)=False) and (CreditOrNot(edtCredit.Text)=False) then

edtResult.Text:= 'Текст второго поля: '+edtCredit.Text;

end;

procedure TForm15.lbl2Click(Sender: TObject);

begin

end; end.

Графики функций

Интерфейс:

Код программы:

unit UnitGraph01;

interface

uses

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

Dialogs, StdCtrls;

type

ff=function(x:real):Real;

TForm1 = class(TForm)

Button1: TButton;

Button2: TButton;

ComboBox1: TComboBox;

Label1: TLabel;

ComboBox2: TComboBox;

Label2: TLabel;

ComboBox3: TComboBox;

Label3: TLabel;

edit1: TEdit;

edit2: TEdit;

Label4: TLabel;

Label5: TLabel;

procedure FormResize(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

const

n=100;

procedure Reline;

procedure Rename;

procedure Redraw(fun1,fun2,fun3:ff);

procedure ReMinimax(fun1,fun2,fun3:ff);

function f1(x:real):Real;

function f2(x:real):Real;

function f3(x:real):Real;

function emptyfun(x:real):Real;

{function f4(x:real):Real;

function f5(x:real):Real; }

var

Form1: TForm1;

xmin,xmax,ymin,ymax:Real;

AreaLeft,AreaTop,Wid,hi,nx,ny,k1,k2,k3:Integer;

bt1t,bt2t,tx1t,tx2t,box1t,box2t:Integer;

box3t,lbl1t,lbl2t,lbl3t,lbl4t,lbl5t:Integer;

fun1,fun2,fun3:ff;

implementation

{$R *.dfm}

procedure Reline;

var

x,y:Integer;

begin

nx:=0;

ny:=0;

x:=0;

y:=hi+30;

while x<wid-30 do

begin

with form1.Canvas do

begin

x:=x+30;

Pen.Color:=RGB(0,200,0);

MoveTo(x,AreaTop);

LineTo(x,hi);

nx:=nx+1;

end;

end;

while y>60 do

begin

with form1.Canvas do

begin

y:=y-30;

Pen.Color:=RGB(0,200,0);

MoveTo(AreaLeft,y);

LineTo(wid,y);

ny:=ny+1;

end;

end;

end;

procedure Rename;

var

i:Integer;

begi

for i:=1 to ny do

begin

with form1.Canvas do

begin

TextOut(5,i*30,FloatToStrF(ymin+(ny-i)*(ymax-ymin)/ny,fffixed,3,2));

end;

end;

end;

procedure Redraw(fun1,fun2,fun3:ff);

var

i,YScreen,XScreen:Integer;

x,y:Real;

begin

form1.Canvas.MoveTo(AreaLeft,hi);

Form1.Canvas.Pen.Color:=clGreen;

if k1<>1 then

for i:=1 to 100*nx do

begin

x:=xmin+i/100/nx*(xmax-xmin);

y:=fun1(x);

XScreen:=Round((x-xmin)/(xmax-xmin)*(wid-AreaLeft)+arealeft);

YScreen:=Round(hi-(y-ymin)/(ymax-ymin)*(hi-AreaTop));

if (YScreen>=AreaTop) and(YScreen<=hi) and (XScreen>=Arealeft) and (XScreen<=wid) then

Form1.Canvas.LineTo(XScreen,YScreen);

end;

form1.Canvas.MoveTo(AreaLeft,hi);

Form1.Canvas.Pen.Color:=clred;

if k2<>1 then

for i:=1 to 100*nx do

begin

x:=xmin+i/100/nx*(xmax-xmin);

y:=fun2(x);

XScreen:=Round((x-xmin)/(xmax-xmin)*(wid-AreaLeft)+arealeft);

YScreen:=Round(hi-(y-ymin)/(ymax-ymin)*(hi-AreaTop));

if (YScreen>=AreaTop) and(YScreen<=hi) and (XScreen>=Arealeft) and (XScreen<=wid) then

Form1.Canvas.LineTo(XScreen,YScreen);

end;

form1.Canvas.MoveTo(AreaLeft,hi);

Form1.Canvas.Pen.Color:=clblue;

if k3<>1 then

for i:=1 to 100*nx do

begin

procedure ReMinimax(fun1,fun2,fun3:ff);

var

i:Integer;

x,y:Real;

begin

ymax:=-1000;

ymin:=1000;

if k1<>1 then

for i:=1 to 100*nx do

begin

x:=xmin+i/100/nx*(xmax-xmin);

y:=fun1(x);

if y<ymin then

ymin:=y;

if y>ymax then

ymax:=y;

end;

if k2<>1 then

for i:=1 to 100*nx do

begin

x:=xmin+i/100/nx*(xmax-xmin);

y:=fun2(x);

if y<ymin then

ymin:=y;

if y>ymax then

ymax:=y;

end;

if k3<>1 then

for i:=1 to 100*nx do

begin

x:=xmin+i/100/nx*(xmax-xmin);

y:=fun3(x);

if y<ymin then

ymin:=y;

if y>ymax then

ymax:=y;

end;

end;

function f1(x:real):Real;

begin

result:=x*x

end;

function f2(x:real):Real;

begin

result:=Sin(x)

end;

function f3(x:real):Real;

begin

result:=Exp(Sin(x)*cos(2*x))-1

end;

function emptyfun(x:real):Real;

begin

Result:=0;

End;

procedure TForm1.FormResize(Sender: TObject);

begin

form1.Refresh;

AreaLeft:=30;

AreaTop:=30;

wid:=ClientWidth-100;

hi:=ClientHeight-100;

with form1.Canvas do

begin

Brush.Color:=RGB(200,200,200);

Pen.Color:=RGB(200,200,200);

end;

Form1.Canvas.Rectangle(AreaLeft,AreaTop,Wid,hi);

ReMinimax(fun1,fun2,fun3);

Reline;

Rename;

Redraw(fun1,fun2,fun3);

begin

fun3:=f3;

k3:=0;

end;

Form1.canvas.brush.color:=clBtnFace;

Form1.canvas.pen.color:=clBtnFace;

Form1.Canvas.Rectangle(AreaLeft-10,AreaTop,Wid+40,hi+40);

Form1.Canvas.Brush.Color:=RGB(200,200,200);

Form1.Canvas.Rectangle(AreaLeft,AreaTop,Wid,hi);

ReMinimax(fun1,fun2,fun3);

Reline;

Rename;

Redraw(fun1,fun2,fun3);

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

Form1.Canvas.Rectangle(AreaLeft,AreaTop,Wid,hi);

ReMinimax(fun1,fun2,fun3);

Reline;

Rename;

end;

end.

Дата добавления: 2015-10-23