⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 graphics.htm

📁 对于学习很有帮助
💻 HTM
📖 第 1 页 / 共 3 页
字号:
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
<HTML>
<HEAD>
<TITLE>UDDF - Graphics</TITLE>
<META CONTENT="A collection of graphical routines for Delphi " NAME="Description">
</HEAD>

<body bgcolor="#FFFFFF">
<CENTER>
<IMG SRC="../images/uddf.jpg"> </CENTER>
<HR SIZE="6" color="#00FF00">

<FONT FACE="Arial Black" SIZE=7 COLOR="#ff0000"><P ALIGN="CENTER">Graphics</P>
</FONT>
<P><H1><A NAME="graphics0">TGA header</P></A></H1>
<I><P>From: 'Derek A. Benner' &lt;dbenner@pacbell.net&gt;</P>
</I><P>OK, Straight from 'Graphics File Formats, 2nd Edition' by David C. Kay &amp; John R. Levine, here is the header format for the Targa image file. </P>
<PRE>Offset          Length (in bytes)       Description
------          -----------------       -----------
0               1                       ID Field Length
1               1                       Color-map Type
2               1                       Image Type

        (Color-map-specific Info)
3               2                       First Color-map Entry
5               2                       Color-map Length
7               1                       Color-map Entry Size

        (Image-specific Info)
8               2                       Image X Origin
10              2                       Image Y Origin
12              2                       Image Width
14              2                       Image Height
16              1                       Bits-Per-Pixel
17              1                       Image-Descriptor Bits</PRE>
<P>For True-color images the value of Color-map Type should be 0, while color-mapped images should set this to 1. 
If a color map is present, then Color-map Entry Size should be set to 15, 16, 24 or 32. For 15 and 16 values each 
color map entry is stored in two bytes in the format of: </P>
<PRE>High byte    Low byte  
A RRRRR GG   GGG BBBBB  </PRE>
<P>with the 'A' bit set to 0 for 15-bit color values. 24-bit-sized entries are stored as three bytes in the order of 
(B)lue, (G)reen, and (R)ed. 32-bit-sized color map entries are stored in four bytes ordered as (B)lue, (G)reen, (R)ed and (A)ttribute values. </P>
<P>Further, the Image Type code should contain one of the following values: </P>
<PRE>Code            Description
----            -----------
0               No Image Present
1               Color-mapped, uncompressed
2               True-color, uncompressed
3               Black-&amp;-White, uncompressed
9               Color-mapped, RLE compressed
10              True-color, RLE compressed
11              Black-&amp;-White, RLE compressed</PRE>
<P>The Image X &amp; Y Origins and the Image Width &amp; Height fields are self-explanatory. 
Bits-Per-Pixel holds the number of bits per image pixel and should hold the values 8, 16, 24, or 32. </P>
<P>The Image Descriptor byte contains several bit fields that need to be extracted: </P>
<PRE>Bits            Description
----            -----------
0-3             Attribute Bits (Explained later)
4               Left-to-Right orientation 0=L/R 1=R/L
5               Top/Bottom orientation 0=B/T 1=T/B
6-7             Scan-Line Interleaving 00H=None, 40H=2way, 80H=4way</PRE>
<P>The Attribute bits are used to define the attributes of the colors in color-mapped or true-color pixels. 
0 means no alpha data, 1 means undefined and ignorable, 2 means undefined but should be preserved, 
3 means regular alpha data and 4 means the pixel information has already been multiplied by the alpha value. </P>
<P>Version 2.0 Targa files also have a file footer that may contain additional image and comment information. 
A version 2.0 Targa file always ends with the null-terminated string 'TRUEVISION-TARGA.'. 
So, if your Targa image ends with the values 'TRUEVISION-TARGA.' + 00H then you can extract the eight bytes prior to 
the string to find the start of the extension area and the developer directory positions within the file. Basically the Version 2.0 footer takes the format: </P>
<PRE>Byte            Length          Description
-----           ------          -----------
0               4               32-bit offset to Extension Area
4               4               32-bit offset to Developer Directory
8               17              TRUEVISION-TARGA.
25              1               Binary zero ($0)</PRE>
<P>I'm not going to give complete descriptions to the Developer's Directory or the Extension Area. 
Instead, I'm going to point out the postage-stamp info that the V2.0 Targa file *MAY* contain. 
This postage stamp is a miniature of the image, no larger than 64 X 64 pixels in size, *IF PRESENT*! </P>
<P>Extension Area </P>
<PRE>Offset          Length          Description
------          ------          -----------
0               2               Extension Area Size (should be 495)
2               41              Author's Name
43              81              Author's Comments
124             81              Author's Comments
205             81              Author's Comments
286             81              Author's Comments
367             2               Creation Month
369             2               Creation Day
371             2               Creation Year
....            ...             ...
482             4               Color-correction table file offset
486             4               Postage-Stamp Image File Offset  ******
490             4               Scan-line table file offset
494             1               Attribute byte</PRE>
<P>This postage-stamp image, if present, may be directly usable by you. It is an uncompressed image in the same color format (Color-mapped or True-color) as the full image. </P>
<H1><A NAME="graphics1">*** Drawing CURVES in Delphi? ***</A></H1>
<H2>Solution 1</H2>
<I><P>From: dmitrys@phyast.la.asu.edu (Dmitry Streblechenko)</P>
</I><PRE>In article &lt;4uijv6$kf7@newsbf02.news.aol.com,
   gtabsoft2@aol.com (GTABSoft2) wrote:
Does anyone have source code or info on drawing Bezier curves? I must have
it for my component. Please respond to my email address.</PRE>
<P>I did this some time ago; I was too lazy to learn how to draw Bezier curves using Win API, so I did it using Polyline(). </P>
<P>Note I used floating type values for points coordinates, (I used some kind of virtual screen), just change them to integer.</P>
<P><HR></P>
<PRE> PBezierPoint = ^TBezierPoint;
 TBezierPoint = record
  X,Y:double;   //main node
  Xl,Yl:double; //left control point
  Xr,Yr:double; //right control point
 end;

//P1 and P2 are two TBezierPoint's, t is between 0 and 1:
//when t=0 X=P1.X, Y=P1.Y; when t=1 X=P2.X, Y=P2.Y;

procedure BezierValue(P1,P2:TBezierPoint; t:double; var X,Y:double);
 var t_sq,t_cb,r1,r2,r3,r4:double;
 begin
     t_sq := t * t;
     t_cb := t * t_sq;
     r1 := (1 - 3*t + 3*t_sq -   t_cb)*P1.X;
     r2 := (    3*t - 6*t_sq + 3*t_cb)*P1.Xr;
     r3 := (          3*t_sq - 3*t_cb)*P2.Xl;
     r4 := (                     t_cb)*P2.X;
     X  := r1 + r2 + r3 + r4;
     r1 := (1 - 3*t + 3*t_sq -   t_cb)*P1.Y;
     r2 := (    3*t - 6*t_sq + 3*t_cb)*P1.Yr;
     r3 := (          3*t_sq - 3*t_cb)*P2.Yl;
     r4 := (                     t_cb)*P2.Y;
     Y  := r1 + r2 + r3 + r4;
 end;</PRE>
<P><HR></P>
<P>To draw Bezier curve, split interval between P1 and P2 into several intervals based on how coarse you want your 
Bezier curve look (3 - 4 pixels looks Ok), then in a loop create an array of points using procedure above with t from 0 to 1 
and draw that array of points using polyline().</P>
<H2>Solution 2</H2>
<I><P>From: saconn@iol.ie (Stephen Connolly)</P>
</I><PRE>gtabsoft2@aol.com (GTABSoft2) wrote:
Does anyone have source code or info on drawing Bezier curves? I must have
it for my component. Please respond to my email address.</PRE>
<P>I'm posting this here - 'cause: 1. I've seen people ask for this before, 2. The reference is so old I just had to. (BTW I have older references than this ;-P)</P>
<P>I'm sure that there is a standard Borland disclaimer to go with this:</P>
<P><HR></P>
<PRE>(********************************************************************)
(*                         GRAPHIX TOOLBOX 4.0                      *)
(*       Copyright (c) 1985, 87 by  Borland International, Inc.     *)
(********************************************************************)
unit GShell;

interface

{-------------------------------- snip ----------------------------}

procedure Bezier(A : PlotArray; MaxContrPoints : integer;
                 var B : PlotArray; MaxIntPoints : integer);

implementation

{-------------------------------- snip ---------------------------}

procedure Bezier{(A : PlotArray; MaxContrPoints : integer;
                 var B : PlotArray; MaxIntPoints : integer)};
const
  MaxControlPoints = 25;
type
  CombiArray = array[0..MaxControlPoints] of Float;
var
  N : integer;
  ContrPoint, IntPoint : integer;
  T, SumX, SumY, Prod, DeltaT, Quot : Float;
  Combi : CombiArray;

begin
  MaxContrPoints := MaxContrPoints - 1;
  DeltaT := 1.0 / (MaxIntPoints - 1);
  Combi[0] := 1;
  Combi[MaxContrPoints] := 1;
  for N := 0 to MaxContrPoints - 2 do
    Combi[N + 1] := Combi[N] * (MaxContrPoints - N) / (N + 1);
  for IntPoint := 1 to MaxIntPoints do
  begin
    T := (IntPoint - 1) * DeltaT;
    if T &lt;= 0.5 then
      begin
        Prod := 1.0 - T;
        Quot := Prod;
        for N := 1 to MaxContrPoints - 1 do
          Prod := Prod * Quot;
        Quot := T / Quot;
        SumX := A[MaxContrPoints + 1, 1];
        SumY := A[MaxContrPoints + 1, 2];
        for N := MaxContrPoints downto 1 do
        begin
          SumX := Combi[N - 1] * A[N, 1] + Quot * SumX;
          SumY := Combi[N - 1] * A[N, 2] + Quot * SumY;
        end;
      end
    else
      begin
        Prod := T;
        Quot := Prod;
        for N := 1 to MaxContrPoints - 1 do
          Prod := Prod * Quot;
        Quot := (1 - T) / Quot;
        SumX := A[1, 1];
        SumY := A[1, 2];
        for N := 1 to MaxContrPoints do
        begin
          SumX := Combi[N] * A[N + 1, 1] + Quot * SumX;
          SumY := Combi[N] * A[N + 1, 2] + Quot * SumY;
        end;
      end;
    B[IntPoint, 1] := SumX * Prod;
    B[IntPoint, 2] := SumY * Prod;
  end;
end; { Bezier }

end. { GShell }
</PRE>
<P><HR></P>
<H1><A NAME="graphics2">FFT algorithm for Delphi 2</A></H1>
<I><P>David Ullrich &lt;ullrich@math.okstate.edu&gt;</P>
</I><P>Here's an FFT that handles 256 data points in about 0.008 seconds on a P66 (with 72MB, YMMV). Nothing but Delphi.</P>
<P>This one came out a lot nicer than the one I did a year ago. It's probably not optimal; if we want an optimal FFT we have to buy hardware, what the heck.<BR>
But I don't think it's too bad, performance-wise. 
There's a little bit of recursion involved, but the recursion doesn't involve copying any data, just a few pointers; 
if we have an array of length N = 2^d then the depth of the recursion is just d. 
Possibly it could be improved by unwrapping the recursion, it's not clear whether it would be worth the trouble. 
(But probably a person could get substantial inprovement with relatively little effort by unwrapping the bottom layer or two of the recursion, ie by saying </P>
<P><HR></P>
<PRE>if Depth &lt; 2 then
{do what needs to be done}</PRE>
<P><HR></P>
<P>instead of the current 'if Depth = 0 then...' 
This would eliminate function calls that do nothing but make assignments, a good thing, while OTOH unwrapping all of the resursion 
would be trickier, and wouldn't seem as productive, since most of the function calls that would be eliminated do much more than just an assignment.)<BR>
There's a lookup table used for the sines and cosines; it could be that this is the wrong way to do it for large arrays, seems to work just fine for small to medium arrays.</P>
<P>Probably on a mchine with a lot of RAM a person would use VirtualAlloc(... PAGE_NOCACHE) for Src, Dest, and the lookup tables.</P>
<P>If anybody notices anything stupid about the way something's done not mentioned above please mention it.</P>
<P>What does it do, exactly? There are FFT's and FFT's - this one does the 'complex FT', 
that being the one I understand and care about. By this I mean that if N = 2^d and Src^ and Dest^ are arrays of N TComplexes, then a call </P>
<P><HR></P>
<PRE>FFT(d, Src, Dest)</PRE>
<P><HR></P>
<P>will fill in Dest with the complex FT: after the call Dest^[j] will equal </P>
<P><HR></P>
<PRE>1/sqrt(N) * Sum(k=0.. N - 1 ; EiT(2*Pi(j*k/N)) * Src^[k])</PRE>
<P><HR></P>
<P>, where EiT(t) = cos(t) + i sin(t) . Ie, the standard Fourier Transform.</P>
<P>Comes in two versions: In the first version I use a TComplex, with functions to 
manipulate the complex numbers. In the second version everything's real - 
instead of arrays Src and Dest of complexes we have arrays SrcR, SrcI, DestR, DestI of reals (for the real and imagionary parts), and all 
those function calls are written out inline. 
The first one is much easier for me to make sense of, the second version is much faster. (They both give the 'complex FFT'.) 
With little programs that test whether it does what it should by checking Plancherel (aka Parseval). It really does work, 
btw - if it doesn't work for you it's because I garbled something in the process of deleting stupid comments. The complex version: </P>
<P><HR></P>
<PRE>***
unit cplx;

interface


type
    PReal = ^TReal;
    TReal = extended;

    PComplex = ^TComplex;
    TComplex = record
      r : TReal;
      i : TReal;
    end;


function MakeComplex(x, y: TReal): TComplex;
function Sum(x, y: TComplex) : TComplex;
function Difference(x, y: TComplex) : TComplex;
function Product(x, y: TComplex): TComplex;
function TimesReal(x: TComplex; y: TReal): TComplex;
function PlusReal(x: TComplex; y: TReal): TComplex;
function EiT(t: TReal):TComplex;
function ComplexToStr(x: TComplex): string;
function AbsSquared(x: TComplex): TReal;

implementation

uses SysUtils;

function MakeComplex(x, y: TReal): TComplex;
begin
 with result do
 begin
     r:=x;
     i:= y;
 end;
end;

function Sum(x, y: TComplex) : TComplex;
begin
with result do
begin
    r:= x.r + y.r;
    i:= x.i + y.i;
end;
end;

function Difference(x, y: TComplex) : TComplex;
begin
with result do
begin
    r:= x.r - y.r;
    i:= x.i - y.i;
end;
end;

function EiT(t: TReal): TComplex;
begin
with result do
begin
    r:= cos(t);
    i:= sin(t);
end;
end;


function Product(x, y: TComplex): TComplex;
begin
with result do
begin
    r:= x.r * y.r - x.i * y.i;
    i:= x.r * y.i + x.i * y.r;
end;
end;

function TimesReal(x: TComplex; y: TReal): TComplex;
begin
with result do
begin
    r:= x.r * y;
    i:= x.i * y;
end;
end;

function PlusReal(x: TComplex; y: TReal): TComplex;
begin
with result do
begin
    r:= x.r + y;
    i:= x.i;
end;
end;

function ComplexToStr(x: TComplex): string;
begin
   result:= FloatToStr(x.r)
            + ' + '
            + FloatToStr(x.i)
            + 'i';
end;

function AbsSquared(x: TComplex): TReal;
begin
  result:= x.r*x.r + x.i*x.i;
end;

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

interface

uses Cplx;

type
      PScalar = ^TScalar;
      TScalar = TComplex; {Making conversion to real version easier}

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

const

      TrigTableDepth: word = 0;
      TrigTable : PScalars = nil;

procedure InitTrigTable(Depth: word);

procedure FFT(Depth: word;
              Src: PScalars;
              Dest: PScalars);

{REQUIRES allocating

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

bytes for Src and Dest before call!}

implementation

procedure DoFFT(Depth: word;
              Src: PScalars;
              SrcSpacing: word;
              Dest: PScalars);
{the recursive part called by FFT when ready}
var j, N: integer; Temp: TScalar; Shift: word;
begin
if Depth = 0 then
   begin
      Dest^[0]:= Src^[0];
      exit;
   end;

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

DoFFT(Depth - 1, Src, SrcSpacing * 2, Dest);
DoFFT(Depth - 1, @Src^[SrcSpacing], SrcSpacing * 2, @Dest^[N] );

Shift:= TrigTableDepth - Depth;

for j:= 0 to N - 1 do
begin
   Temp:= Product(TrigTable^[j shl Shift],
                  Dest^[j + N]);
   Dest^[j + N]:= Difference(Dest^[j], Temp);
   Dest^[j]    := Sum(Dest^[j], Temp);
end;

end;

procedure FFT(Depth: word;
              Src: PScalars;
              Dest: PScalars);
var j, N: integer; Normalizer: extended;
begin

N:= integer(1) shl depth;

if Depth  TrigTableDepth then
           InitTrigTable(Depth);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -