home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / BGVGA256.ZIP / HSI.PAS next >
Encoding:
Pascal/Delphi Source File  |  1989-05-31  |  3.4 KB  |  159 lines
  1. program HSI;
  2. {$N+,E+}
  3.  
  4. { Copyright (c) 1987,89 Borland International }
  5.  
  6.  
  7. { illustrates conversion of Hue-Saturation-Intensity to Red-Green-Blue }
  8.  
  9. uses
  10.   Dos, Crt, Graph;
  11. type
  12.   ColorValue     = record
  13.                      Rvalue, Gvalue, Bvalue : byte;
  14.                    end;
  15.   VGAPaletteType = array[0..255] of ColorValue;
  16.  
  17. {$IFOPT N+}
  18.   Float = double;
  19. {$ELSE}
  20.   Float = real;
  21. {$ENDIF}
  22.  
  23. procedure VGASetAllPalette(var P : VGAPaletteType);
  24. var
  25.   Regs : Registers;
  26. begin
  27.   with Regs do
  28.   begin
  29.     AX := $1012;
  30.     BX := 0;
  31.     CX := 256;
  32.     ES := Seg(P);
  33.     DX := Ofs(P);
  34.   end;
  35.   Intr($10, Regs);
  36. end; { VGASetAllPalette }
  37.  
  38. procedure Hsi2Rgb(H, S, I : Float; var C : ColorValue);
  39. var
  40.   T : Float;
  41.   Rv, Gv, Bv : Float;
  42. begin
  43.   T := 2 * Pi * H;
  44.   Rv := 1 + S * Sin(T - 2 * Pi / 3);
  45.   Gv := 1 + S * Sin(T);
  46.   Bv := 1 + S * Sin(T + 2 * Pi / 3);
  47.   T := 63.999 * I / 2;
  48.   with C do
  49.   begin
  50.     Rvalue := trunc(Rv * T);
  51.     Gvalue := trunc(Gv * T);
  52.     Bvalue := trunc(Bv * T);
  53.   end;
  54. end; { Hsi2Rgb }
  55.  
  56. procedure Wait;
  57. var
  58.   Ch : char;
  59. begin
  60.   repeat until KeyPressed;
  61.   Ch := ReadKey;
  62.   if Ch = #0 then
  63.     Ch := ReadKey;
  64. end;
  65.  
  66. {$F+}
  67. function DetectVGA256 : integer;
  68. var
  69.   DetectedDriver : integer;
  70.   SuggestedMode  : integer;
  71. begin
  72.   DetectGraph(DetectedDriver, SuggestedMode);
  73.   if (DetectedDriver = VGA) or (DetectedDriver = MCGA) then
  74.     DetectVGA256 := 0        { Default video mode = 0 }
  75.   else
  76.     DetectVGA256 := grError; { Couldn't detect hardware }
  77. end; { DetectVGA256 }
  78. {$F-}
  79.  
  80. var
  81.   H, S, I : Float;
  82.   X, Y, Z : integer;
  83.   C       : ColorValue;
  84.   P       : VGAPaletteType;
  85.   Xx, Yy  : integer;
  86.   Jj      : integer;
  87.   K       : integer;
  88.  
  89.   AutoDetectPointer : pointer;
  90.   Driver, Mode : integer;
  91.   ErrorCode : integer;
  92. begin
  93.   ClrScr;
  94.   writeln('Hue-Saturation-Intensity to Red-Green-Blue Conversion Example');
  95.   writeln('Copyright (c) 1987,1989 Borland International Inc.');
  96.   writeln;
  97.   DirectVideo := false;
  98.   AutoDetectPointer := @DetectVGA256; { Point to detection routine }
  99.   Driver := InstallUserDriver('VGA256', AutoDetectPointer);
  100.   Driver := Detect;
  101.   InitGraph(Driver, Mode, '');
  102.   ErrorCode := GraphResult;
  103.   if ErrorCode <> grOK then
  104.   begin
  105.     Writeln('Error: ', GraphErrorMsg(ErrorCode));
  106.     Halt;
  107.   end;
  108.  
  109. { create grey scale }
  110.   for Z := 0 to 15 do
  111.     with P[Z] do
  112.     begin
  113.       Rvalue := Z * 4;
  114.       Gvalue := Z * 4;
  115.       Bvalue := Z * 4;
  116.     end;
  117.  
  118. { create HSI spectrum }
  119.   for X := 0 to 3 do      { four different intensities }
  120.     for Y := 0 to 2 do    { three different saturations }
  121.       for Z := 0 to 19 do { twenty different hues }
  122.       begin
  123.         { determine H,S,I between 0 and 1 }
  124.         H := Z / 20;
  125.         S := (Y+1) / 3;
  126.         I := (X+1) / 4;
  127.         { calculate and store R,G,B values }
  128.         Hsi2Rgb(H, S, I, C);
  129.         P[16+Z+20*Y+60*X] := C;
  130.       end;
  131.  
  132.   VGASetAllPalette(P);
  133.   { draw grey scale }
  134.   for X := 0 to 15 do
  135.   begin
  136.     Xx := 200;
  137.     Yy := X * 8;
  138.     for Jj := 0 to 7 do
  139.     begin
  140.       SetFillStyle(SolidFill, 15-X);
  141.       Bar(Xx, Yy+Jj, Xx+7, Yy+Jj+7);
  142.     end;
  143.   end;
  144.  
  145.   { draw spectrum }
  146.   for Z := 0 to 19 do
  147.     for X := 0 to 3 do
  148.       for Y := 0 to 2 do
  149.       begin
  150.         K := 16+Z+20*Y+60*X;
  151.         Xx := 8*X+40*(Z mod 5);
  152.         Yy := 8*Y+32*(Z div 5);
  153.         SetFillStyle(SolidFill, K);
  154.         Bar(Xx, Yy, Xx+7, Yy+7);
  155.       end;
  156.  
  157.   Wait;
  158.   CloseGraph;
  159. end.