home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 January / Pcwk0198.iso / Dcomplib / BACKDROP.LZH / BACKDROP.PAS < prev   
Pascal/Delphi Source File  |  1995-11-06  |  12KB  |  324 lines
  1. unit Backdrop;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs;
  8.  
  9. type
  10.    TDirection = (bdUp, bdDown, bdLeft, bdRight, bdHorzIn, bdHorzOut, bdVertIn, bdVertOut);
  11.    TBackClrs = (clRed, clLime, clYellow, clBlue, clFuchsia, clAqua, clWhite);
  12.    TOneWayType = (Up, Down, DLeft, DRight);
  13.    TTwoWayType = (DIn, DOut);
  14.    TTwoWayDir = (Horz, Vert);
  15.  
  16. type
  17.   TBackDrop = class(TGraphicControl)
  18.    constructor Create(AComponent: TComponent); override;
  19.    procedure Loaded; override;
  20.   private
  21.     { Private declarations }
  22.    BgnClr: TBackClrs;
  23.    FDir: TDirection;
  24.    FClr: TBackClrs;
  25.    procedure HorzOneWay(Clr1, Clr2: TColor);
  26.    procedure HorzTwoWay(Clr1, Clr2: TColor);
  27.    procedure VertOneWay(Clr1, Clr2: TColor);
  28.    procedure VertTwoWay(Clr1, Clr2: TColor);
  29.    {***}
  30.    procedure SetDir(Dir: TDirection);
  31.    procedure SetColor(Clr: TBackClrs);
  32.    {***}
  33.    procedure FillOneWay(WType: TOneWayType; Clr: TColor);
  34.    procedure FillTwoWay(WType: TTwoWayType; WDir: TTwoWayDir; Clr: TColor);
  35.   protected
  36.     { Protected declarations }
  37.    procedure Paint; override;
  38.   public
  39.     { Public declarations }
  40.   published
  41.    { Published declarations }
  42.    property Direction: TDirection read FDir write SetDir default bdUp;
  43.    property Color: TBackClrs read FClr write SetColor default clBlue;
  44.   end;
  45.  
  46. procedure Register;
  47.  
  48. implementation
  49.  
  50. constructor TBackDrop.Create(AComponent: TComponent);
  51. begin
  52.    FDir := bdUp;
  53.    FClr := clBlue;
  54.    Align := alClient;
  55.    BgnClr := clBlue;
  56.    inherited Create(AComponent);
  57. end;
  58.  
  59. procedure TBackDrop.Loaded;
  60. begin
  61.    inherited Loaded;
  62. end;
  63.  
  64. procedure TBackDrop.SetDir(Dir: TDirection);
  65. begin
  66.    FDir := Dir;
  67.    Repaint;
  68. end;
  69.  
  70. procedure TBackDrop.SetColor(Clr: TBackClrs);
  71. begin
  72.    FClr := Clr;
  73.    BgnClr := Clr;
  74.    Repaint;
  75. end;
  76.  
  77. procedure TBackDrop.HorzOneWay(Clr1, Clr2: TColor);
  78. var
  79.   RGBFrom   : array[0..2] of Byte;    { from RGB values                     }
  80.   RGBDiff   : array[0..2] of integer; { difference of from/to RGB values    }
  81.   ColorBand : TRect;                  { color band rectangular coordinates  }
  82.   I         : Integer;                { color band index                    }
  83.   R         : Byte;                   { a color band's R value              }
  84.   G         : Byte;                   { a color band's G value              }
  85.   B         : Byte;                   { a color band's B value              }
  86. begin
  87.    { extract from RGB values}
  88.    RGBFrom[0] := GetRValue (ColorToRGB (Clr1));
  89.    RGBFrom[1] := GetGValue (ColorToRGB (Clr1));
  90.    RGBFrom[2] := GetBValue (ColorToRGB (Clr1));
  91.    { calculate difference of from and to RGB values}
  92.    RGBDiff[0] := GetRValue (ColorToRGB (Clr2)) - RGBFrom[0];
  93.    RGBDiff[1] := GetGValue (ColorToRGB (Clr2)) - RGBFrom[1];
  94.    RGBDiff[2] := GetBValue (ColorToRGB (Clr2)) - RGBFrom[2];
  95.    { set pen sytle and mode}
  96.    Canvas.Pen.Style := psSolid;
  97.    Canvas.Pen.Mode := pmCopy;
  98.    { set color band's left and right coordinates}
  99.    ColorBand.Left := 0;
  100.    ColorBand.Right := Width;
  101.    for I := 0 to $ff do
  102.    begin
  103.        { calculate color band's top and bottom coordinates}
  104.        ColorBand.Top    := MulDiv (I    , Height, $100);
  105.        ColorBand.Bottom := MulDiv (I + 1, Height, $100);
  106.        { calculate color band color}
  107.        R := RGBFrom[0] + MulDiv (I, RGBDiff[0], $ff);
  108.        G := RGBFrom[1] + MulDiv (I, RGBDiff[1], $ff);
  109.        B := RGBFrom[2] + MulDiv (I, RGBDiff[2], $ff);
  110.        { select brush and paint color band}
  111.        Canvas.Brush.Color := RGB (R, G, B);
  112.        Canvas.FillRect (ColorBand);
  113.    end;
  114. end;
  115.  
  116. procedure TBackDrop.VertOneWay(Clr1, Clr2: TColor);
  117. var
  118.   RGBFrom   : array[0..2] of Byte;    { from RGB values                     }
  119.   RGBDiff   : array[0..2] of integer; { difference of from/to RGB values    }
  120.   ColorBand : TRect;                  { color band rectangular coordinates  }
  121.   I         : Integer;                { color band index                    }
  122.   R         : Byte;                   { a color band's R value              }
  123.   G         : Byte;                   { a color band's G value              }
  124.   B         : Byte;                   { a color band's B value              }
  125. begin
  126.    { extract from RGB values}
  127.    RGBFrom[0] := GetRValue (ColorToRGB (Clr1));
  128.    RGBFrom[1] := GetGValue (ColorToRGB (Clr1));
  129.    RGBFrom[2] := GetBValue (ColorToRGB (Clr1));
  130.    { calculate difference of from and to RGB values}
  131.    RGBDiff[0] := GetRValue (ColorToRGB (Clr2)) - RGBFrom[0];
  132.    RGBDiff[1] := GetGValue (ColorToRGB (Clr2)) - RGBFrom[1];
  133.    RGBDiff[2] := GetBValue (ColorToRGB (Clr2)) - RGBFrom[2];
  134.    { set pen sytle and mode}
  135.    Canvas.Pen.Style := psSolid;
  136.    Canvas.Pen.Mode := pmCopy;
  137.    { set color band's left and right coordinates}
  138.    ColorBand.Top := 0;
  139.    ColorBand.Bottom := Height;
  140.    for I := 0 to $ff do
  141.    begin
  142.        { calculate color band's top and bottom coordinates}
  143.        ColorBand.Left    := MulDiv (I    , Width, $100);
  144.        ColorBand.Right := MulDiv (I + 1, Width, $100);
  145.        { calculate color band color}
  146.        R := RGBFrom[0] + MulDiv (I, RGBDiff[0], $ff);
  147.        G := RGBFrom[1] + MulDiv (I, RGBDiff[1], $ff);
  148.        B := RGBFrom[2] + MulDiv (I, RGBDiff[2], $ff);
  149.        { select brush and paint color band}
  150.        Canvas.Brush.Color := RGB (R, G, B);
  151.        Canvas.FillRect (ColorBand);
  152.    end;
  153. end;
  154.  
  155. procedure TBackDrop.HorzTwoWay(Clr1, Clr2: TColor);
  156. var
  157.   RGBFrom   : array[0..2] of Byte;    { from RGB values                     }
  158.   RGBDiff   : array[0..2] of integer; { difference of from/to RGB values    }
  159.   ColorBand : TRect;                  { color band rectangular coordinates  }
  160.   j, I      : Integer;                { color band index                    }
  161.   R         : Byte;                   { a color band's R value              }
  162.   G         : Byte;                   { a color band's G value              }
  163.   B         : Byte;                   { a color band's B value              }
  164. begin
  165.    { extract from RGB values}
  166.    RGBFrom[0] := GetRValue (ColorToRGB (Clr1));
  167.    RGBFrom[1] := GetGValue (ColorToRGB (Clr1));
  168.    RGBFrom[2] := GetBValue (ColorToRGB (Clr1));
  169.    { calculate difference of from and to RGB values}
  170.    RGBDiff[0] := GetRValue (ColorToRGB (Clr2)) - RGBFrom[0];
  171.    RGBDiff[1] := GetGValue (ColorToRGB (Clr2)) - RGBFrom[1];
  172.    RGBDiff[2] := GetBValue (ColorToRGB (Clr2)) - RGBFrom[2];
  173.    { set pen sytle and mode}
  174.    Canvas.Pen.Style := psSolid;
  175.    Canvas.Pen.Mode := pmCopy;
  176.    { set color band's left and right coordinates}
  177.    ColorBand.Left := 0;
  178.    ColorBand.Right := Width;
  179.    for I := 0 to ($ff div 2) do
  180.    begin
  181.        { calculate color band's top and bottom coordinates}
  182.        ColorBand.Top    := MulDiv (I    , Height, $100);
  183.        ColorBand.Bottom := MulDiv (I + 1, Height, $100);
  184.        { calculate color band color}
  185.        R := RGBFrom[0] + MulDiv (I * 2, RGBDiff[0], $ff);
  186.        G := RGBFrom[1] + MulDiv (I * 2, RGBDiff[1], $ff);
  187.        B := RGBFrom[2] + MulDiv (I * 2, RGBDiff[2], $ff);
  188.        { select brush and paint color band}
  189.        Canvas.Brush.Color := RGB (R, G, B);
  190.        Canvas.FillRect (ColorBand);
  191.    end;
  192.    if FDir = bdHorzIn then
  193.        Canvas.Brush.Color := Clr2;
  194.    ColorBand.Top := MulDiv(I + 1,Height,$100);
  195.    ColorBand.Bottom := MulDiv(I + 2,Height,$100);
  196.    Canvas.FillRect(ColorBand);
  197.    j := I;
  198.    for I := $ff downto ($ff div 2) do
  199.    begin
  200.        ColorBand.Top    := MulDiv (I    , Height, $100);
  201.        ColorBand.Bottom := MulDiv (I + 1, Height, $100);
  202.        R := RGBFrom[0] + MulDiv (j * 2, RGBDiff[0], $ff);
  203.        G := RGBFrom[1] + MulDiv (j * 2, RGBDiff[1], $ff);
  204.        B := RGBFrom[2] + MulDiv (j * 2, RGBDiff[2], $ff);
  205.        Canvas.Brush.Color := RGB (R, G, B);
  206.        Canvas.FillRect (ColorBand);
  207.        Inc(j);
  208.    end;
  209. end;
  210.  
  211. procedure TBackDrop.VertTwoWay(Clr1, Clr2: TColor);
  212. var
  213.   RGBFrom   : array[0..2] of Byte;    { from RGB values                     }
  214.   RGBDiff   : array[0..2] of integer; { difference of from/to RGB values    }
  215.   ColorBand : TRect;                  { color band rectangular coordinates  }
  216.   j, I      : Integer;                { color band index                    }
  217.   R         : Byte;                   { a color band's R value              }
  218.   G         : Byte;                   { a color band's G value              }
  219.   B         : Byte;                   { a color band's B value              }
  220. begin
  221.    { extract from RGB values}
  222.    RGBFrom[0] := GetRValue (ColorToRGB (Clr1));
  223.    RGBFrom[1] := GetGValue (ColorToRGB (Clr1));
  224.    RGBFrom[2] := GetBValue (ColorToRGB (Clr1));
  225.    { calculate difference of from and to RGB values}
  226.    RGBDiff[0] := GetRValue (ColorToRGB (Clr2)) - RGBFrom[0];
  227.    RGBDiff[1] := GetGValue (ColorToRGB (Clr2)) - RGBFrom[1];
  228.    RGBDiff[2] := GetBValue (ColorToRGB (Clr2)) - RGBFrom[2];
  229.    { set pen sytle and mode}
  230.    Canvas.Pen.Style := psSolid;
  231.    Canvas.Pen.Mode := pmCopy;
  232.    { set color band's left and right coordinates}
  233.    ColorBand.Top := 0;
  234.    ColorBand.Bottom := Height;
  235.    for I := 0 to ($ff div 2) do
  236.    begin
  237.        { calculate color band's top and bottom coordinates}
  238.        ColorBand.Left    := MulDiv (I    , Width, $100);
  239.        ColorBand.Right := MulDiv (I + 1, Width, $100);
  240.        { calculate color band color}
  241.        R := RGBFrom[0] + MulDiv (I * 2, RGBDiff[0], $ff);
  242.        G := RGBFrom[1] + MulDiv (I * 2, RGBDiff[1], $ff);
  243.        B := RGBFrom[2] + MulDiv (I * 2, RGBDiff[2], $ff);
  244.        { select brush and paint color band}
  245.        Canvas.Brush.Color := RGB (R, G, B);
  246.        Canvas.FillRect (ColorBand);
  247.    end;
  248.    if FDir = bdVertIn then
  249.        Canvas.Brush.Color := Clr2;
  250.    ColorBand.Left := MulDiv(I + 1,Width,$100);
  251.    ColorBand.Right := MulDiv(I + 2,Width,$100);
  252.    Canvas.FillRect(ColorBand);
  253.    j := I;
  254.    for I := $ff downto ($ff div 2) do
  255.    begin
  256.        ColorBand.Left    := MulDiv (I    , Width, $100);
  257.        ColorBand.Right := MulDiv (I + 1, Width, $100);
  258.        R := RGBFrom[0] + MulDiv (j * 2, RGBDiff[0], $ff);
  259.        G := RGBFrom[1] + MulDiv (j * 2, RGBDiff[1], $ff);
  260.        B := RGBFrom[2] + MulDiv (j * 2, RGBDiff[2], $ff);
  261.        Canvas.Brush.Color := RGB (R, G, B);
  262.        Canvas.FillRect (ColorBand);
  263.        Inc(j);
  264.    end;
  265. end;
  266.  
  267. procedure TBackDrop.FillOneWay(WType: TOneWayType; Clr: TColor);
  268. begin
  269.    if WType = Up then HorzOneWay(Clr,clBlack);
  270.    if WType = Down then HorzOneWay(clBlack,Clr);
  271.    if WType = DLeft then VertOneWay(Clr,clBlack);
  272.    if WType = DRight then VertOneWay(clBlack,Clr);
  273. end;
  274.  
  275. procedure TBackDrop.FillTwoWay(WType: TTwoWayType; WDir: TTwoWayDir; Clr: TColor);
  276. begin
  277.    if WDir = Horz then
  278.    begin
  279.        if WType = DIn then HorzTwoWay(clBlack,Clr);
  280.        if WType = DOut then HorzTwoWay(Clr,clBlack);
  281.    end
  282.    else
  283.    begin
  284.        if WType = DIn then VertTwoWay(clBlack,Clr);
  285.        if WType = DOut then VertTwoWay(Clr,clBlack);
  286.    end;
  287. end;
  288.  
  289. procedure TBackDrop.Paint;
  290. var
  291.    UseClr: TColor;
  292. begin
  293.    if BgnClr = clRed then UseClr := $000000FF;
  294.    if BgnClr = clLime then UseClr := $0000FF00;
  295.    if BgnClr = clYellow then UseClr := $0000FFFF;
  296.    if BgnClr = clBlue then UseClr := $00FF0000;
  297.    if BgnClr = clFuchsia then UseClr := $00FF00FF;
  298.    if BgnClr = clAqua then UseClr := $00FFFF00;
  299.    if BgnClr = clWhite then UseClr := $00FFFFFF;
  300.    if FDir = bdUp then
  301.       FillOneWay(Up, UseClr);
  302.    if FDir = bdDown then
  303.        FillOneWay(Down, UseClr);
  304.    if FDir = bdLeft then
  305.        FillOneWay(DLeft, UseClr);
  306.    if FDir = bdRight then
  307.        FillOneWay(DRight, UseClr);
  308.    if FDir = bdHorzOut then
  309.        FillTwoWay(DOut, Horz, UseClr);
  310.    if FDir = bdHorzIn then
  311.        FillTwoWay(DIn, Horz, UseClr);
  312.    if FDir = bdVertIn then
  313.        FillTwoWay(DIn, Vert, UseClr);
  314.    if FDir = bdVertOut then
  315.        FillTwoWay(DOut, Vert, UseClr);
  316. end;
  317.  
  318. procedure Register;
  319. begin
  320.   RegisterComponents('Custom', [TBackDrop]);
  321. end;
  322.  
  323. end.
  324.