Gamayun74

7 лет назад

Здесь не на что смотреть⁠⁠

Просто куски кода из различных прог в Delphe7

Очистка канвы:

InvalidateRect(0, nil, true);

Защита едита:

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);

begin

if not(Key in ['0'..'9',#8]) then Key := #0;

end;

Рандомные линии:

for i:=1 to 7 do

begin

canvas.Pen.Color := RGB(Random(256), Random(256), Random(256));

canvas.LineTo(random(Form1.Width),random(Form1.Height));

end;

Рандомные фигуры:

var shape:Tshape;

Canvas.Brush.Color := RGB(Random(256), Random(256), Random(256));

canvas.Pen.Color := RGB(Random(256), Random(256), Random(256));

a:=1+random(4);

case a of

1 : Canvas.Ellipse(random(Form1.Width),random(Form1.Height),random(Form1.Width),random(Form1.Height));

2 : Canvas.Rectangle(random(Form1.Width),random(Form1.Height),random(Form1.Width),random(Form1.Height));

3 : Canvas.Polygon([Point(random(Form1.Width),random(Form1.Height)), Point(random(Form1.Width),random(Form1.Height)), Point(random(Form1.Width),random(Form1.Height))]);

end;

Рандомные строки из массива:

canvas.brush.style:=bsClear;

<заполнение массива> //если рандомные символы, то без массива рандомим их код в цикле

for i:=1 to 8 do

begin

canvas.Font.color:=RGB(Random(256), Random(256), Random(256));

canvas.font.Size:=5+random(15);

canvas.textout(random(Form1.Width-100),random(Form1.Height),M[random(9)]);

end;

Задача принтер:

var a,i,m : integer;

Shape8.Height:=1; //стартовое положение листа на форме

Shape8.Top:=231;

a:=0;

i:=1;

m:=200;

case strtoint(Edit1.Text) of // "Пуск" - считываем кол-во копий и запускаем таймер

1..10: begin

a:=StrToInt(Edit1.Text);

Timer1.Enabled:=True;

end;

Движение фигуры (в таймере интервал 5-10):

begin

if Shape7.Brush.Color=clRed then

i:=a-1;

If (Shape6.left=70) and (Shape6.top>110) then

Shape6.top:=Shape6.Top-1

else

if (Shape6.top=110) and (Shape6.left<320) then

Shape6.Left:=Shape6.Left+1

else

if (Shape6.left=320) and (Shape6.top<m) then

Shape6.Top:=Shape6.top+1

else

begin

i:=i+1;

m:=m-10;

Shape5.Top:=Shape5.top+10;

Shape5.Height:=Shape5.Height-10;

Shape8.Height := Shape8.Height + 10;

Shape8.Top := Shape8.Top - 10;

Shape6.Left := 70;

Shape6.Top := Shape5.top;

if i=a then

begin

Timer1.Enabled:=false;

Button1.Enabled:=False;

Shape7.Brush.Color:=clRed;

end;

Битовые образы. Вывод статичного изображения.

var Air,Plan : TBitmap;

// создать битовые образы

Air := TBitMap.Create;

Plan := TBitMap.Create;

// загрузить картинки

Air.LoadFromFile('Air.bmp');

Plan.LoadFromFile('Plan.bmp') ;

Form1.Canvas.Draw(0,0,Air); // отрисовка фона

Form1.Canvas.Draw(20,20,Plan); // отрисовка левого самолета

Plan.Transparent:=True;

// теперь элементы рисунка, цвет которых совпадает с цветом

// левой нижней точки битового образа, не отрисовываются

Form1.Canvas.Draw(120,20,Plan);

// отрисовка правого самолета

// освободить память

Air.free;

Plan.free;

Движение кругов на форме

var

x,y: byte; // координаты центра окружности

dx: byte; // приращение координаты x при движении окружности

a,b: byte;

da: byte;

procedure Ris;

begin

// стереть окружность

form1.Canvas.Pen.Color:=form1.Color;

form1.Canvas.Ellipse(x,y,x+10,y+10);

x:=x+dx;

// нарисовать окружность на новом месте

form1.Canvas.Pen.Color:=clBlack;

form1.Canvas.Ellipse(x,y, x+10, y+10) ;

// стереть окружность

form1.Canvas.Pen.Color:=form1.Color;

form1.Canvas.Ellipse(a,b,a+10,b+30);

a:=a+da;

// нарисовать окружность на новом месте

form1.Canvas.Pen.Color:=clBlack;

form1.Canvas.Ellipse(a,b, a+10, b+30) ;

end;

<в таймере прописать Ris;> //сразу включен

OnActivate формы

begin

x:=0;

y:=10;

dx:=5;

a:=0;

b:=20;

da:=5;

timer1.Interval:=50;

// период возникновения события OnTimer -0.5 сек

form1.canvas.brush.color:=clRed;

end;

Движение кораблика

var x,y: integer;

// вычерчивает кораблик

procedure Titanik(x,y: integer; // координаты базовой точки

color: TColor); // цвет корабля

const dx = 5; dy = 5;

var

buf: TColor;

begin

with form1.canvas do

begin

buf:=pen.Color; // сохраним текущий цвет

pen.Color:=color;

// установим нужный цвет

// рисуем . . .

// корпус MoveTo(x,y);

LineTo(x,y-2*dy) ;

LineTo (x+10*dx, y-2*dy) ;

LineTo (x+11*dx, y-3*dy) ;

LineTo (x+17*dx,y-3*dy) ;

LineTo (x+14*dx, y) ;

LineTo (x,y) ;

// надстройка

MoveTo(x+3*dx,y-2*dy) ;

LineTo (x+4*dx, y-3*dy) ;

LineTo (x+4*dx, y-4*dy) ;

LineTo (x+13*dx,y-4*dy) ;

LineTo (x+13*dx, y-3*dy) ;

MoveTo(x+5*dx,y-3*dy) ;

LineTo (x+9*dx, y-3*dy) ;

// капитанский мостик

Rectangle (x+8*dx, y-4*dy, x+11*dx, y-5*dy);

// труба

Rectangle(x+7*dx, y-4*dy, x+8*dx, y-7*dy) ;

// иллюминаторы

Ellipse (x+11*dx,y-2*dy,x+12*dx,y-1*dy) ;

Ellipse (x+13*dx, y-2*dy, x+14*dx, y-1*dy) ;

// мачта

MoveTo(x+10*dx,y-5*dy) ;

LineTo(x+10*dx,y-10*dy);

// оснастка

MoveTo(x+17*dx,y-3*dy);

LineTo(x+10*dx,y-10*dy);

LineTo(x,y-2*dy);

LineTo(x,y);

pen.Color:=buf; // восстановим старый цвет карандаша

end;

В таймере:

Titanik(x,y,form1.color); // стереть рисунок

if x < Form1.ClientWidth then

x := x+5

else

begin // новый рейс x := 0;

y:= Random(50) + 100;

end;

Titanik(x,y,clWhite); // нарисовать в новой точке

OnActivate формы:

x:=0; y:=100;

Form1.Color:=clNavy;

Timer1.Interval := 50; // сигнал таймера каждые 50 миллисекунд

Полёт самолётика :)

var

Back, bitmap, Buf : TBitMap; // фон, картинка, буфер

BackRct : TRect; // область фона, которая должна быть

// восстановлена из буфера

BufRet: Trect; // область буфера, которая используется для

// восстановления фона

x,y:integer; // текущее положение картинки

W,H: integer; // размеры картинки

procedure TForm1.FormActivate(Sender: TObject);

begin

// создать три объекта - битовых образа

Back := TBitmap.Create; // фон

bitmap := TBitmap.Create; // картинка

Buf := TBitmap.Create; // буфер

// загрузить и вывести фон

Back.LoadFromFile('Air.bmp');

Form1.Image1.canvas.Draw(0,0,Back);

// загрузить картинку, которая будет двигаться

bitmap.LoadFromFile('Plane.bmp');

// определим "прозрачный" цвет

bitmap.Transparent := True;

bitmap.TransparentColor := bitmap.canvas.pixels[1,1];

// создать буфер для сохранения копии области фона,

// на которую накладывается картинка

W:= bitmap.Width;

H:= bitmap.Height;

Buf.Width:= W;

Buf.Height:=H;

Buf.Palette:=Back.Palette;

// Чтобы обеспечить соответствие палитр //

Buf.Canvas.CopyMode:=cmSrcCopy;

// определим область буфера, которая

// будет использоваться

// для восстановления фона

BufRet:=Bounds(0,0,W,H);

// начальное положение картинки

x := -W;

y:= 20;

// определим сохраняемую область фона

BackRct:=Bounds(x,y,W,H); // и сохраним ее

Buf.Canvas.CopyRect(BufRet,Back.Canvas,BackRct);

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

// восстановлением фона (из буфера) удалим рисунок

Form1.image1.canvas.Draw(x,y,Buf);

x:=x+2;

if x>(form1.Image1.Width) then x:=-W;

// определим сохраняемую область фона

BackRct:=Bounds(x,y,W,H);

// сохраним ее копию

Buf.Canvas.CopyRect(BufRet,Back.Canvas,BackRct);

// выведем рисунок

Form1.image1.canvas.Draw(x,y,bitmap);

end;

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

begin

// освободим память, выделенную

// для хранения битовых образов

Back.Free;

bitmap.Free;

Buf.Free;

end;

Почаще бы к коду комментарии делать...

[моё] Шпаргалка Delphi Гифка Длиннопост