graphics.htm

对于学习很有帮助

var
  MetafilePict: PMetafilePict;
  IC: HDC;
  ExtRect: TRect;
begin
  if Bool(FMetafileHandle) then DeleteMetafile(FMetafileHandle);
  FMetafileHandle := CloseMetafile(Handle);
  Handle := 0;
  { Prepair metafile for clipboard display. }
  MetafilePict := GlobalLock(FClipboardHandle);
  MetafilePict^.mm := mm_AnIsoTropic;
  IC := CreateIC('DISPLAY', nil, nil, nil);
  SetMapMode(IC, mm_HiMetric);
  ExtRect := FRect;
  DPtoLP(IC, ExtRect, 2);
  DeleteDC(IC);
  MetafilePict^.xExt := ExtRect.Right - ExtRect.Left;
  MetafilePict^.yExt := ExtRect.Top - ExtRect.Bottom;
  MetafilePict^.HMF :=  FMetafileHandle;
  GlobalUnlock(FClipboardHandle);
  { I'm giving you this handle, but please do NOT eat it. }
  Result := FClipboardHandle;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  MetafileCanvas : TMetafileCanvas;
begin
  MetafileCanvas := TMetafileCanvas.Create;
  MetafileCanvas.Rect := Rect(0,0,500,500);
  MetafileCanvas.Ellipse(10,10,400,400);
  Image1.Picture.Metafile.LoadFromClipboardFormat(
    cf_MetafilePict, MetafileCanvas.MetafileHandle, 0);
  MetafileCanvas.Free;
end;

end.
</PRE><HR>

<P><H1><A NAME="graphics4">Capturing the DESKTOP to a form.canvas</P></A></H1>
<P><I>From: Craig Francisco &lt;[e-mail]&gt;</I></P>

Try this:

<HR><PRE> 
procedure TScrnFrm.GrabScreen;
 var

    DeskTopDC: HDc;
    DeskTopCanvas: TCanvas;
    DeskTopRect: TRect;
    
 begin
    DeskTopDC := GetWindowDC(GetDeskTopWindow);
    DeskTopCanvas := TCanvas.Create;
    DeskTopCanvas.Handle := DeskTopDC;

    DeskTopRect := Rect(0,0,Screen.Width,Screen.Height);

    ScrnForm.Canvas.CopyRect(DeskTopRect,DeskTopCanvas,DeskTopRect);

    ReleaseDC(GetDeskTopWindow,DeskTopDC);
end;
</PRE><HR>
Note: I haven't tested this, so you may have to massage it a little.  
You may also have to play around with co-ordinates, depending on what 
you want to do.  Also, if your form is already loaded and displayed, 
that is what you you will get, so you may want to do a hide and a 
show...<P>

<H1><A NAME="graphics5"> Several Points (2D and 3D) routines</A></H1>
<I>From: "Verstraelen" &lt;[e-mail]&gt;</I>
<HR><PRE>
unit Functs;

interface

uses
  WinTypes, Classes, Graphics, SysUtils;

type
  TPoint2D = record
    X, Y: Real;
  end;
  TPoint3D = record
    X, Y, Z: Real;
  end;

function Point2D(X, Y: Real): TPoint2D;
function RoundPoint(P: TPoint2D): TPoint;
function FloatPoint(P: TPoint): TPoint2D;
function Point3D(X, Y, Z: Real): TPoint3D;
function Angle2D(P: TPoint2D): Real;
function Dist2D(P: TPoint2D): Real;
function Dist3D(P: TPoint3D): Real;
function RelAngle2D(PA, PB: TPoint2D): Real;
function RelDist2D(PA, PB: TPoint2D): Real;
function RelDist3D(PA, PB: TPoint3D): Real;
procedure Rotate2D(var P: TPoint2D; Angle2D: Real);
procedure RelRotate2D(var P: TPoint2D; PCentr: TPoint2D; Angle2D: Real);
procedure Move2D(var P: TPoint2D; Angle2D, Distance: Real);
function Between(PA, PB: TPoint2D; Preference: Real): TPoint2D;
function DistLine(A, B, C: Real; P: TPoint2D): Real;
function Dist2P(P, P1, P2: TPoint2D): Real;
function DistD1P(DX, DY: Real; P1, P: TPoint2D): Real;
function NearLine2P(P, P1, P2: TPoint2D; D: Real): Boolean;
function AddPoints(P1, P2: TPoint2D): TPoint2D;
function SubPoints(P1, P2: TPoint2D): TPoint2D;

function Invert(Col: TColor): TColor;
function Dark(Col: TColor; Percentage: Byte): TColor;
function Light(Col: TColor; Percentage: Byte): TColor;
function Mix(Col1, Col2: TColor; Percentage: Byte): TColor;
function MMix(Cols: array of TColor): TColor;
function Log(Base, Value: Real): Real;
function Modulator(Val, Max: Real): Real;
function M(I, J: Integer): Integer;
function Tan(Angle2D: Real): Real;
procedure Limit(var Value: Integer; Min, Max: Integer);
function Exp2(Exponent: Byte): Word;
function GetSysDir: String;
function GetWinDir: String;

implementation

function Point2D(X, Y: Real): TPoint2D;
begin
  Point2D.X := X;
  Point2D.Y := Y;
end;

function RoundPoint(P: TPoint2D): TPoint;
begin
  RoundPoint.X := Round(P.X);
  RoundPoint.Y := Round(P.Y);
end;

function FloatPoint(P: TPoint): TPoint2D;
begin
  FloatPoint.X := P.X;
  FloatPoint.Y := P.Y;
end;

function Point3D(X, Y, Z: Real): TPoint3D;
begin
  Point3D.X := X;
  Point3D.Y := Y;
  Point3D.Z := Z;
end;

function Angle2D(P: TPoint2D): Real;
begin
  if P.X = 0 then
  begin
    if P.Y &gt; 0 then Result := Pi / 2;
    if P.Y = 0 then Result := 0;
    if P.Y &lt; 0 then Result := Pi / -2;
  end
  else
    Result := Arctan(P.Y / P.X);

  if P.X &lt; 0 then
  begin
    if P.Y &lt; 0 then Result := Result + Pi;
    if P.Y &gt;= 0 then Result := Result - Pi;
  end;

  If Result &lt; 0 then Result := Result + 2 * Pi;
end;

function Dist2D(P: TPoint2D): Real;
begin
  Result := Sqrt(P.X * P.X + P.Y * P.Y);
end;

function Dist3D(P: TPoint3D): Real;
begin
  Dist3d := Sqrt(P.X * P.X + P.Y * P.Y + P.Z * P.Z);
end;

function RelAngle2D(PA, PB: TPoint2D): Real;
begin
  RelAngle2D := Angle2D(Point2D(PB.X - PA.X, PB.Y - PA.Y));
end;

function RelDist2D(PA, PB: TPoint2D): Real;
begin
  Result := Dist2D(Point2D(PB.X - PA.X, PB.Y - PA.Y));
end;

function RelDist3D(PA, PB: TPoint3D): Real;
begin
  RelDist3D := Dist3D(Point3D(PB.X - PA.X, PB.Y - PA.Y, PB.Z - PA.Z));
end;

procedure Rotate2D(var P: TPoint2D; Angle2D: Real);
var
  Temp: TPoint2D;
begin
  Temp.X := P.X * Cos(Angle2D) - P.Y * Sin(Angle2D);
  Temp.Y := P.X * Sin(Angle2D) + P.Y * Cos(Angle2D);
  P := Temp;
end;

procedure RelRotate2D(var P: TPoint2D; PCentr: TPoint2D; Angle2D: Real);
var
  Temp: TPoint2D;
begin
  Temp := SubPoints(P, PCentr);
  Rotate2D(Temp, Angle2D);
  P := AddPoints(Temp, PCentr);
end;

procedure Move2D(var P: TPoint2D; Angle2D, Distance: Real);
var
  Temp: TPoint2D;
begin
  Temp.X := P.X + (Cos(Angle2D) * Distance);
  Temp.Y := P.Y + (Sin(Angle2D) * Distance);
  P := Temp;
end;

function Between(PA, PB: TPoint2D; Preference: Real): TPoint2D;
begin
  Between.X := PA.X * Preference + PB.X * (1 - Preference);
  Between.Y := PA.Y * Preference + PB.Y * (1 - Preference);
end;

function DistLine(A, B, C: Real; P: TPoint2D): Real;
begin
  Result := (A * P.X + B * P.Y + C) / Sqrt(Sqr(A) + Sqr(B));
end;

function Dist2P(P, P1, P2: TPoint2D): Real;
begin
  Result := DistLine(P1.Y - P2.Y, P2.X - P1.X, -P1.Y * P2.X + P1.X * P2.Y, P);
end;

function DistD1P(DX, DY: Real; P1, P: TPoint2D): Real;
begin
  Result := DistLine(DY, -DX, -DY * P1.X + DX * P1.Y, P);
end;

function NearLine2P(P, P1, P2: TPoint2D; D: Real): Boolean;
begin
  Result := False;
  if DistD1P(-(P2.Y - P1.Y), P2.X - P1.X, P1, P) * DistD1P(-(P2.Y - P1.Y), P2.X - P1.X, P2, P) &lt;= 0 then
    if Abs(Dist2P(P, P1, P2)) &lt; D then Result := True;
end;

function AddPoints(P1, P2: TPoint2D): TPoint2D;
begin
  AddPoints := Point2D(P1.X + P2.X, P1.Y + P2.Y);
end;

function SubPoints(P1, P2: TPoint2D): TPoint2D;
begin
  SubPoints := Point2D(P1.X - P2.X, P1.Y - P2.Y);
end;

function Invert(Col: TColor): TColor;
begin
  Invert := not Col;
end;

function Dark(Col: TColor; Percentage: Byte): TColor;
var
  R, G, B: Byte;
begin
  R := GetRValue(Col); G := GetGValue(Col); B := GetBValue(Col);
  R := Round(R * Percentage / 100);
  G := Round(G * Percentage / 100);
  B := Round(B * Percentage / 100);
  Dark := RGB(R, G, B);
end;

function Light(Col: TColor; Percentage: Byte): TColor;
var
  R, G, B: Byte;
begin
  R := GetRValue(Col); G := GetGValue(Col); B := GetBValue(Col);
  R := Round(R * Percentage / 100) + Round(255 - Percentage / 100 * 255);
  G := Round(G * Percentage / 100) + Round(255 - Percentage / 100 * 255);
  B := Round(B * Percentage / 100) + Round(255 - Percentage / 100 * 255);
  Light := RGB(R, G, B);
end;

function Mix(Col1, Col2: TColor; Percentage: Byte): TColor;
var
  R, G, B: Byte;
begin
  R := Round((GetRValue(Col1) * Percentage / 100) + (GetRValue(Col2) * (100 - Percentage) / 100));
  G := Round((GetGValue(Col1) * Percentage / 100) + (GetGValue(Col2) * (100 - Percentage) / 100));
  B := Round((GetBValue(Col1) * Percentage / 100) + (GetBValue(Col2) * (100 - Percentage) / 100));
  Mix := RGB(R, G, B);
end;

function MMix(Cols: array of TColor): TColor;
var
  I, R, G, B, Length: Integer;
begin
  Length := High(Cols) - Low(Cols) + 1;
  R := 0; G := 0; B := 0;
  for I := Low(Cols) to High(Cols) do
  begin
    R := R + GetRValue(Cols[I]);
    G := G + GetGValue(Cols[I]);
    B := B + GetBValue(Cols[I]);
  end;
  R := R div Length;
  G := G div Length;
  B := B div Length;
  MMix := RGB(R, G, B);
end;

function Log(Base, Value: Real): Real;
begin
  Log := Ln(Value) / Ln(Base);
end;

function Power(Base, Exponent: Real): Real;
begin
  Power := Ln(Base) * Exp(Exponent);
end;

function Modulator(Val, Max: Real): Real;
begin
  Modulator := (Val / Max - Round(Val / Max)) * Max;
end;

function M(I, J: Integer): Integer;
begin
  M := ((I mod J) + J) mod J;
end;

function Tan(Angle2D: Real): Real;
begin
  Tan := Sin(Angle2D) / Cos(Angle2D);
end;

procedure Limit(var Value: Integer; Min, Max: Integer);
begin
  if Value &lt; Min then Value := Min;
  if Value &gt; Max then Value := Max;
end;

function Exp2(Exponent: Byte): Word;
var
  Temp, I: Word;
begin
  Temp := 1;
  for I := 1 to Exponent do
    Temp := Temp * 2;
  Result := Temp;
end;

function GetSysDir: String;
var
  Temp: array[0..255] of Char;
begin
  GetSystemDirectory(Temp, 256);
  Result := StrPas(Temp);
end;

function GetWinDir: String;
var
  Temp: array[0..255] of Char;
begin
  GetWindowsDirectory(Temp, 256);
  Result := StrPas(Temp);
end;

end.
</PRE><HR>

12. Screen handle


<P><H1><A NAME="graphics6">How can I get the canvas from the screen (like a screen-capture program)?<IMG SRC="../images/new.gif" WIDTH=28 HEIGHT=11 BORDER=0 ALT=" [NEW]"></P></A></H1>

<I>[Chris Means, [e-mail]]</I><P>
Using the standard Windows API:<p>

use hWnd := GetDesktopWindow to get the Handle to the 'desktop' ;<BR>
use hDC := GetDC (hWnd) to get the HDC (handle to a display context) ;<BR>
be sure to free the (release the handle of) hDC when you're done with it.
<p>
As a TCanvas.Handle is the HDC, you can use regular WinAPI to draw to it
etc., or it may be possible to supply the HDC to the Handle property of a
TCanvas you create.<P>

<I>[Chris Means, [e-mail]]</I><P>
In D1 (should work for D2 also) try this:<P>

I put a TPaintBox object and a TButton on my form.

<HR><PRE>
procedure TForm1.Button1Click(Sender: TObject);

var
  DeskTop : TCanvas ;

begin
  DeskTop := TCanvas.Create ;
  try
    with DeskTop do
      Handle := GetWindowDC (GetDesktopWindow) ;

    with PaintBox1.Canvas do
      CopyRect (Rect (0, 0, 200, 200),
                DeskTop,
                Rect (0, 0, 200, 200))

  finally
    DeskTop.Free

  end
end;
</PRE><HR>

This will copy the top left area of the desktop, to the top left area of
your TPaintBox.


<HR SIZE="6" color="#00FF00">
<P><A HREF="mailto:[e-mail]"><FONT SIZE=2>Please email me</FONT></A><FONT SIZE=2> and tell me if you liked this page.<BR>
<SCRIPT LANGUAGE="JavaScript"><!--
	document.write("Last modified " + document.lastModified);
// --></SCRIPT></FONT>
<P ALIGN="CENTER"><CENTER><TABLE CELLSPACING=0 BORDER=0>
<TR><TD VALIGN="MIDDLE">
<P><FONT SIZE=2>This page has been created with </FONT></TD>
<TD VALIGN="MIDDLE">
<P><A HREF="http://www.dexnet.com./homesite.html"><IMG SRC="../images/hslogo.gif" BORDER=0 WIDTH=144 HEIGHT=64></A></TD>
</TR>
</TABLE>
</CENTER></P>

</BODY>
</HTML>