Kod: Tümünü seç
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dieser Tip enthält eine Klasse mit der man zur Laufzeit Komponenten
in der Größe verändern bzw verschieben kann so wie man es aus der
Entwicklungsumgebung her gewohnt ist.
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
This Tip provides a tool class that implements the functionality of
moving or resizing any component at runtime (as in the IDE)
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
//Als eigne Unit
unit Egal;
interface
uses Controls, ExtCtrls, QGraphics, Classes, SysUtils, StdCtrls;
type
Markierungen = class
constructor Create(Komponente: TControl);
destructor Destroy();
private
panels: array[0..7] of TPanel;
LblPos: TPanel;
Komp: TControl;
FDownX, FDownY: Integer;
FDragging: Boolean;
OrgMDown, OrgMUp: TMouseEvent;
OrgMMove: TMouseMoveEvent;
OrgMClick: TNotifyEvent;
procedure panelsMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure panelsMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure panelsMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure NewPos();
end;
implementation
type
TMoveCracker = class(TControl);
constructor Markierungen.Create(Komponente: TControl);
var
i: Byte;
begin
Komp := Komponente;
for i := 0 to 7 do
begin //Die acht Markierungspunkte erstellen.
panels[i] := TPanel.Create(Komponente);
panels[i].Parent := Komponente.Parent;
panels[i].Width := 5;
panels[i].Height := 5;
panels[i].Color := clBlack;
panels[i].BevelOuter := bvNone;
panels[i].OnMouseDown := panelsMouseDown;
panels[i].OnMouseMove := panelsMouseMove;
panels[i].OnMouseUp := panelsMouseUp;
panels[i].Tag := i;
end;
NewPos(); //Die Markierungen an die richtige Position bringen
OrgMDown := TPanel(Komp).OnMouseDown; //Sicheren der orginalen Mousereignisse
OrgMUp := TPanel(Komp).OnMouseUp;
OrgMMove := TPanel(Komp).OnMouseMove;
OrgMClick := TPanel(Komp).OnClick;
TPanel(Komp).OnClick := nil; //für funktionen benötige Ereignisse zuweisen
TPanel(Komp).OnMouseDown := panelsMouseDown;
TPanel(Komp).OnMouseUp := panelsMouseUp;
TPanel(Komp).OnMouseMove := panelsMouseMove;
LblPos := TPanel.Create(Komp); //gibt beim Verschieben größe bzw Position an
with LblPos do
begin
Parent := Komp.Parent;
Visible := False;
BevelOuter := bvNone;
Color := clYellow;
Height := 16;
Width := 50;
end;
end;
procedure Markierungen.NewPos();
begin
panels[0].Left := Komp.Left - 2;
panels[0].Top := Komp.Top - 2;
panels[1].Left := Komp.Left + Komp.Width div 2;
panels[1].Top := Komp.Top - 2;
panels[2].Left := Komp.Left + Komp.Width - 2;
panels[2].Top := Komp.Top - 2;
panels[3].Left := Komp.Left + Komp.Width - 2;
panels[3].Top := Komp.Top + Komp.Height - 2;
panels[4].Left := Komp.Left + Komp.Width div 2;
panels[4].Top := Komp.Top + Komp.Height - 2;
panels[5].Left := Komp.Left - 2;
panels[5].Top := Komp.Top + Komp.Height - 2;
panels[6].Left := Komp.Left - 2;
panels[6].Top := Komp.Top + Komp.Height div 2 - 1;
panels[7].Left := Komp.Left + Komp.Width - 2;
panels[7].Top := Komp.Top + Komp.Height div 2 - 1;
end;
destructor Markierungen.Destroy();
var
i: Byte;
begin
TPanel(Komp).OnMouseDown := OrgMDown; //Rückgabe der Orginalen Eregnissprozeduren
TPanel(Komp).OnMouseUp := OrgMUp;
TPanel(Komp).OnMouseMove := OrgMMove;
TPanel(Komp).OnClick := OrgMClick;
for i := 0 to 7 do panels[i].Free;
LblPos.Free;
end;
procedure Markierungen.panelsMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); //Funktion aus Swissdelphicenter entnommen
begin //Tip: "Komponenten während der Laufzeit verschieben?"
FDownX := X;
FDownY := Y;
FDragging := True;
TMoveCracker(Sender).MouseCapture := True;
LblPos.Visible := True;
end;
procedure Markierungen.panelsMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if FDragging then
with Sender as TControl do
begin
if Sender = Komp then
begin
Left := X - FDownX + Left; //Es wurde direkt auf die Komponente geklickt
Top := Y - FDownY + Top;
LblPos.Caption := '[' + IntToStr(Left) + ',' + IntToStr(Top) + ']';
end
else
begin
case TPanel(Sender).Tag of
0:
begin //oben links
Komp.Top := Y - FDownY + TPanel(Sender).Top + 2;
Komp.Height := Komp.Height - (Y - FDownY);
Komp.Left := X - FDownX + TPanel(Sender).Left + 2;
Komp.Width := Komp.Width - (X - FDownX);
end;
1:
begin //oben mitte
Komp.Top := Y - FDownY + TPanel(Sender).Top + 2;
Komp.Height := Komp.Height - (Y - FDownY);
end;
2:
begin //oben rechts
Komp.Width := X - FDownX + Komp.Width - 2;
Komp.Top := Y - FDownY + TPanel(Sender).Top + 2;
Komp.Height := Komp.Height - (Y - FDownY);
end;
3:
begin //unten rechts
Komp.Width := X - FDownX + Komp.Width - 2;
Komp.Height := Y - FDownY + Komp.Height - 2;
end;
4: Komp.Height := Y - FDownY + Komp.Height - 2; //unten mitte
5:
begin //unten links
Komp.Left := X - FDownX + TPanel(Sender).Left + 2;
Komp.Width := Komp.Width - (X - FDownX);
Komp.Height := Y - FDownY + Komp.Height - 2;
end;
6:
begin //nach links
Komp.Left := X - FDownX + TPanel(Sender).Left + 2;
Komp.Width := Komp.Width - (X - FDownX);
end;
7: Komp.Width := X - FDownX + Komp.Width - 2; //nach rechts
end;
LblPos.Caption := '[' + IntToStr(Komp.Width) + ',' + IntToStr(Komp.Height) + ']';
end;
newPos(); //zum Nachführen der Markierungspanel
LblPos.Left := TControl(Sender).Left + X;
LblPos.Top := TControl(Sender).Top + Y + 20;
LblPos.BringToFront;
LblPos.Refresh;
end;
end;
procedure Markierungen.panelsMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); //Funktion aus Swissdelphicenter entnommen
begin //Tip: "Komponenten während der Laufzeit verschieben?"
if FDragging then
begin
FDragging := False;
TMoveCracker(Sender).MouseCapture := False;
LblPos.Visible := False;
end;
end;
end.
//In eigenes Programm muss nur noch:
uses Egal;
var
Veraendern: Markierungen;
//In diesem Beispiel über ein Onclickereigniss welches jedes auf dem Form befindliche
//Komponente und das Form selbst bekommt. (Auf Komponente Klicken löst Möglichkeit
//zum größe ändern und verschieben aus und ein Klick wo anders beendet sie wieder.
procedure TForm1.FormClick(Sender: TObject);
begin if Assigned(Veraendern) then
begin
Veraendern.Destroy;
Veraendern := nil;
end
else
Veraendern := Markierungen.Create(TControl(Sender));
end;
//Will man eine PaintBox benutzen muss man diese noch sichtbar machen.
//Z.B. so:
procedure TForm1.FormShow(Sender: TObject);
begin PaintBox1Paint(Sender);
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin with PaintBox1 do
begin
Canvas.Pen.Style := psDash;
Canvas.Rectangle(0, 0, Width, Height);
end;
end;
