unit fPersonPictureEdit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, DBCtrls, ExtCtrls, ExtDlgs, jpeg,
sPanel, sGroupBox, odPanel, odPanelCustomPerson, odPanelMember, ComCtrls, sComboBoxes, acShellCtrls, sListView, sTreeView;
type
TFormPersonPictureEdit =
class(TForm)
PanelMain: TPanel;
sPanel2: TPanel;
ImageMain: TImage;
PLO: TImage;
PRO: TImage;
PLU: TImage;
PRU: TImage;
PO: TImage;
PR: TImage;
PU: TImage;
PL: TImage;
Shape: TShape;
BitBtnSpielerBildDateiOeffnen: TBitBtn;
ButtonShapePositionieren: TButton;
ButtonBildUebernehmen: TButton;
ImageTmp: TImage;
sGroupBoxBitmap: TGroupBox;
sGroupBoxNewBitmap: TGroupBox;
sPanel1: TPanel;
ImageResult: TImage;
Panel1: TPanel;
ImageOld: TImage;
Panel2: TPanel;
BitBtn2: TBitBtn;
BitBtn1: TBitBtn;
Panel3: TPanel;
Panel4: TPanel;
sShellComboBox: TsShellComboBox;
sShellTreeView: TsShellTreeView;
Panel5: TPanel;
sShellListView: TsShellListView;
procedure AutoSelect;
procedure BitBtnSpielerBildDateiOeffnenClick(Sender: TObject);
procedure ShapeMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ShapeMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ShapeMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure ShapeContextPopup(Sender: TObject; MousePos: TPoint;
var Handled: Boolean);
procedure BitBtnSpielerBildLoeschenClick(Sender: TObject);
procedure ButtonBildUebernehmenClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure PMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure PMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure PMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ButtonShapePositionierenClick(Sender: TObject);
procedure ImageMainMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ImageMainMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ImageMainMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure OpenPictureFile(PictureFileName:
String);
virtual;
procedure sShellListViewClick(Sender: TObject);
procedure sShellListViewChange(Sender: TObject; Item: TListItem; Change: TItemChange);
private
{ Private-Deklarationen }
public
AutoSelectFlag: Boolean;
end;
TCanvasShape =
class(TShape)
private
{ private-Deklarationen }
protected
{ protected-Deklarationen }
public
{ public-Deklarationen }
function CopyCanvas: TCanvas;
published
{ published-Deklarationen }
end;
var
FormPersonPictureEdit: TFormPersonPictureEdit;
MouseDownFlag: Boolean = False;
MX, MY, C: Integer;
PathPicture:
String = '
';
implementation
uses
Math, ssGraphics, ssFiles, ShlObj, iStahliSport;
const
PS = 12;
PSH = PS
div 2;
{$R *.dfm}
procedure TFormPersonPictureEdit.AutoSelect;
var
F: Real;
begin
AutoSelectFlag := False;
if ImageMain.Picture.Bitmap.Width > ImageMain.Picture.Bitmap.Height
then
begin
F := ImageMain.Picture.Bitmap.Height / ImageMain.Picture.Bitmap.Width;
Shape.Width := Round(PanelMain.Width * F);
Shape.Height := Round(PanelMain.Height * F);
end
else if ImageMain.Picture.Bitmap.Width < ImageMain.Picture.Bitmap.Height
then
begin
F := ImageMain.Picture.Bitmap.Width / ImageMain.Picture.Bitmap.Height;
Shape.Width := Round(PanelMain.Width * F);
Shape.Height := Round(PanelMain.Height * F);
end
else
begin
Shape.Width := PanelMain.Width;
Shape.Height := PanelMain.Height;
end;
Shape.Left := 0;
Shape.Top := 0;
ButtonShapePositionierenClick(Self);
end;
procedure TFormPersonPictureEdit.BitBtnSpielerBildDateiOeffnenClick(Sender: TObject);
begin
// if PathPicture = '' then
// PathPicture := GetSpecialFolder(0, CSIDL_MYPICTURES);
// OpenPictureDialog.InitialDir := PathPicture;
// OpenPictureDialog.FileName := '*.bmp; *.jpg';
// if OpenPictureDialog.Execute then
// begin
// PathPicture := ExtractFilePath(OpenPictureDialog.FileName);
// OpenPictureFile(OpenPictureDialog.FileName);
// end;
// ButtonBildUebernehmenClick(Self);
// AutoSelect;
end;
procedure TFormPersonPictureEdit.BitBtnSpielerBildLoeschenClick(Sender: TObject);
begin
ImageResult.Picture.Bitmap.FreeImage;
end;
procedure TFormPersonPictureEdit.ButtonBildUebernehmenClick(Sender: TObject);
var
L, T, W, H: Integer;
DR, SR: TRect;
HF, VF, F: Real;
begin
HF := ImageMain.Width / Max(ImageMain.Picture.Bitmap.Width, 1);
VF := ImageMain.Height / Max(ImageMain.Picture.Bitmap.Height, 1);
if HF < VF
then
F := HF
else
F := VF;
L := Round(Shape.Left / F);
T := Round(Shape.Top / F);
W := Round(Shape.Width / F);
H := Round(Shape.Height / F);
if W < H
then
W := H;
if H < W
then
H := W;
ImageTmp.Width := W;
ImageTmp.Height := H;
ImageTmp.Picture.Bitmap.Width := W;
ImageTmp.Picture.Bitmap.Height := H;
DR.Left := 0;
DR.Top := 0;
DR.Right := W;
DR.Bottom := H;
SR.Left := L;
SR.Top := T;
SR.Right := L + W;
SR.Bottom := T + H;
ImageTmp.Picture.Bitmap.Canvas.FillRect(ImageTmp.ClientRect);
ImageTmp.Picture.Bitmap.Canvas.CopyRect(DR, ImageMain.Picture.Bitmap.Canvas, SR);
W := 150;
H := 150;
DR.Left := 0;
DR.Top := 0;
DR.Right := W;
DR.Bottom := H;
ImageResult.Picture.Bitmap.Width := W;
ImageResult.Picture.Bitmap.Height := H;
ImageResult.Picture.Bitmap.Canvas.StretchDraw(DR, ImageTmp.Picture.Bitmap);
end;
procedure TFormPersonPictureEdit.ButtonShapePositionierenClick(Sender: TObject);
var
P: TPoint;
DS, DI: Integer;
begin
if (Shape.Width > PanelMain.ClientWidth)
then
begin
Shape.Left := 0;
Shape.Width := PanelMain.ClientWidth;
end;
if (Shape.Height > PanelMain.ClientHeight)
then
begin
Shape.Top := 0;
Shape.Height := PanelMain.ClientHeight;
end;
DS := ((Shape.Left + Shape.Width) - PanelMain.ClientWidth);
if (DS > 0)
then
begin
Shape.Left := (Shape.Left - DS);
DI := (ImageMain.Width - PanelMain.ClientWidth + ImageMain.Left);
if (DI > 0)
then
begin
ImageMain.Left := (ImageMain.Left - Min(DI, DS));
P.X := MX;
P.Y := MY;
P := Shape.ClientToScreen(P);
SetCursorPos(P.X, P.Y);
end;
end;
DS := ((Shape.Top + Shape.Height) - PanelMain.ClientHeight);
if (DS > 0)
then
begin
Shape.Top := (Shape.Top - DS);
DI := (ImageMain.Height - PanelMain.ClientHeight + ImageMain.Top);
if (DI > 0)
then
begin
ImageMain.Top := (ImageMain.Top - Min(DI, DS));
P.X := MX;
P.Y := MY;
P := Shape.ClientToScreen(P);
SetCursorPos(P.X, P.Y);
end;
end;
DS := (-Shape.Left);
if (DS > 0)
then
begin
Shape.Left := (Shape.Left + DS);
DI := (-ImageMain.Left);
if (DI > 0)
then
begin
ImageMain.Left := (ImageMain.Left + Min(DI, DS));
P.X := MX;
P.Y := MY;
P := Shape.ClientToScreen(P);
SetCursorPos(P.X, P.Y);
end;
end;
DS := (-Shape.Top);
if (DS > 0)
then
begin
Shape.Top := (Shape.Top + DS);
DI := (-ImageMain.Top);
if (DI > 0)
then
begin
ImageMain.Top := (ImageMain.Top + Min(DI, DS));
P.X := MX;
P.Y := MY;
P := Shape.ClientToScreen(P);
SetCursorPos(P.X, P.Y);
end;
end;
Shape.Refresh;
PLO.Left := (Shape.Left - PSH);
PLO.Top := (Shape.Top - PSH);
PRU.Left := (Shape.Left + Shape.Width - PSH);
PRU.Top := (Shape.Top + Shape.Height - PSH);
PLU.Left := (Shape.Left - PSH);
PLU.Top := (Shape.Top + Shape.Height - PSH);
PRO.Left := (Shape.Left + Shape.Width - PSH);
PRO.Top := (Shape.Top - PSH);
PL.Left := (Shape.Left - PSH);
PL.Top := (Shape.Top + (Shape.Height
div 2) - PSH);
PR.Left := (Shape.Left + Shape.Width - PSH);
PR.Top := (Shape.Top + (Shape.Height
div 2) - PSH);
PU.Left := (Shape.Left + (Shape.Width
div 2) - PSH);
PU.Top := (Shape.Top + Shape.Height - PSH);
PO.Left := (Shape.Left + (Shape.Width
div 2) - PSH);
PO.Top := (Shape.Top - PSH);
ImageMain.Refresh;
ButtonBildUebernehmenClick(Self);
end;
procedure TFormPersonPictureEdit.FormActivate(Sender: TObject);
begin
// StopClosingForm(Self);
if ((ImageMain.Picture.Graphic =
nil)
or (ImageMain.Picture.Graphic.Empty))
then
BitBtnSpielerBildDateiOeffnenClick(Self);
if AutoSelectFlag
then
AutoSelect;
if PathPicture = '
'
then
PathPicture := GetSpecialFolder(0, CSIDL_MYPICTURES);
if sShellTreeView.Tag = 0
then
begin
sShellTreeView.Path := PathPicture;
sShellTreeView.Tag := 1;
end;
end;
procedure TFormPersonPictureEdit.FormCreate(Sender: TObject);
begin
sShellComboBox.Align := alClient;
PanelMain.DoubleBuffered := True;
Shape.Left := ((PanelMain.Width
div 2) - (Shape.Width
div 2));
Shape.Top := ((PanelMain.Height
div 2) - (Shape.Height
div 2));
ButtonShapePositionierenClick(Self);
Refresh;
ButtonBildUebernehmenClick(Self);
// OpenPictureDialog.OnShow := FormTurniere.OpenDialogShow;
// OpenPictureDialog.OnClose := FormTurniere.OpenDialogClose;
PLO.Width := PS;
PLO.Height := PS;
PLO.BringToFront;
PRU.Width := PS;
PRU.Height := PS;
PRU.BringToFront;
PLU.Width := PS;
PLU.Height := PS;
PLU.BringToFront;
PRO.Width := PS;
PRO.Height := PS;
PRO.BringToFront;
PL.Width := PS;
PL.Height := PS;
PL.BringToFront;
PR.Width := PS;
PR.Height := PS;
PR.BringToFront;
PU.Width := PS;
PU.Height := PS;
PU.BringToFront;
PO.Width := PS;
PO.Height := PS;
PO.BringToFront;
end;
procedure TFormPersonPictureEdit.ImageMainMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
P: TPoint;
begin
ImageMain.Cursor := crHandPoint;
MouseDownFlag := True;
Shape.Pen.Color := clBlue;
P.X := X;
P.Y := Y;
P := ImageMain.ClientToScreen(P);
P := PanelMain.ScreenToClient(P);
MX := P.X;
MY := P.Y;
Shape.Left := (MX - (Shape.Width
div 2));
Shape.Top := (MY - (Shape.Height
div 2));
MX := (Shape.Width
div 2);
MY := (Shape.Height
div 2);
ButtonShapePositionierenClick(Self);
end;
procedure TFormPersonPictureEdit.ImageMainMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
P: TPoint;
begin
if (MouseDownFlag)
then
begin
P.X := X;
P.Y := Y;
P := ImageMain.ClientToScreen(P);
P := PanelMain.ScreenToClient(P);
Shape.Left := (P.X - MX);
Shape.Top := (P.Y - MY);
ButtonShapePositionierenClick(Self);
end;
end;
procedure TFormPersonPictureEdit.ImageMainMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
MouseDownFlag := False;
ButtonBildUebernehmenClick(Self);
Shape.Pen.Color := clBlack;
ImageMain.Cursor := crCross;
end;
procedure TFormPersonPictureEdit.OpenPictureFile(PictureFileName:
String);
var
Jpg: TJPEGImage;
begin
if IsJPEG(PictureFileName)
then
begin
Jpg := TJPEGImage.Create;
try
Jpg.LoadFromFile(PictureFileName);
ImageMain.Picture.Bitmap.Assign(Jpg);
finally
FreeAndNil(Jpg);
end;
end
else
begin
ImageMain.Picture.LoadFromFile(PictureFileName);
end;
ImageMain.Transparent := ImageMain.Picture.Bitmap.Empty;
ButtonBildUebernehmenClick(Self);
end;
procedure TFormPersonPictureEdit.PMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
MouseDownFlag := True;
Shape.Pen.Color := clBlue;
MX := 0;
MY := 0;
end;
procedure TFormPersonPictureEdit.PMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
P: TPoint;
MP: TImage;
PX, PY, LX, LY, L, ZX, ZY: Integer;
begin
if (MouseDownFlag)
then
begin
MP := TImage(Sender);
P.X := X;
P.Y := Y;
P := MP.ClientToScreen(P);
P := PanelMain.ScreenToClient(P);
PX := P.X;
PY := P.Y;
if (MP.
Name = '
PRU')
then
begin
LX := Max((PX - Shape.Left), 16);
LY := Max((PY - Shape.Top), 16);
L := Max(LX, LY);
Shape.Width := L;
Shape.Height := L;
end;
if (MP.
Name = '
PRO')
then
begin
LX := Max((PX - Shape.Left), 16);
LY := Max(((Shape.Top + Shape.Height) - PY), 16);
L := Max(LX, LY);
Shape.Top := (Shape.Top + Shape.Height - L);
Shape.Width := L;
Shape.Height := L;
end;
if (MP.
Name = '
PLO')
then
begin
LX := Max(((Shape.Left + Shape.Width) - PX), 16);
LY := Max(((Shape.Top + Shape.Height) - PY), 16);
L := Max(LX, LY);
Shape.Top := (Shape.Top + Shape.Height - L);
Shape.Left := (Shape.Left + Shape.Width - L);
Shape.Width := L;
Shape.Height := L;
end;
if (MP.
Name = '
PLU')
then
begin
LX := Max(((Shape.Left + Shape.Width) - PX), 16);
LY := Max((PY - Shape.Top), 16);
L := Max(LX, LY);
Shape.Left := (Shape.Left + Shape.Width - L);
Shape.Width := L;
Shape.Height := L;
end;
if (MP.
Name = '
PR')
then
begin
ZX := (Shape.Left + (Shape.Width
div 2));
ZY := (Shape.Top + (Shape.Height
div 2));
LX := Max((PX - ZX), 16);
// LY:=Max((PY-ZY),16);
L := LX;
Shape.Width := (L * 2);
Shape.Height := (L * 2);
Shape.Left := (ZX - L);
Shape.Top := (ZY - L);
end;
if (MP.
Name = '
PO')
then
begin
ZX := (Shape.Left + (Shape.Width
div 2));
ZY := (Shape.Top + (Shape.Height
div 2));
// LX:=Max((ZX-PX),16);
LY := Max((ZY - PY), 16);
L := LY;
Shape.Width := (L * 2);
Shape.Height := (L * 2);
Shape.Left := (ZX - L);
Shape.Top := (ZY - L);
end;
if (MP.
Name = '
PL')
then
begin
ZX := (Shape.Left + (Shape.Width
div 2));
ZY := (Shape.Top + (Shape.Height
div 2));
LX := Max((ZX - PX), 16);
// LY:=Max((ZY-PY),16);
L := LX;
Shape.Width := (L * 2);
Shape.Height := (L * 2);
Shape.Left := (ZX - L);
Shape.Top := (ZY - L);
end;
if (MP.
Name = '
PU')
then
begin
ZX := (Shape.Left + (Shape.Width
div 2));
ZY := (Shape.Top + (Shape.Height
div 2));
// LX:=Max((PX-ZX),16);
LY := Max((PY - ZY), 16);
L := LY;
Shape.Width := (L * 2);
Shape.Height := (L * 2);
Shape.Left := (ZX - L);
Shape.Top := (ZY - L);
end;
ButtonShapePositionierenClick(Self);
end;
end;
procedure TFormPersonPictureEdit.PMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
MouseDownFlag := False;
ButtonBildUebernehmenClick(Self);
Shape.Pen.Color := clBlack;
end;
procedure TFormPersonPictureEdit.ShapeContextPopup(Sender: TObject; MousePos: TPoint;
var Handled: Boolean);
begin
ButtonBildUebernehmenClick(Self);
end;
procedure TFormPersonPictureEdit.ShapeMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
MouseDownFlag := True;
Shape.Pen.Color := clBlue;
MX := X;
MY := Y;
end;
procedure TFormPersonPictureEdit.ShapeMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
P: TPoint;
begin
if (MouseDownFlag)
then
begin
P.X := X;
P.Y := Y;
P := Shape.ClientToScreen(P);
P := PanelMain.ScreenToClient(P);
Shape.Left := (P.X - MX);
Shape.Top := (P.Y - MY);
ButtonShapePositionierenClick(Self);
end;
end;
procedure TFormPersonPictureEdit.ShapeMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
MouseDownFlag := False;
ButtonBildUebernehmenClick(Self);
Shape.Pen.Color := clBlack;
end;
procedure TFormPersonPictureEdit.sShellListViewChange(Sender: TObject; Item: TListItem; Change: TItemChange);
begin
if sShellListView.Selected <>
nil then
begin
if sShellListView.SelectedFolder.IsFile
then
begin
PathPicture := ExtractFilePath(sShellListView.SelectedFolder.PathName);
OpenPictureFile(sShellListView.SelectedFolder.PathName);
ButtonBildUebernehmenClick(Self);
AutoSelect;
end;
end;
end;
procedure TFormPersonPictureEdit.sShellListViewClick(Sender: TObject);
begin
end;
{ TCanvasShape }
function TCanvasShape.CopyCanvas: TCanvas;
begin
Result := Canvas;
end;
end.