Hallo Allerseits,
in Delphi 5 versuche ich einen durchsichtigen Selektionsrahmen zu basteln.
Dieser Rahmen soll für die Selektion von Steuerelementen auf dem Formular zur Laufzeit dienen. Der einfache Selektionsrahmen mit dem Pen und XOR-Trick ist mir zu simpel.
Der erste Schritt den ich erst einmal hinbekommen möchte ist ein Rahmen der sich ziehen lässt. Das ist schon soweit, eingeschränkt, gelungen.
Vielleicht könnte sich jemand von euch das mal anschauen und ausprobieren, was ich zusammenprogrammiert habe.
Wenn dieser Schritt soweit funktioniert, statte ich die Paint-Mehtode mit einer Tranzparent-Zeichen-Methode aus.
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
| unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, extctrls,
StdCtrls;
type
TForm1 = class(TForm)
imgSelektion: TPaintBox;
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure imgSelektionPaint(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
var
posx,posy: Integer;
mouseButtonDown: Boolean;
bmpSelektion: TBitmap;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button=mbLeft then
begin
mouseButtonDown := true;
posx:=X;
posy:=Y;
imgSelektion.Left := posx;
imgSelektion.Top := posy;
imgSelektion.Visible := true;
end;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if mouseButtonDown then
begin
imgSelektion.Width := X-posx;
imgSelektion.Height := Y-posy;
imgSelektionPaint(imgSelektion);
end;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
mouseButtonDown := false;
imgSelektion.Visible := false;
imgSelektion.Width := 0;
imgSelektion.Height := 0;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
bmpSelektion := TBitmap.Create;
imgSelektion.Width := 0;
imgSelektion.Height := 0;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
bmpSelektion.Free;
end;
procedure TForm1.imgSelektionPaint(Sender: TObject);
begin
bmpSelektion.Width := abs(imgSelektion.Width);
bmpSelektion.Height := abs(imgSelektion.Height);
with bmpSelektion.Canvas do
begin
Brush.Color := clGreen;
Brush.Style := bsDiagCross;
FillRect(ClipRect);
Pen.Color := clWhite;
MoveTo(0,0);
LineTo(bmpSelektion.Width,bmpSelektion.Height);
imgSelektion.Canvas.Draw(0,0,bmpSelektion);
end;
end;
end. |
Der Vollständikeit halber schreibe ich noch was jetzt nicht stimmt. Irgendwie funktioniert nicht die Doppelpufferung, wodurch das Bild beim neuzeichnen noch immer flackert. Das zeichnen funktioniert nur in positiver Richtung sprich in Richtung:
[AktuelleMausPosition]>[MausKlickPosition]
Weiß einer wie man das beheben kann?
Moderiert von 
AXMD: Beiträge zusammengefasst
