перемещение изображений по форме

← →
caps14 (2009-08-06 18:19) [0]

Выполнил всё согласно статье, прокомпилировал-без ошибок
Запустил в результате-картинки стоят на мести ни как не реагируя на кнопки мыши.
Загружал картинки bmp1,bmp2 и т.д. так
Создал 3 пустых Image на форме-Загрузил в них bmp посредством-свойство Picture ...(TBitmap) Вот код:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;

type
TForm1 = class(TForm)
Image1: TImage;
Image2: TImage;
Image3: TImage;
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormCreate(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
var Pic: array[1..3] of TImage;
x0,y0:integer;
flag:boolean;

{$R *.dfm}
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
If button<>mbLeft Then
flag:=false
Else begin
flag:=true;
x0:=x;
y0:=y
end
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
flag:=false
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
If flag Then begin
(Sender As TImage).Left:=(Sender As TImage).Left+x-x0;
(Sender As TImage).Top:=(Sender As TImage).Top+y-y0
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var i:byte;
begin
For i:=0 To Form1.ComponentCount-1 Do
If (Form1.Components[i] Is TImage) Then
Pic[Form1.Components[i].Tag]:=(Form1.Components[i] As TImage)
For i:=1 To 3 Do begin
Pic[i].Picture.LoadFromFile(IntToStr(i)+".bmp");
Pic[i].OnMouseDown:=Image1MouseDown;
Pic[i].OnMouseMove:=Image1MouseMove;
Pic[i].OnMouseUp:= Image1MouseUp
end
end;
end.
Подскажите,пожалуйста в чём проблема?

← →
Игорь Шевченко © (2009-08-06 18:24) [1]

> Выполнил всё согласно статье

уголовного кодекса Российской Федерации ?

← →
CSS (2009-08-06 18:40) [2]

Хм... Какой-то странный код... Надо бы изучить зачем они такое творили... =)

> прокомпилировал-без ошибок

Странно... =))

> Создал 3 пустых Image на форме-Загрузил в них bmp посредством-
> свойство Picture ...(TBitmap) Вот код:

Судя по коду загружать в них картинки вручную не надо, а просто расположить в папке с проектом файлы "1.bmp", "2.bmp" и "3.bmp"... =)

> Подскажите,пожалуйста в чём проблема?

А вы проставили всем Image"ам соответствующие Tag"и?

← →
CSS (2009-08-06 19:10) [3]

Можно ещё в Image1MouseDown добавить строку:

TControl(Sender).BringToFront;

Тогда та картинка на которую жмёшь будет ещё и как бы на передний план "вылазить"... =)

← →
caps14 (2009-08-06 22:53) [4]

Прописал в TAG номера 1,2,3
разместил 1.bmp,.... в папку с проектом . Не помогло- создается пустая форма!
может есть другой способ?
мне ещё нужно чтобы картинка при клики ПКМ
перечеркивалась красным крестиком, 2 клика-2 крестика. Помогите,пожалуйста, бьюсь уже неделю-вроде все процедуры есть, а у меня что-то не получается!

← →
CSS (2009-08-07 00:07) [5]

У меня работает..... Код брал отсюда...
Попробуйте "пересобрать" проект, чтоли... =)

> перечеркивалась красным крестиком, 2 клика-2 крестика.

Ну перечёркивалась-то ладно... А "при двух щелчках дважды перечёркиваться" - это как так? =))

← →
CSS (2009-08-07 00:12) [6]

А... Забыл...
Точка с запятой пропущена перед "For" была...

Я такое автоматом исправляю просто... =)

← →
caps14 (2009-08-07 03:37) [7]

Отправьте, пожалуйста,(если Вам нетрудно) код мне на мыло caps14@gmail.com Вашу ссылку я не вижу- наверно недостаточно прав на форуме. 2 крестика- это 2 маленьких красных крестика на одной карте. Так я запоминаю какие карты вышли из колоды при игре в онлайн.

← →
Leonid Troyanovsky © (2009-08-07 08:04) [8]

> caps14 (07.08.09 03:37) [7]

http://www.podgoretsky.com/Redir.aspx?id=226&DownloadFile=~/ftp/Docs/Delphi/DX/PeterBelow.chm

Смотрим пример

> I want to move an image across my form.
> Therefore I´ve found a good routine. This works nice with buttons etc.
> But with my image it doesn´t. WHY?
>
> procedure Tmainform.MyImage1mouseDown(Sender: TObject;
> Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
> const
> SC_DragMove = $F012;
> begin
> ReleaseCapture;
> (MyImage1 as tcontrol).perform(WM_SysCommand, SC_DragMove, 0);
> end;

It does not work because a TImage is *not* a TwinControl, it does not
have a window handle and so it does not even exist as far as Windows is
concerned. The dragmove hack highjacks the Windows method of moving
forms, it only works with TWinControls.

It is not that hard to write mouse handler code that allows the user to
drag a control around, here is an example:

Drag around controls:
unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls, DBTables, DB; type TForm1 = class(TForm) Button1: TButton; Memo1: TMemo; Image1: TImage; procedure Button1Click(Sender: TObject); procedure ControlMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure ControlMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); private { Private declarations } downX, downY: Integer; dragging: Boolean; public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} Type TCracker = Class(TControl); { Needed since TControl.MouseCapture is protected } procedure TForm1.Button1Click(Sender: TObject); begin Close end; { Control event handlers are attached to both memo and image mouse events. } procedure TForm1.ControlMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin downX:= X; downY:= Y; dragging := TRue; TCracker(Sender).MouseCapture := TRue; end; procedure TForm1.ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin If dragging Then with Sender As TControl Do Begin Left := X-downX+Left; Top := Y-downY+Top; End; end; procedure TForm1.ControlMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin If dragging then Begin dragging := False; TCracker(Sender).MouseCapture := False; End; end; initialization end.

Peter Below (TeamB) 100113.1101@compuserve.com)

--
Regards, LVT.

← →
caps14 (2009-08-07 18:59) [9]

Извините,а как мне использовать свои изображения с этим кодом:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
StdCtrls, ExtCtrls, ComCtrls, DBTables, DB;

type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Image1: TImage;
procedure Button1Click(Sender: TObject);
procedure ControlMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ControlMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ControlMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
downX, downY: Integer;
dragging: Boolean;

public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

Type
TCracker = Class(TControl);
{ Needed since TControl.MouseCapture is protected }

procedure TForm1.Button1Click(Sender: TObject);
begin
Close
end;

{ Control event handlers are attached to both memo and image mouse
events. }
procedure TForm1.ControlMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
downX:= X;
downY:= Y;
dragging := TRue;
TCracker(Sender).MouseCapture := TRue;
end;

procedure TForm1.ControlMouseMove(Sender: TObject; Shift: TShiftState;
X,
Y: Integer);
begin
If dragging Then
with Sender As TControl Do Begin
Left := X-downX+Left;
Top := Y-downY+Top;
End;
end;

procedure TForm1.ControlMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
If dragging then Begin
dragging := False;
TCracker(Sender).MouseCapture := False;
End;
end;

initialization
end.
Пробовал и в папку с проектом помещать изображения
и делал на форме пустые Image прописывая в Tag номера.
Результат один-пустая форма! А в архиве(8Мб) что? У меня медленный инет,не хотелось бы долго качать то что может не пригодиться.
А вообще всем спасибо за участие!

> caps14 (07.08.09 18:59) [9]

> Извините,а как мне использовать свои изображения с этим
> кодом:

А чего, испытывалось на ворованных?

> Пробовал и в папку с проектом помещать изображения
> и делал на форме пустые Image прописывая в Tag номера.
> Результат один-пустая форма!

Image1.Picture.LoadFromFile

--
Regards, LVT.

← →
caps14 (2009-08-11 19:13) [11]

Из исходника Solitaire4L, удалив лишнее, собрал следующий код, добавив процедуру
рисования ЛКМ и ПКМ звёзд:
Но почему-то на пустой форме звёзды прорисовываются, а на картах нет.
Что нужно изменить в процедуре StarLine, чтобы звезды рисовались на каждой из карт?
unit Main4D;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, Menus, ExtCtrls, StdCtrls;

type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
Game1: TMenuItem;
Quit1: TMenuItem;
SB1: TStatusBar;
NewGame1: TMenuItem;
Image1: TImage;
procedure Quit1Click(Sender: TObject);
procedure NewGame1Click(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);

private
// procedure AppMessage(var Msg: TMsg; var Handled: Boolean);
public
{ Public declarations }

end;

(*
Diamonds - Áóáíû
Hearts - ×åðâè
Clubs - Êðåñòè
Spades - Ïèêè
*)
Suits = (Diamonds,Hearts,Spades,Clubs);

CPack = record
Suit : Suits;
Card : Byte;
BPos : Byte;
end;

XY = record
X : Integer;
Y : Integer;
B : Boolean;
end;

const
_PosC : array[1..4,1..9] of TPoint =
(((x:0;y:0), (x:35;y:0), (x:70;y:0), (x:105;y:0), (x:140;y:0), (x:175;y:0), (x:210;y:0), (x:245;y:0), (x:280;y:0)),
((x:0;y:90), (x:35;y:90), (x:70;y:90), (x:105;y:90), (x:140;y:90), (x:175;y:90), (x:210;y:90), (x:245;y:90), (x:280;y:90)),
((x:0;y:180),(x:35;y:180),(x:70;y:180),(x:105;y:180),(x:140;y:180),(x:175;y:180) ,(x:210;y:180),(x:245;y:180),(x:280;y:180)),
((x:0;y:285),(x:35;y:285),(x:70;y:285),(x:105;y:285),(x:140;y:285),(x:175;y:285) ,(x:210;y:285),(x:245;y:285),(x:280;y:285)));
BitmapName : array[0..35] of ShortString =
("B1_6","B2_7","B3_8","B4_9","B5_10","B6_J","B7_Q","B8_K","B9_A",
"C1_6","C2_7","C3_8","C4_9","C5_10","C6_J","C7_Q","C8_K","C9_A",
"P1_6","P2_7","P3_8","P4_9","P5_10","P6_J","P7_Q","P8_K","P9_A",
"T1_6","T2_7","T3_8","T4_9","T5_10","T6_J","T7_Q","T8_K","T9_A");
HCard : Byte = 96;
WCard : Byte = 34;

var
Form1 : TForm1;
Pack : array[1..4,1..9] of CPack;
Lines : array[1..4] of Byte;
TCards : array[0..35] of CPack;
Attempt : Byte;
Drag : Boolean;
CBitmap : TBitmap;
Background,
Card : TRect;
OPX,OPY : Integer;
OSX,OSY : Integer;
SPX,SPY : Integer;
UnX1,UnX2,
UnY1,UnY2 : Byte;
_Pos : array[1..4,1..9] of TPoint;

procedure Convert(var X,Y:Integer);

implementation

{$R *.DFM}
procedure StarLine(x0,y0,r: integer; Canvas: TCanvas);
var
p : array[1..11] of TPoint;
a: integer;
i: integer;
begin
a := 18;
for i:=1 to 10 do
begin
if (i mod 2 = 0) then
begin // âïàäèíà
p[i].x := x0+Round(r/2*cos(a*2*pi/360));
p[i].y:=y0-Round(r/2*sin(a*2*pi/360));
end
else
begin // ëó÷
p[i].x:=x0+Round(r*cos(a*2*pi/360));
p[i].y:=y0-Round(r*sin(a*2*pi/360));
end;
a := a+36;

end;

p[11].X := p[1].X;
p[11].Y := p[1].Y;

Canvas.Polyline(p);
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft
then Form1.Canvas.Pen.Color := clBlack
else Form1.Canvas.Pen.Color := clRed;
StarLine(x, y, 30,Form1.Canvas);
end;

procedure TForm1.Quit1Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.NewGame1Click(Sender: TObject);
const
SuitOfCard : array[1..4] of Suits = (Diamonds,Hearts,Spades,Clubs);
var
Card : CPack;
Bitmap1 : TBitmap;
I : Word;
X,Y : Byte;
begin
for Y:=1 to 4 do
for X:=1 to 9 do
Form1.Canvas.RoundRect(_Pos[Y,X].X,_Pos[Y,X].Y,_Pos[Y,X].X+WCard,_Pos[Y,X].Y+HCard,6,6);
for Y:=1 to 4 do
for X:=1 to 9 do
begin
Pack[Y,X].Suit:=SuitOfCard[Y];
Pack[Y,X].Card:=X;
Pack[Y,X].BPos:=(Y-1)*9+(X-1);
TCards[(Y-1)*9+(X-1)]:=Pack[Y,X];
end;

for Y:=1 to 4 do
for X:=1 to 9 do
begin
Bitmap1 := TBitmap.Create;
Pack[Y,X]:=TCards[(Y-1)*9+(X-1)];
Bitmap1.LoadFromResourceName(hInstance, BitmapName[Pack[Y,X].BPos]);
Form1.Canvas.Draw(_Pos[Y,X].X,_Pos[Y,X].Y,Bitmap1);
Bitmap1.Free;

end;
SB1.Panels[2].Text := "Îñòàëîñü êàðò :" + IntToStr(32 - (Lines[1]+Lines[2]+Lines[3]+Lines[4]));
for Y:=1 to 1 do
for X:=1 to 1 do
if TCards[(Y-1)*9+(X-1)].Card = 9 then
begin
Pack[Y,X].Card:=0;

Form1.Canvas.RoundRect(_Pos[Y,X].X,_Pos[Y,X].Y,_Pos[Y,X].X+WCard,_Pos[Y,X].Y+HCard,6,6);
end else Pack[Y,X]:=TCards[(Y-1)*9+(X-1)];
end;

Procedure Convert(var X,Y:Integer);
Var
X1,Y1 : Integer;
begin
for Y1 := 1 to 4 do
if (_Pos[Y1,1].Y+1 <= Y) AND (Y < _Pos[Y1,1].Y+HCard+1) then Break;
for X1 := 1 to 9 do
if (_Pos[1,X1].X+1 <= X) AND (X < _Pos[1,X1].X+WCard+1) then Break;
X:=X1;
Y:=Y1
end;

procedure TForm1.FormPaint(Sender: TObject);
var
Bitmap1 : TBitmap;
X,Y : Byte;
ShiftX,
ShiftY : Byte;
begin
Form1.ClientHeight := 450;
Form1.ClientWidth := 350;
ShiftY := 20;
if GetSystemMetrics(SM_CXFULLSCREEN) < 800
then ShiftX := 7
else ShiftX := 20;
for Y:=1 to 4 do
for X:=1 to 9 do
begin
_Pos[Y,X].X := _PosC[Y,X].X + ShiftX;
_Pos[Y,X].Y := _PosC[Y,X].Y + ShiftY;
end;
for Y:=1 to 4 do
for X:=1 to 9 do
if Pack[Y,X].Card=0 then
with Form1.Canvas do
begin
Pen.Width := 1;
Pen.Color := $00808040;
Brush.Color := clGreen;
RoundRect(_Pos[Y,X].X,_Pos[Y,X].Y,_Pos[Y,X].X+WCard,_Pos[Y,X].Y+HCard,6,6);
end else
begin
Bitmap1 := TBitmap.Create;
Bitmap1.LoadFromResourceName(hInstance, BitmapName[Pack[Y,X].BPos]);
Form1.Canvas.Draw(_Pos[Y,X].X,_Pos[Y,X].Y,Bitmap1);
Bitmap1.Free;
end;
end;

end.

StarLine(x, y, 30,Form1.Canvas);
где указываешь, там и рисуешь

← →
caps14 (2009-08-12 12:16) [13]

спасибо, то есть вместо Form1.Canvas написать Image1.Canvas?

перемещение изображений по форме Найти похожие ветки