graphics.htm

对于学习很有帮助

DoFFT(Depth, Src, 1, Dest);

Normalizer:= 1 / sqrt(N) ;

for j:=0 to N - 1 do
    Dest^[j]:= TimesReal(Dest^[j], Normalizer);

end;

procedure InitTrigTable(Depth: word);
var j, N: integer;
begin

N:= integer(1) shl depth;
ReAllocMem(TrigTable, N * SizeOf(TScalar));
for j:=0 to N - 1 do
    TrigTable^[j]:= EiT(-(2*Pi)*j/N);
TrigTableDepth:= Depth;

end;

initialization

   ;

finalization
    ReAllocMem(TrigTable, 0);

end.</PRE>
<P><HR></P>
<P><HR></P>
<PRE>unit DemoForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses cplx, cplxfft1, MMSystem;

procedure TForm1.Button1Click(Sender: TObject);
var j: integer; s:string;
    src, dest: PScalars;
    norm: extended;
    d,N,count:integer;
    st,et: longint;
begin

   d:= StrToIntDef(edit1.text, -1) ;
   if d &lt;1 then
      raise exception.Create('depth must be a positive integer');


   N:= integer(1) shl d ;

   GetMem(Src, N*Sizeof(TScalar));
   GetMem(Dest, N*SizeOf(TScalar));

   for j:=0 to N-1 do
      begin
           src^[j]:= MakeComplex(random, random);
      end;

begin

 st:= timeGetTime;
   FFT(d, Src, dest);
 et:= timeGetTime;

end;

   Memo1.Lines.Add('N = ' + IntToStr(N));
   Memo1.Lines.Add('expected norm: ' +#9+ FloatToStr(N*2/3));

   norm:=0;
   for j:=0 to N-1 do norm:= norm + AbsSquared(src^[j]);
   Memo1.Lines.Add('Data norm: '+#9+FloatToStr(norm));
   norm:=0;
   for j:=0 to N-1 do norm:= norm + AbsSquared(dest^[j]);
   Memo1.Lines.Add('FT norm: '+#9#9+FloatToStr(norm));


   Memo1.Lines.Add('Time in FFT routine: '+#9
                    + inttostr(et - st)
                    + ' ms.');
   Memo1.Lines.Add(' ');

   FreeMem(Src);
   FreeMem(DEst);
end;

end.
</PRE>
<P><HR></P>
<P>**** The real version: </P>
<P>**** </P>
<P><HR></P>
<PRE>unit cplxfft2;


interface


type
      PScalar = ^TScalar;
      TScalar = extended; 

      PScalars = ^TScalars;
      TScalars = array[0..High(integer) div SizeOf(TScalar) - 1]
                                                of TScalar;

const

      TrigTableDepth: word = 0;
      CosTable : PScalars = nil;
      SinTable : PScalars = nil;

procedure InitTrigTables(Depth: word);

procedure FFT(Depth: word;
              SrcR, SrcI: PScalars;
              DestR, DestI: PScalars);

{REQUIRES allocating

(integer(1) shl Depth) * SizeOf(TScalar)

bytes for SrcR, SrcI, DestR and DestI before call!}


implementation


procedure DoFFT(Depth: word;
              SrcR, SrcI: PScalars;
              SrcSpacing: word;
              DestR, DestI: PScalars);
{the recursive part called by FFT when ready}
var j, N: integer; 
    TempR, TempI: TScalar;
    Shift: word;
    c, s: extended;
begin
if Depth = 0 then
   begin
      DestR^[0]:= SrcR^[0];
      DestI^[0]:= SrcI^[0];
      exit;
   end;

N:= integer(1) shl (Depth - 1);

DoFFT(Depth - 1, SrcR, SrcI, SrcSpacing * 2, DestR, DestI);
DoFFT(Depth - 1,
      @SrcR^[srcSpacing],
      @SrcI^[SrcSpacing],
      SrcSpacing * 2,
      @DestR^[N],
      @DestI^[N]);

Shift:= TrigTableDepth - Depth;

for j:= 0 to N - 1 do
begin
   c:= CosTable^[j shl Shift];
   s:= SinTable^[j shl Shift];

   TempR:= c * DestR^[j + N] - s * DestI^[j + N];
   TempI:= c * DestI^[j + N] + s * DestR^[j + N];

   DestR^[j + N]:= DestR^[j] - TempR;
   DestI^[j + N]:= DestI^[j] - TempI;

   DestR^[j]:= DestR^[j] + TempR;
   DestI^[j]:= DestI^[j] + TempI;
end;

end;

procedure FFT(Depth: word;
              SrcR, SrcI: PScalars;
              DestR, DestI: PScalars);
var j, N: integer; Normalizer: extended;
begin

N:= integer(1) shl depth;

if Depth  TrigTableDepth then
           InitTrigTables(Depth);

DoFFT(Depth, SrcR, SrcI, 1, DestR, DestI);

Normalizer:= 1 / sqrt(N) ;

for j:=0 to N - 1 do
    begin
       DestR^[j]:= DestR^[j] * Normalizer;
       DestI^[j]:= DestI^[j] * Normalizer;
    end;

end;

procedure InitTrigTables(Depth: word);
var j, N: integer;
begin

N:= integer(1) shl depth;
ReAllocMem(CosTable, N * SizeOf(TScalar));
ReAllocMem(SinTable, N * SizeOf(TScalar));
for j:=0 to N - 1 do
  begin
    CosTable^[j]:= cos(-(2*Pi)*j/N);
    SinTable^[j]:= sin(-(2*Pi)*j/N);
  end;
TrigTableDepth:= Depth;

end;

initialization

   ;

finalization
    ReAllocMem(CosTable, 0);
    ReAllocMem(SinTable, 0);

end.</PRE>
<P><HR></P>
<P><HR></P>
<PRE>unit demofrm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics,
  Controls, Forms, Dialogs, cplxfft2, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses MMSystem;

procedure TForm1.Button1Click(Sender: TObject);
var SR, SI, DR, DI: PScalars;
j,d,N:integer;
st, et: longint;
norm: extended;
begin

   d:= StrToIntDef(edit1.text, -1) ;
   if d &lt;1 then
      raise exception.Create('depth must be a positive integer');

N:= integer(1) shl d;

GetMem(SR, N * SizeOf(TScalar));
GetMem(SI, N * SizeOf(TScalar));
GetMem(DR, N * SizeOf(TScalar));
GetMem(DI, N * SizeOf(TScalar));

for j:=0 to N - 1 do
begin
   SR^[j]:=random;
   SI^[j]:=random;
end;

 st:= timeGetTime;
FFT(d, SR, SI, DR, DI);
 et:= timeGetTime;

memo1.Lines.Add('N = '+inttostr(N));
memo1.Lines.Add('expected norm: '+#9+FloatToStr(N*2/3));

norm:=0;
for j:=0 to N - 1 do
    norm:= norm + SR^[j]*SR^[j] + SI^[j]*SI^[j];
memo1.Lines.Add('Data norm: '+#9+FloatToStr(norm));

norm:=0;
for j:=0 to N - 1 do
    norm:= norm + DR^[j]*DR^[j] + DI^[j]*DI^[j];
memo1.Lines.Add('FT norm: '+#9#9+FloatToStr(norm));

memo1.Lines.Add('Time in FFT routine: '+#9+inttostr(et-st));
memo1.Lines.add('');
(*for j:=0 to N - 1 do
 Memo1.Lines.Add(FloatToStr(SR^[j])
               + ' + '
               + FloatToStr(SI^[j])
               + 'i');

for j:=0 to N - 1 do
 Memo1.Lines.Add(FloatToStr(DR^[j])
               + ' + '
               + FloatToStr(DI^[j])
               + 'i');*)

FreeMem(SR, N * SizeOf(TScalar));
FreeMem(SI, N * SizeOf(TScalar));
FreeMem(DR, N * SizeOf(TScalar));
FreeMem(DI, N * SizeOf(TScalar));
end;

end.
</PRE><HR>

<P><H1><A NAME="graphics3">Canvas from THandle (for metafiles) </P></A></H1>
<P><I>From: [e-mail] (Rene Post)</I></P>

<PRE>
[e-mail] (Martin Lapidus) wrote:
&gt;I need to draw to a Windows metafile. Delphi does not directly support this, 
&gt;so I plan to use API calls to create the metafile. Creating a Metafile returns 
&gt;a THandle which can be cast to a DC. 

&gt;In delphi, how can I use the THandle to get/create a Canvas for drawing?
</PRE>
I've asked a similar question a few days ago but got no response, so 
I figured it out myself. Here's the code. (hope it's what you need).

<HR><PRE>
unit Metaform;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Buttons, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    BitBtn1: TBitBtn;
    Image1: TImage;
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

type
  TMetafileCanvas = class(TCanvas)
  private
    FClipboardHandle: THandle;
    FMetafileHandle: HMetafile;
    FRect: TRect;
  protected
    procedure CreateHandle; override;
    function GetMetafileHandle: HMetafile;
  public
    constructor Create;
    destructor Destroy; override;
    property Rect: TRect read FRect write FRect;
    property MetafileHandle: HMetafile read GetMetafileHandle;
  end;

constructor TMetafileCanvas.Create;
begin
  inherited Create;
  FClipboardHandle := GlobalAlloc(
    GMEM_SHARE or GMEM_ZEROINIT, SizeOf(TMetafilePict));
end;

destructor TMetafileCanvas.Destroy;
begin
  DeleteMetafile(CloseMetafile(Handle));
  if Bool(FClipboardHandle) then GlobalFree(FClipboardHandle);
  if Bool(FMetafileHandle) then DeleteMetafile(FMetafileHandle);
  inherited Destroy;
end;

procedure TMetafileCanvas.CreateHandle;
var
  MetafileDC: HDC;
begin
  { Create a metafile DC in memory }
  MetafileDC := CreateMetaFile(nil);
  if Bool(MetafileDC) then
  begin
    { Map the top,left corner of the displayed rectangle to the top,left of the
      device context. Leave a border of 10 logical units around the picture. }
    with FRect do SetWindowOrg(MetafileDC, Left - 10, Top - 10);
    { Set the extent of the picture with a border of 10 logical units. }
    with FRect do SetWindowExt(MetafileDC, Right - Left + 20, Bottom - Top + 20);
    { Play any valid metafile contents to it. }
    if Bool(FMetafileHandle) then
    begin
      PlayMetafile(MetafileDC, FMetafileHandle);
    end;
  end;
  Handle := MetafileDC;
end;

function TMetafileCanvas.GetMetafileHandle: HMetafile;