Последние записи
- Прозрачность тайлсета в TPNGImage
- Как сделать VBA макрос в excel
- Поиск по столбцу 1-ого не нулевого значения (формулой в Microsoft Office Excel)
- Простановка единиц в ячейки под объектами (Microsoft Office Excel)
- Расчет затраченного времени между определенным рабочим временем (формулой в Microsoft Office Excel)
- Мигающий экран на Assembler
- VBA-макрос по копированию 10 строчек в выбранном диапазоне в Microsoft Office Excel
- Копирование только нужного диапазона в Microsoft Office Excel
- Перенос диапазона стоки в Microsoft Office Excel на другой лист по условию
- Мелодия в Pascal.ABC.Net с помощью System.Console.Beep — задержка воспроизведения звука
1st
Мар
Как получить все цвета пикселей в Timage?
вот не понимаю как получить все цвета, ведь сначала проходить нужно будет с [1 и до …]; а это до тоже может меняться. Может кто ни будь подсказать, если в [1,и до …] дальше пиксели не идут как сместится на [2 и до …] (читать всё…)
8th
Ноя
Программное открытие изображение, изменение размера, сохранение без потерь
Посоветуйте. Мне нужно: программно открыть изображение и изменить его размер, причем изменяя ширину, высота должна изменяться пропорционально. После нужно сохранить изображение под др. именем. (читать всё…)
12th
Сен
Анимированный Gif в компоненте Image
Есть модуль от Андерса Меландера, бесплатный. Подключаете его в секцию uses и пишете код:
Код:
procedure Tform1.FormCreate(Sender : Tobject);
var
gif : TGifImage;
begin
gif:=TGIfImage.Create;
try
Image1.Picture.LoadFromFile('1.gif);
finally
gif.Free;
end;
end;
А вот собственно сам модуль
5th
Сен
Липкие обьекты
Как можно сделать эффект липких объектов?
Stilet:
Обработчик перемещения так чтоб картинки клеились к друг другу сбоку:
код:
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var cx2,cx,pt2:TPoint;i:integer; r1,r2:double;
begin
if (pt.X>0)and(pt.Y>0) then begin
pt2:=TImage(Sender).ClientToScreen(Point(x,y));
TImage(Sender).Left:=TImage(Sender).Left+(pt2.X-pt.X);
TImage(Sender).Top:=TImage(Sender).Top+(pt2.y-pt.y);
pt:=pt2;
cx.X:=TImage(Sender).Left+TImage(Sender).Width div 2;
cx.y:=TImage(Sender).Top+TImage(Sender).Height div 2;
r1:=sqrt(sqr(TImage(Sender).Width)+sqrt(TImage(Sender).Height));
for i := 0 to ControlCount – 1 do begin
if (Controls is TImage)and(Controlssender) then begin
with TImage(Controls) do begin
cx2.X:=Left+Width div 2;
cx2.y:=Top+Height div 2;
r2:=sqrt(sqr(Width)+sqrt(Height));
if sqrt(sqr(cx.X-cx2.X)+sqr(cx.y-cx2.y))<((r2+r1)/2+20) then begin
//******************************************
if (cx.X>cx2.X) then begin
TImage(Sender).Left:=Left+Width;
TImage(Sender).Top:=top;
end;
if (cx.X<cx2.X) then begin
TImage(Sender).Left:=Left-Width;
TImage(Sender).Top:=top;
end;
//******************************************
end;
end;
end;
end;
end;
end;
Y: Integer);
var cx2,cx,pt2:TPoint;i:integer; r1,r2:double;
begin
if (pt.X>0)and(pt.Y>0) then begin
pt2:=TImage(Sender).ClientToScreen(Point(x,y));
TImage(Sender).Left:=TImage(Sender).Left+(pt2.X-pt.X);
TImage(Sender).Top:=TImage(Sender).Top+(pt2.y-pt.y);
pt:=pt2;
cx.X:=TImage(Sender).Left+TImage(Sender).Width div 2;
cx.y:=TImage(Sender).Top+TImage(Sender).Height div 2;
r1:=sqrt(sqr(TImage(Sender).Width)+sqrt(TImage(Sender).Height));
for i := 0 to ControlCount – 1 do begin
if (Controls is TImage)and(Controlssender) then begin
with TImage(Controls) do begin
cx2.X:=Left+Width div 2;
cx2.y:=Top+Height div 2;
r2:=sqrt(sqr(Width)+sqrt(Height));
if sqrt(sqr(cx.X-cx2.X)+sqr(cx.y-cx2.y))<((r2+r1)/2+20) then begin
//******************************************
if (cx.X>cx2.X) then begin
TImage(Sender).Left:=Left+Width;
TImage(Sender).Top:=top;
end;
if (cx.X<cx2.X) then begin
TImage(Sender).Left:=Left-Width;
TImage(Sender).Top:=top;
end;
//******************************************
end;
end;
end;
end;
end;
end;
19th
Июл
Перемещение TImage по форме. Как это сделать?
dmitriegorovih:
Значит у меня Delphi 7
кидаем на форму image1 и кнопку, чтоб создавались image(ы)
во “всеобщий var” пишем следующиеvar
x2,y2,n:integer;
nagata:boolean;в обработчике onmousedown пишем следующие
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
nagata:=true;
x2:=x;
y2:=y;
end;в обработчике onMouseMove пишем следующие
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if nagata=true then begin
if xx2 then begin
Timage(sender).Left:=Timage(sender).Left+(x-x2)
end;
if yy2 then begin
Timage(sender).Top:=Timage(sender).Top+(y-y2)
end;
end;
end;в обработчике onMouseUp пишем следующие
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
nagata:=false;
end;по нажатию кнопки пишем следующие
procedure TForm1.Button1Click(Sender: TObject);
Var K:Timage;
Begin
K:=Timage.create(self);
k.parent:=self;
k.picture:=image1.picture;
k.onMouseMove:=image1.onMouseMove;
k.onMouseDown:=image1. onMouseDown;
k.onMouseUp:=image1.onMouseUp;
k.name:=’Image_’+inttostr(n);
inc(n);
end;
Ещё один способ:
Кидаем на форму TPanel На нее кидаем TImage, и расстягиваем Image на AlClient чтоб оно заполнило всю панель.
Далее в в обработчике зажатия мышки для Image пишем:
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
const Sc_dragmove = $F012;
begin
ReleaseCapture;
Panel1.Perform(WM_SYSCOMMAND, Sc_dragmove, 0);
end;
