Ich möchte einen Picture-Picker bauen .
Urzustand ist ein normales Form mit einer Paintbox , die am Formrahmen verankert ist.
Auf Button-Klick soll an der Position der Paintbox ein Loch entstehen und bei erneutem Click alles in den Ursprung zurück versetzt werden.
Wichtig ist auch , das das Form-Resize sowohl mit Loch drinn , als auch im Orginalzustand funktionieren muss.
Das ganze Form muss sich auf dem Bildschirm verschieben lassen .
Das Form soll dann in der Application z.B. per Funktionstaste F-X aufpoppen und Stay-On-Top sein , also über der App schweben.
Das Form mit dem Loch darin sollte dann wie ein Bilderrahmen positioniert und vergrößert werden können , um einen bestimmten Bildausschnitt per Screenshot picken zu können .
Während der Screnn-Shot gemacht wird , sollte die Form kurz unsichtbar gemacht werden , damit man die Form selber nicht mit im Screenshot-Bild hat .
Ist das Screenshot-Bild gemacht , soll die Form auf Normalmodus schalten und das Pickbild in die Paintbox zeichnen .
Dann kann man dort noch was reinmalen und alles wegspeichern.
Bezüglich des Lochs im Form habe auch mal einen ersten Code geproggt , siehe unten .
Verwende dafür die Funktionen (CreateRectRgn , CombineRgn , SetWindowRgn) .
Es wird ein Loch gemacht und auf erneuten Button-Klick zurück in den Orginalzustand.
Problem:
Die Funktion SetWindowRgn erzeugt ein Aussehen wie zu Windows XP-Zeiten.
Positionen der Komponeneten werden verschoben , der Form-Rahmen wird rechts und unten abgeschnitten , so das man die Form nicht Resizen kann.
1) Kann man das ändern ?
2) Gibt es eine andere Möglichkeit ein Loch zu machen ?
3) Sollte unter WIN und Linux laufen
Gruß
Frank
Code: Alles auswählen
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls ,
LCLIntf,LCLType, ExtCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
PaintBox1: TPaintBox;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
private
public
loch:boolean;
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var
region1, region2: hrgn;
begin
if loch
then
begin
region1 := CreateRectRgn(0, 0, Width, Height);
region2 := CreateRectRgn(paintbox1.Left,
paintbox1.top,
paintbox1.Width,
paintbox1.Height);
CombineRgn(region1, region1, region2, RGN_DIFF);
SetWindowRgn(Handle, region1, True);
end
else
SetWindowRgn(Handle,0,True);
loch:= not loch;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
loch:=true;
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
paintbox1.Canvas.Brush.Color:=cllime;
paintbox1.Canvas.FillRect(Rect(0,0,paintbox1.width,paintbox1.height));
end;
end.
Picture_Picker_1.zip- (105.98 KiB) 226-mal heruntergeladen
Verein
Links
Suche