5,7 → 5,15 |
{$INCLUDE DelphiXcfg.inc} |
|
uses |
Windows, Messages, SysUtils, Classes, Controls, Forms, MMSystem, DirectX; |
Windows, Messages, SysUtils, Classes, Controls, Forms, MMSystem, Graphics, {$IFDEF _DMO_}MultiMon,{$ENDIF} |
{$IfDef StandardDX} |
{$IfDef DX9} |
Direct3D, DirectInput, |
{$EndIf} |
DirectDraw, DirectSound; |
{$Else} |
DirectX; |
{$EndIf} |
|
type |
|
50,6 → 58,46 |
property Drivers[Index: Integer]: TDirectXDriver read GetDriver; default; |
end; |
|
{$IFDEF _DMO_} |
{ TDirectXDriverEx } |
|
TDirectXDriverEx = class(TCollectionItem) |
private |
FGUID: PGUID; |
FGUID2: TGUID; |
FDescription: string; |
FDriverName: string; |
FMonitor: HMonitor; |
FMonitorInfo: TMonitorInfo; |
procedure SetGUID(Value: PGUID); |
function ConvertHMonitor(iMonitor: HMonitor): TMonitorInfo; |
function GetMonitorInfo: TMonitorInfo; |
function GetFlags: DWORD; |
function GetTempSpace: TRect; |
function GetWorkSpace: TRect; |
public |
property GUID: PGUID read FGUID write SetGUID; |
property Monitor: HMonitor read FMonitor write FMonitor; |
property MonitorInfo: TMonitorInfo read GetMonitorInfo; |
published |
property Description: string read FDescription write FDescription; |
property DriverName: string read FDriverName write FDriverName; |
property WorkSpace: TRect read GetWorkSpace; |
property TempSpace: TRect read GetTempSpace; |
property Flags: DWORD read GetFlags; |
end; |
|
{ TDirectXDriversEx } |
|
TDirectXDriversEx = class(TCollection) |
private |
function GetDriver(Index: Integer): TDirectXDriverEx; |
public |
constructor Create; |
property Drivers[Index: Integer]: TDirectXDriverEx read GetDriver; default; |
end; |
{$ENDIF} |
|
{ TDXForm } |
|
TDXForm = class(TForm) |
170,20 → 218,137 |
function IndexOf(const Name: string): Integer; |
end; |
|
function Max(Val1, Val2: Integer): Integer; |
function Min(Val1, Val2: Integer): Integer; |
{Addapted from RXLib.PicClip} |
|
{ TPicClip } |
TCellRange = 1..MaxInt; |
|
TDXPictureClip = class(TComponent) |
private |
FPicture: TPicture; |
FRows: TCellRange; |
FCols: TCellRange; |
FBitmap: TBitmap; |
FMasked: Boolean; |
FMaskColor: TColor; |
FOnChange: TNotifyEvent; |
procedure CheckIndex(Index: Integer); |
function GetCell(Col, Row: Cardinal): TBitmap; |
function GetGraphicCell(Index: Integer): TBitmap; |
function GetDefaultMaskColor: TColor; |
function GetIsEmpty: Boolean; |
function GetCount: Integer; |
function GetHeight: Integer; |
function GetWidth: Integer; |
function IsMaskStored: Boolean; |
procedure PictureChanged(Sender: TObject); |
procedure SetHeight(Value: Integer); |
procedure SetPicture(Value: TPicture); |
procedure SetWidth(Value: Integer); |
procedure SetMaskColor(Value: TColor); |
protected |
procedure AssignTo(Dest: TPersistent); override; |
procedure Changed; dynamic; |
public |
constructor Create(AOwner: TComponent); override; |
destructor Destroy; override; |
procedure Assign(Source: TPersistent); override; |
function GetIndex(Col, Row: Cardinal): Integer; |
procedure Draw(Canvas: TCanvas; X, Y, Index: Integer); |
procedure DrawCenter(Canvas: TCanvas; Rect: TRect; Index: Integer); |
property Cells[Col, Row: Cardinal]: TBitmap read GetCell; |
property GraphicCell[Index: Integer]: TBitmap read GetGraphicCell; |
property IsEmpty: Boolean read GetIsEmpty; |
property Count: Integer read GetCount; |
published |
property Cols: TCellRange read FCols write FCols default 1; |
property Height: Integer read GetHeight write SetHeight stored False; |
property Masked: Boolean read FMasked write FMasked default True; |
property Rows: TCellRange read FRows write FRows default 1; |
property Picture: TPicture read FPicture write SetPicture; |
property MaskColor: TColor read FMaskColor write SetMaskColor stored IsMaskStored; |
property Width: Integer read GetWidth write SetWidth stored False; |
property OnChange: TNotifyEvent read FOnChange write FOnChange; |
end; |
|
function Max(Val1, Val2: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF} |
function Min(Val1, Val2: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF} |
|
function Cos256(i: Integer): Double; |
function Sin256(i: Integer): Double; |
|
function PointInRect(const Point: TPoint; const Rect: TRect): Boolean; |
function RectInRect(const Rect1, Rect2: TRect): Boolean; |
function OverlapRect(const Rect1, Rect2: TRect): Boolean; |
function PointInRect(const Point: TPoint; const Rect: TRect): Boolean; {$IFDEF VER9UP}inline;{$ENDIF} |
function RectInRect(const Rect1, Rect2: TRect): Boolean; {$IFDEF VER9UP}inline;{$ENDIF} |
function OverlapRect(const Rect1, Rect2: TRect): Boolean; {$IFDEF VER9UP}inline;{$ENDIF} |
|
function WideRect(ALeft, ATop, AWidth, AHeight: Integer): TRect; |
function WideRect(ALeft, ATop, AWidth, AHeight: Integer): TRect; {$IFDEF VER9UP}inline;{$ENDIF} |
|
{ Transformations routines} |
|
const |
L_Curve = 0;//The left curve |
R_Curve = 1;//The right curve |
|
C_Add = 0;//Increase (BTC) |
C_Dec = 1;//Decrease (ETC) |
|
Type |
TDblPoint = packed record |
X, Y: Double; |
end; |
TSngPoint = packed record //SinglePoint |
X, Y: Single; |
end; |
|
|
//Transformation matrix |
T2DRowCol = Array[1..3] of Array[1..3] of Double; |
T2DVector = Array[1..3] of Double; |
//Distance between 2 points |
function Get2PointRange(a,b: TDblPoint):Double; |
//From vector angular calculation |
function Get256(dX,dY: Double):Double; |
//The angular calculation of the A from B |
function GetARadFromB(A,B: TDblPoint):Double; |
|
//It calculates the TDblPoint |
function DblPoint(a,b:Double):TDblPoint; |
//It converts the TDboPoint to the TPoint |
function TruncDblPoint(DblPos: TDblPoint): TPoint; |
|
function GetPointFromRangeAndAngle(SP: TDblPoint; Range,Angle: Double): TDblPoint; |
|
function Ini2DRowCol: T2DRowCol; |
function Trans2DRowCol(x,y:double):T2DRowCol; |
function Scale2DRowCol(x,y:double):T2DRowCol; |
function Rotate2DRowCol(Theta:double):T2DRowCol; |
function RotateIntoX2DRowCol(x,y: double):T2DRowCol; |
function Multiply2DRowCol(A,B:T2DRowCol):T2DRowCol; |
function ScaleAt2DRowCol(x,y,Sx,Sy:double):T2DRowCol; |
function ReflectAcross2DRowCol(x,y,dx,dy:Double): T2DRowCol; |
function Apply2DVector(V:T2DVector; M:T2DRowCol): T2DVector; |
function RotateAround2DRowCol(x,y,Theta:Double): T2DRowCol; |
|
//Collision decision |
function PointInCircle(PPos,CPos: TPoint; R: integer): Boolean; |
function CircleInCircle(C1Pos,C2Pos: TPoint; R1,R2:Integer): Boolean; |
function SegmentInCircle(SPos,EPos,CPos: TPoint; R: Integer): Boolean; |
|
//If A is closer than B from starting point S, the True is returned. |
function CheckNearAThanB(S,A,B: TDblPoint): Boolean; |
|
//The Angle of 256 period is returned |
function Angle256(Angle: Single): Single; |
|
{ Support functions } |
|
procedure ReleaseCom(out Com); |
function DXLoadLibrary(const FileName, FuncName: string): TFarProc; |
|
{ Simple helper } |
|
procedure Log(const Co: string; const FName: string{$IFDEF VER4UP} = 'c:\logerr.txt'{$ENDIF}); |
|
implementation |
|
uses DXConsts; |
690,8 → 855,763 |
Result := -1; |
end; |
|
{ TDXPictureClip } |
|
constructor TDXPictureClip.Create(AOwner: TComponent); |
begin |
inherited Create(AOwner); |
FPicture := TPicture.Create; |
FPicture.OnChange := PictureChanged; |
FBitmap := TBitmap.Create; |
FRows := 1; |
FCols := 1; |
FMaskColor := GetDefaultMaskColor; |
FMasked := True; |
end; |
|
destructor TDXPictureClip.Destroy; |
begin |
FOnChange := nil; |
FPicture.OnChange := nil; |
FBitmap.Free; |
FPicture.Free; |
inherited Destroy; |
end; |
|
procedure TDXPictureClip.Assign(Source: TPersistent); |
begin |
if Source is TDXPictureClip then begin |
with TDXPictureClip(Source) do begin |
Self.FRows := Rows; |
Self.FCols := Cols; |
Self.FMasked := Masked; |
Self.FMaskColor := MaskColor; |
Self.FPicture.Assign(FPicture); |
end; |
end |
else if (Source is TPicture) or (Source is TGraphic) then |
FPicture.Assign(Source) |
else inherited Assign(Source); |
end; |
|
type |
THack = class(TImageList); |
|
procedure TDXPictureClip.AssignTo(Dest: TPersistent); |
var |
I: Integer; |
SaveChange: TNotifyEvent; |
begin |
if (Dest is TPicture) then Dest.Assign(FPicture) |
else if (Dest is TImageList) and not IsEmpty then begin |
with TImageList(Dest) do begin |
SaveChange := OnChange; |
try |
OnChange := nil; |
Clear; |
Width := Self.Width; |
Height := Self.Height; |
for I := 0 to Self.Count - 1 do begin |
if Self.Masked and (MaskColor <> clNone) then |
TImageList(Dest).AddMasked(GraphicCell[I], MaskColor) |
else TImageList(Dest).Add(GraphicCell[I], nil); |
end; |
Masked := Self.Masked; |
finally |
OnChange := SaveChange; |
end; |
THack(Dest).Change; |
end; |
end |
else inherited AssignTo(Dest); |
end; |
|
procedure TDXPictureClip.Changed; |
begin |
if Assigned(FOnChange) then FOnChange(Self); |
end; |
|
function TDXPictureClip.GetIsEmpty: Boolean; |
begin |
Result := not Assigned(Picture) or Picture.Graphic.Empty; |
end; |
|
function TDXPictureClip.GetCount: Integer; |
begin |
if IsEmpty then Result := 0 |
else Result := Cols * Rows; |
end; |
const |
{ TBitmap.GetTransparentColor from GRAPHICS.PAS uses this value } |
PaletteMask = $02000000; |
|
procedure TDXPictureClip.Draw(Canvas: TCanvas; X, Y, Index: Integer); |
|
function PaletteColor(Color: TColor): Longint; |
begin |
Result := ColorToRGB(Color) or PaletteMask; |
end; |
procedure StretchBltTransparent(DstDC: HDC; DstX, DstY, DstW, DstH: Integer; |
SrcDC: HDC; SrcX, SrcY, SrcW, SrcH: Integer; Palette: HPalette; |
TransparentColor: TColorRef); |
var |
Color: TColorRef; |
bmAndBack, bmAndObject, bmAndMem, bmSave: HBitmap; |
bmBackOld, bmObjectOld, bmMemOld, bmSaveOld: HBitmap; |
MemDC, BackDC, ObjectDC, SaveDC: HDC; |
palDst, palMem, palSave, palObj: HPalette; |
begin |
{ Create some DCs to hold temporary data } |
BackDC := CreateCompatibleDC(DstDC); |
ObjectDC := CreateCompatibleDC(DstDC); |
MemDC := CreateCompatibleDC(DstDC); |
SaveDC := CreateCompatibleDC(DstDC); |
{ Create a bitmap for each DC } |
bmAndObject := CreateBitmap(SrcW, SrcH, 1, 1, nil); |
bmAndBack := CreateBitmap(SrcW, SrcH, 1, 1, nil); |
bmAndMem := CreateCompatibleBitmap(DstDC, DstW, DstH); |
bmSave := CreateCompatibleBitmap(DstDC, SrcW, SrcH); |
{ Each DC must select a bitmap object to store pixel data } |
bmBackOld := SelectObject(BackDC, bmAndBack); |
bmObjectOld := SelectObject(ObjectDC, bmAndObject); |
bmMemOld := SelectObject(MemDC, bmAndMem); |
bmSaveOld := SelectObject(SaveDC, bmSave); |
{ Select palette } |
palDst := 0; palMem := 0; palSave := 0; palObj := 0; |
if Palette <> 0 then begin |
palDst := SelectPalette(DstDC, Palette, True); |
RealizePalette(DstDC); |
palSave := SelectPalette(SaveDC, Palette, False); |
RealizePalette(SaveDC); |
palObj := SelectPalette(ObjectDC, Palette, False); |
RealizePalette(ObjectDC); |
palMem := SelectPalette(MemDC, Palette, True); |
RealizePalette(MemDC); |
end; |
{ Set proper mapping mode } |
SetMapMode(SrcDC, GetMapMode(DstDC)); |
SetMapMode(SaveDC, GetMapMode(DstDC)); |
{ Save the bitmap sent here } |
BitBlt(SaveDC, 0, 0, SrcW, SrcH, SrcDC, SrcX, SrcY, SRCCOPY); |
{ Set the background color of the source DC to the color, } |
{ contained in the parts of the bitmap that should be transparent } |
Color := SetBkColor(SaveDC, PaletteColor(TransparentColor)); |
{ Create the object mask for the bitmap by performing a BitBlt() } |
{ from the source bitmap to a monochrome bitmap } |
BitBlt(ObjectDC, 0, 0, SrcW, SrcH, SaveDC, 0, 0, SRCCOPY); |
{ Set the background color of the source DC back to the original } |
SetBkColor(SaveDC, Color); |
{ Create the inverse of the object mask } |
BitBlt(BackDC, 0, 0, SrcW, SrcH, ObjectDC, 0, 0, NOTSRCCOPY); |
{ Copy the background of the main DC to the destination } |
BitBlt(MemDC, 0, 0, DstW, DstH, DstDC, DstX, DstY, SRCCOPY); |
{ Mask out the places where the bitmap will be placed } |
StretchBlt(MemDC, 0, 0, DstW, DstH, ObjectDC, 0, 0, SrcW, SrcH, SRCAND); |
{ Mask out the transparent colored pixels on the bitmap } |
BitBlt(SaveDC, 0, 0, SrcW, SrcH, BackDC, 0, 0, SRCAND); |
{ XOR the bitmap with the background on the destination DC } |
StretchBlt(MemDC, 0, 0, DstW, DstH, SaveDC, 0, 0, SrcW, SrcH, SRCPAINT); |
{ Copy the destination to the screen } |
BitBlt(DstDC, DstX, DstY, DstW, DstH, MemDC, 0, 0, |
SRCCOPY); |
{ Restore palette } |
if Palette <> 0 then begin |
SelectPalette(MemDC, palMem, False); |
SelectPalette(ObjectDC, palObj, False); |
SelectPalette(SaveDC, palSave, False); |
SelectPalette(DstDC, palDst, True); |
end; |
{ Delete the memory bitmaps } |
DeleteObject(SelectObject(BackDC, bmBackOld)); |
DeleteObject(SelectObject(ObjectDC, bmObjectOld)); |
DeleteObject(SelectObject(MemDC, bmMemOld)); |
DeleteObject(SelectObject(SaveDC, bmSaveOld)); |
{ Delete the memory DCs } |
DeleteDC(MemDC); |
DeleteDC(BackDC); |
DeleteDC(ObjectDC); |
DeleteDC(SaveDC); |
end; |
procedure StretchBitmapTransparent(Dest: TCanvas; Bitmap: TBitmap; |
TransparentColor: TColor; DstX, DstY, DstW, DstH, SrcX, SrcY, |
SrcW, SrcH: Integer); |
var |
CanvasChanging: TNotifyEvent; |
begin |
if DstW <= 0 then DstW := Bitmap.Width; |
if DstH <= 0 then DstH := Bitmap.Height; |
if (SrcW <= 0) or (SrcH <= 0) then begin |
SrcX := 0; SrcY := 0; |
SrcW := Bitmap.Width; |
SrcH := Bitmap.Height; |
end; |
if not Bitmap.Monochrome then |
SetStretchBltMode(Dest.Handle, STRETCH_DELETESCANS); |
CanvasChanging := Bitmap.Canvas.OnChanging; |
Bitmap.Canvas.Lock; |
try |
Bitmap.Canvas.OnChanging := nil; |
if TransparentColor = clNone then begin |
StretchBlt(Dest.Handle, DstX, DstY, DstW, DstH, Bitmap.Canvas.Handle, |
SrcX, SrcY, SrcW, SrcH, Dest.CopyMode); |
end |
else begin |
if TransparentColor = clDefault then |
TransparentColor := Bitmap.Canvas.Pixels[0, Bitmap.Height - 1]; |
if Bitmap.Monochrome then TransparentColor := clWhite |
else TransparentColor := ColorToRGB(TransparentColor); |
StretchBltTransparent(Dest.Handle, DstX, DstY, DstW, DstH, |
Bitmap.Canvas.Handle, SrcX, SrcY, SrcW, SrcH, Bitmap.Palette, |
TransparentColor); |
end; |
finally |
Bitmap.Canvas.OnChanging := CanvasChanging; |
Bitmap.Canvas.Unlock; |
end; |
end; |
procedure DrawBitmapTransparent(Dest: TCanvas; DstX, DstY: Integer; |
Bitmap: TBitmap; TransparentColor: TColor); |
begin |
StretchBitmapTransparent(Dest, Bitmap, TransparentColor, DstX, DstY, |
Bitmap.Width, Bitmap.Height, 0, 0, Bitmap.Width, Bitmap.Height); |
end; |
var |
Image: TGraphic; |
begin |
if Index < 0 then Image := Picture.Graphic |
else Image := GraphicCell[Index]; |
if (Image <> nil) and not Image.Empty then begin |
if FMasked and (FMaskColor <> clNone) and |
(Picture.Graphic is TBitmap) then |
DrawBitmapTransparent(Canvas, X, Y, TBitmap(Image), FMaskColor) |
else Canvas.Draw(X, Y, Image); |
end; |
end; |
|
procedure TDXPictureClip.DrawCenter(Canvas: TCanvas; Rect: TRect; Index: Integer); |
var |
X, Y: Integer; |
begin |
X := (Rect.Left + Rect.Right - Width) div 2; |
Y := (Rect.Bottom + Rect.Top - Height) div 2; |
Draw(Canvas, X, Y, Index); |
end; |
|
procedure TDXPictureClip.CheckIndex(Index: Integer); |
begin |
if (Index >= Cols * Rows) or (Index < 0) then |
raise EListError.CreateFmt('%s (%d)', ['Load list error', Index]); |
end; |
|
function TDXPictureClip.GetIndex(Col, Row: Cardinal): Integer; |
begin |
Result := Col + (Row * Cols); |
if (Result >= Cols * Rows) or IsEmpty then Result := -1; |
end; |
|
function TDXPictureClip.GetCell(Col, Row: Cardinal): TBitmap; |
begin |
Result := GetGraphicCell(GetIndex(Col, Row)); |
end; |
|
function TDXPictureClip.GetGraphicCell(Index: Integer): TBitmap; |
procedure AssignBitmapCell(Source: TGraphic; Dest: TBitmap; Cols, Rows, |
Index: Integer); |
var |
CellWidth, CellHeight: Integer; |
begin |
if (Source <> nil) and (Dest <> nil) then begin |
if Cols <= 0 then Cols := 1; |
if Rows <= 0 then Rows := 1; |
if Index < 0 then Index := 0; |
CellWidth := Source.Width div Cols; |
CellHeight := Source.Height div Rows; |
with Dest do begin |
Width := CellWidth; Height := CellHeight; |
end; |
if Source is TBitmap then begin |
Dest.Canvas.CopyRect(Bounds(0, 0, CellWidth, CellHeight), |
TBitmap(Source).Canvas, Bounds((Index mod Cols) * CellWidth, |
(Index div Cols) * CellHeight, CellWidth, CellHeight)); |
Dest.TransparentColor := TBitmap(Source).TransparentColor; |
end |
else begin |
Dest.Canvas.Brush.Color := clSilver; |
Dest.Canvas.FillRect(Bounds(0, 0, CellWidth, CellHeight)); |
Dest.Canvas.Draw(-(Index mod Cols) * CellWidth, |
-(Index div Cols) * CellHeight, Source); |
end; |
Dest.Transparent := Source.Transparent; |
end; |
end; |
begin |
CheckIndex(Index); |
AssignBitmapCell(Picture.Graphic, FBitmap, Cols, Rows, Index); |
if Picture.Graphic is TBitmap then |
if FBitmap.PixelFormat <> pfDevice then |
FBitmap.PixelFormat := TBitmap(Picture.Graphic).PixelFormat; |
FBitmap.TransparentColor := FMaskColor or PaletteMask; |
FBitmap.Transparent := (FMaskColor <> clNone) and Masked; |
Result := FBitmap; |
end; |
|
function TDXPictureClip.GetDefaultMaskColor: TColor; |
begin |
Result := clOlive; |
if (Picture.Graphic <> nil) and (Picture.Graphic is TBitmap) then |
Result := TBitmap(Picture.Graphic).TransparentColor and |
not PaletteMask; |
end; |
|
function TDXPictureClip.GetHeight: Integer; |
begin |
Result := Picture.Height div FRows; |
end; |
|
function TDXPictureClip.GetWidth: Integer; |
begin |
Result := Picture.Width div FCols; |
end; |
|
function TDXPictureClip.IsMaskStored: Boolean; |
begin |
Result := MaskColor <> GetDefaultMaskColor; |
end; |
|
procedure TDXPictureClip.SetMaskColor(Value: TColor); |
begin |
if Value <> FMaskColor then begin |
FMaskColor := Value; |
Changed; |
end; |
end; |
|
procedure TDXPictureClip.PictureChanged(Sender: TObject); |
begin |
FMaskColor := GetDefaultMaskColor; |
if not (csReading in ComponentState) then Changed; |
end; |
|
procedure TDXPictureClip.SetHeight(Value: Integer); |
begin |
if (Value > 0) and (Picture.Height div Value > 0) then |
Rows := Picture.Height div Value; |
end; |
|
procedure TDXPictureClip.SetWidth(Value: Integer); |
begin |
if (Value > 0) and (Picture.Width div Value > 0) then |
Cols := Picture.Width div Value; |
end; |
|
procedure TDXPictureClip.SetPicture(Value: TPicture); |
begin |
FPicture.Assign(Value); |
end; |
|
{ Transformations routines } |
{ Authorisation: Mr. Takanori Kawasaki} |
|
//Distance between 2 points is calculated |
function Get2PointRange(a,b: TDblPoint):Double; |
var |
x,y: Double; |
begin |
x := a.X - b.X; |
y := a.Y - b.Y; |
Result := Sqrt(x*x+y*y); |
end; |
|
//Direction angle in the coordinate A which was seen from coordinate B is calculated |
function GetARadFromB(A,B: TDblPoint):Double; |
var |
dX,dY: Double; |
begin |
dX := A.X - B.X; |
dY := A.Y - B.Y; |
Result := Get256(dX,dY); |
end; |
|
//Direction angle is returned with 0 - 255. |
function Get256(dX,dY:Double):Double; |
begin |
Result := 0; |
if dX > 0 then |
begin//0-63 |
if dY > 0 then Result := ArcTan(dY / dX) // 0 < Res < 90 |
else//0 |
if dY = 0 then Result := 0 // 0 |
else//192-255 |
if dY < 0 then Result := 2*Pi + ArcTan(dY / dX) // 270 < Res < 360 |
end else |
if dX = 0 then |
begin//64 |
if dY > 0 then Result := 1 / 2 * Pi // 90 |
else//0 |
if dY = 0 then Result := 0 // 0 |
else//192 |
if dY < 0 then Result := 3 / 2 * Pi // 270 |
end else |
if dX < 0 then |
begin//64-127 |
if dY > 0 then Result := Pi + ArcTan(dY / dX) // 90 < Res < 180 |
else//128 |
if dY = 0 then Result := Pi // 180 |
else//128-191 |
if dY < 0 then Result := Pi + ArcTan(dY / dX) // 180 < Res < 270 |
end; |
Result := 256 * Result / (2*Pi); |
end; |
|
//From the coordinate SP the Range it calculates the point which leaves with the angular Angle |
function GetPointFromRangeAndAngle(SP: TDblPoint; Range,Angle: Double): TDblPoint; |
begin |
Result.X := SP.X + Range * Cos(Angle); |
Result.Y := SP.Y + Range * Sin(Angle); |
end; |
|
//* As for coordinate transformation coordinate for mathematics is used |
//Identity matrix for the 2d is returned. |
function Ini2DRowCol: T2DRowCol; |
var |
i,ii:integer; |
begin |
for i := 1 to 3 do |
for ii := 1 to 3 do |
if i = ii then Result[i,ii] := 1 else Result[i,ii] := 0; |
end; |
|
//Transformation matrix of the portable quantity |
//where the one for 2d is appointed is returned. |
function Trans2DRowCol(x,y:double):T2DRowCol; |
begin |
Result := Ini2DRowCol; |
Result[3,1] := x; |
Result[3,2] := y; |
end; |
|
//Conversion coordinate of the expansion and contraction |
//quantity where the one for 2d is appointed is returned. |
function Scale2DRowCol(x,y:double):T2DRowCol; |
begin |
Result := Ini2DRowCol; |
Result[1,1] := x; |
Result[2,2] := y; |
end; |
|
//Coordinate transformation of the rotary quantity |
//where the one for 2d is appointed is returned. |
function Rotate2DRowCol(Theta:double):T2DRowCol; |
begin |
Result := Ini2DRowCol; |
Result[1,1] := Cos256(Trunc(Theta)); |
Result[1,2] := Sin256(Trunc(Theta)); |
Result[2,1] := -1 * Result[1,2]; |
Result[2,2] := Result[1,1]; |
end; |
|
//You apply two conversion coordinates and adjust. |
function Multiply2DRowCol(A,B:T2DRowCol):T2DRowCol; |
begin |
Result[1,1] := A[1,1] * B[1,1] + A[1,2] * B[2,1]; |
Result[1,2] := A[1,1] * B[1,2] + A[1,2] * B[2,2]; |
Result[1,3] := 0; |
Result[2,1] := A[2,1] * B[1,1] + A[2,2] * B[2,1]; |
Result[2,2] := A[2,1] * B[1,2] + A[2,2] * B[2,2]; |
Result[2,3] := 0; |
Result[3,1] := A[3,1] * B[1,1] + A[3,2] * B[2,1] + B[3,1]; |
Result[3,2] := A[3,1] * B[1,2] + A[3,2] * B[2,2] + B[3,2]; |
Result[3,3] := 1; |
end; |
|
//Until coordinate (the X and the Y) comes on the X axis, |
//the conversion coordinate which turns the position |
//of the point is returned. |
function RotateIntoX2DRowCol(x,y: double):T2DRowCol; |
var |
d: double; |
begin |
Result := Ini2DRowCol; |
d := sqrt(x*x+y*y); |
Result[1,1] := x / d; |
Result[1,2] := y / d; |
Result[2,1] := -1 * Result[1,2]; |
Result[2,2] := Result[1,1]; |
end; |
|
//Coordinate (the X and the Y) as a center, the conversion |
//coordinate which does the scaling of the magnification ratio |
//which is appointed with the Sx and the Sy is returned. |
function ScaleAt2DRowCol(x,y,Sx,Sy:double):T2DRowCol; |
var |
T,S,TInv,M:T2DRowCol; |
begin |
T := Trans2DRowCol(-x,-y); |
TInv := Trans2DRowCol(x,y); |
S := Scale2DRowCol(Sx,Sy); |
M := Multiply2DRowCol(T,S); |
Result := Multiply2DRowCol(M,T); |
end; |
|
//Coordinate (the X and the Y) it passes, comes hard and |
//(DX and the dy) with the direction which is shown it |
//returns the transformation matrix which does the reflected |
//image conversion which centers the line which faces. |
function ReflectAcross2DRowCol(x,y,dx,dy:Double): T2DRowCol; |
var |
T,R,S,RInv,TInv,M1,M2,M3: T2DRowCol; |
begin |
T := Trans2DRowCol(-x,-y); |
TInv := Trans2DRowCol(x,y); |
R := RotateIntoX2DRowCol(dx,dy); |
RInv := RotateIntoX2DRowCol(dx,-dy); |
S := Scale2DRowCol(1,-1); |
M1 := Multiply2DRowCol(T,R); |
M2 := Multiply2DRowCol(S,RInv); |
M3 := Multiply2DRowCol(M1,M2); |
Result := Multiply2DRowCol(M3,TInv); |
end; |
|
//Coordinate focusing on (the X and the Y) the transformation |
//matrix which turns the position of the point with angle Theta is returned. |
function RotateAround2DRowCol(x,y,Theta:Double): T2DRowCol; |
var |
T,R,TInv,M: T2DRowCol; |
begin |
T := Trans2DRowCol(-x,-y); |
TInv := Trans2DRowCol(x,y); |
R := Rotate2DRowCol(Theta); |
M := Multiply2DRowCol(T,R); |
Result := Multiply2DRowCol(M,TInv); |
end; |
|
//Transformation matrix is applied to the point. |
function Apply2DVector(V:T2DVector; M:T2DRowCol): T2DVector; |
begin |
Result[1] := V[1] * M[1,1] + V[2] * M[2,1] + M[3,1]; |
Result[2] := V[1] * M[1,2] + V[2] * M[2,2] + M[3,2]; |
Result[3] := 1; |
end; |
|
//The TDblPoint is returned |
function DblPoint(a,b:Double):TDblPoint; |
begin |
Result.X := a; |
Result.Y := b; |
end; |
|
function TruncDblPoint(DblPos: TDblPoint): TPoint; |
begin |
Result.X := Trunc(DblPos.X); |
Result.Y := Trunc(DblPos.Y); |
end; |
{ |
+-----------------------------------------------------------------------------+ |
|Collision decision | |
+-----------------------------------------------------------------------------+} |
|
//Point and circle |
function PointInCircle(PPos,CPos: TPoint; R: integer): Boolean; |
begin |
Result := (PPos.X - CPos.X)*(PPos.X - CPos.X)+(PPos.Y - CPos.Y)*(PPos.Y - CPos.Y)<= R*R; |
end; |
|
//Circle and circle |
function CircleInCircle(C1Pos,C2Pos: TPoint; R1,R2:Integer): Boolean; |
begin |
Result := (C1Pos.X - C2Pos.X)*(C1Pos.X - C2Pos.X)+(C1Pos.Y - C2Pos.Y)*(C1Pos.Y - C2Pos.Y) <= (R1+R2)*(R1+R2); |
end; |
|
//Circle and line segment |
function SegmentInCircle(SPos,EPos,CPos: TPoint; R: Integer): Boolean; |
var |
V,C: TPoint; |
VC,VV,CC:integer; |
begin |
Result := False; |
V.X := EPos.X - SPos.X; V.Y := EPos.Y - SPos.Y; |
C.X := CPos.X - SPos.X; C.Y := CPos.Y - SPos.Y; |
VC := V.X * C.X + V.Y * C.Y; |
if VC < 0 then |
begin |
Result := (C.X * C.X + C.Y * C.Y) <= R*R; |
end |
else |
begin |
VV := V.X * V.X + V.Y * V.Y; |
if VC >= VV then |
begin |
Result := (EPos.X - CPos.X)*(EPos.X - CPos.X)+(EPos.Y - CPos.Y)*(EPos.Y - CPos.Y) <= R * R; |
end |
else |
if VC < VV then |
begin |
CC := C.X * C.X + C.Y * C.Y; |
Result := CC - (VC div VV)* VC <= R*R; |
end; |
end; |
end; |
|
//Angle recalc |
function Angle256(Angle: Single): Single; |
begin |
Result := Angle; |
While Result < 0 do Result := Result + 256; |
While Result >= 256 do Result := Result -256; |
end; |
|
//If A is closer than B from starting point S, the True is returned. |
function CheckNearAThanB(S,A,B: TDblPoint): Boolean; |
begin |
Result := (S.X-A.X)*(S.X-A.X)+(S.Y-A.Y)*(S.Y-A.Y) <= (S.X-B.X)*(S.X-B.X)+(S.Y-B.Y)*(S.Y-B.Y); |
end; |
|
function CircumCenter3Pt(const x1, y1, x2, y2, x3, y3: Single; out Px, Py: Single): Boolean; |
var |
A,B,C,D,E,F,G: Single; |
begin |
A := x2 - x1; |
B := y2 - y1; |
C := x3 - x1; |
D := y3 - y1; |
E := A * (x1 + x2) + B * (y1 + y2); |
F := C * (x1 + x3) + D * (y1 + y3); |
G := 2.0 * (A * (y3 - y2) - B * (x3 - x2)); |
Result := G <> 0.0; |
if Result then begin |
Px := (D * E - B * F) / G; |
Py := (A * F - C * E) / G; |
end; |
end; |
|
function Distance(const x1, y1, x2, y2: Double): Double; |
begin |
Result := Sqrt(Sqr(y2 - y1) + Sqr(x2 - x1)); |
end; |
|
procedure InCenter(const x1, y1, x2, y2, x3, y3: Double; out Px, Py: Double); |
var |
Perim: Double; |
Side12: Double; |
Side23: Double; |
Side31: Double; |
begin |
Side12 := Distance(x1, y1, x2, y2); |
Side23 := Distance(x2, y2, x3, y3); |
Side31 := Distance(x3, y3, x1, y1); |
{ Using Heron's S=UR } |
Perim := 1.0 / (Side12 + Side23 + Side31); |
Px := (Side23 * x1 + Side31 * x2 + Side12 * x3) * Perim; |
Py := (Side23 * y1 + Side31 * y2 + Side12 * y3) * Perim; |
end; |
|
function PointInTriangle(const Px, Py, x1, y1, x2, y2, x3, y3: Double): Boolean; |
function Orientation(const x1, y1, x2, y2, Px, Py: Double): Integer; |
var |
Orin: Double; |
begin |
(* Linear determinant of the 3 points *) |
Orin := (x2 - x1) * (py - y1) - (px - x1) * (y2 - y1); |
|
if Orin > 0.0 then |
Result := +1 (* Orientaion is to the right-hand side *) |
else if Orin < 0.0 then |
Result := -1 (* Orientaion is to the left-hand side *) |
else |
Result := 0; (* Orientaion is neutral aka collinear *) |
end; |
var |
Or1, Or2, Or3: Integer; |
begin |
Or1 := Orientation(x1, y1, x2, y2, Px, Py); |
Or2 := Orientation(x2, y2, x3, y3, Px, Py); |
Or3 := Orientation(x3, y3, x1, y1, Px, Py); |
|
if (Or1 = Or2) and (Or2 = Or3) then |
Result := True |
else if Or1 = 0 then |
Result := (Or2 = 0) or (Or3 = 0) |
else if Or2 = 0 then |
Result := (Or1 = 0) or (Or3 = 0) |
else if Or3 = 0 then |
Result := (Or2 = 0) or (Or1 = 0) |
else |
Result := False; |
end; |
|
procedure Log(const Co: string; const FName: string); |
var F: Text; D: TDateTime; |
Hour, Minute, Second, MSec: Word; |
begin |
AsSignFile(F, FName); |
if FileExists(FName) then Append(F) |
else ReWrite(F); |
try |
D := Now; |
DecodeTime(D, Hour, Minute, Second, MSec); |
WriteLn(F, DateToStr(D) + ' ' + IntToStr(Hour)+':'+IntToStr(Minute)+':'+IntToStr(Second)+ '.'+IntToStr(MSec) +' ' + Co); |
finally |
CloseFile(F); |
end; |
end; |
|
{$IFDEF _DMO_} |
|
{ TDirectXDriverEx } |
|
function TDirectXDriverEx.ConvertHMonitor(iMonitor: HMonitor): TMonitorInfo; |
begin |
ZeroMemory(@Result, sizeof(Result)); |
Result.cbSize := SizeOf(Result); |
MultiMon.GetMonitorInfo(iMonitor, @Result); |
end; |
|
function TDirectXDriverEx.GetFlags: DWORD; |
begin |
Result := ConvertHMonitor(FMonitor).dwFlags; |
end; |
|
function TDirectXDriverEx.GetMonitorInfo: TMonitorInfo; |
begin |
Result:= ConvertHMonitor(FMonitor); |
end; |
|
function TDirectXDriverEx.GetTempSpace: TRect; |
begin |
Result := ConvertHMonitor(FMonitor).rcWork |
end; |
|
function TDirectXDriverEx.GetWorkSpace: TRect; |
begin |
Result := ConvertHMonitor(FMonitor).rcMonitor |
end; |
|
procedure TDirectXDriverEx.SetGUID(Value: PGUID); |
begin |
if not IsBadHugeReadPtr(Value, SizeOf(TGUID)) then |
begin |
FGUID2 := Value^; |
FGUID := @FGUID2; |
end else |
FGUID := Value; |
end; |
|
{ TDirectXDriversEx } |
|
constructor TDirectXDriversEx.Create; |
begin |
inherited Create(TDirectXDriverEx); |
end; |
|
function TDirectXDriversEx.GetDriver(Index: Integer): TDirectXDriverEx; |
begin |
Result := (inherited Items[Index]) as TDirectXDriverEx; |
end; |
|
{$ENDIF} |
|
initialization |
InitCosinTable; |
finalization |
FreeLibList; |
end. |
end. |