Gölge componenti

[White Rose]

birara ben de kafayı takmıştım bu gölge işine ve aşağıdaki componenti
keşfettim, usta delphiciler daha da geliştirebilir. kolay gelsin

Kod: Tümünü seç

unit Golge;

interface

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

type
  TYogunluk = (Yuksek, Dusuk);
  TGolgePos = (Yuksol, Yuksag, Asgsol, Asgsag);

  type
  TGolge  = class(TGraphicControl)

  private
    FGolgeIntensity : integer;
    FGolgeYogunluk  : TYogunluk;
    FGolgePozisyon  : TGolgePos;
    FGolgeGenislik  : integer;
    procedure SetGolgeIntensity(Value : integer);
    procedure SetGolgeYogunluk(Value  : TYogunluk);
    procedure SetGolgePozisyon(Value  : TGolgePos);
    procedure SetGolgeGenislik(Value : integer);
    procedure DrawGolge(Handle : HDC; left,top,right,bottom,width,intensity : integer;
                       GolgePos:TGolgePos; Yogunluk : TYogunluk);
    procedure DrawFilter(Handle : HDC; left,top,right,bottom,intensity : integer; Yogunluk : TYogunluk);

    function PixelChanged(Color:TColor; value:integer) : TColor;

  protected
    procedure paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
  published
    property Align;
    property GolgeIntensity : integer   read FGolgeIntensity write SetGolgeIntensity;
    property GolgeYogunluk  : TYogunluk read FGolgeYogunluk  write SetGolgeYogunluk;
    property GolgePozisyon  : TGolgePos read FGolgePozisyon  write SetGolgePozisyon;
    property GolgeGenislik  : integer   read FGolgeGenislik  write SetGolgeGenislik;
    property visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Sample', [TGolge]);
end;

constructor TGolge.create(aowner : tcomponent);
begin
  inherited Create(AOwner);
  Height := 105;
  Width  := 105;
  FGolgeIntensity := 75;
  FGolgeYogunluk  := Yuksek;
  FGolgePozisyon  := Asgsag;
  FGolgeGenislik  := 10;
end;

destructor TGolge.Destroy;
begin
  inherited Destroy;
end;

procedure TGolge.paint;
var
  CanvasMem : TBitmap;
  BW,BI : integer;
begin
  CanvasMem := TBitmap.Create;
  CanvasMem.Width  := Width;
  CanvasMem.height := height;
  CanvasMem.Canvas.CopyRect(ClientRect,Canvas,ClientRect);
  DrawGolge(CanvasMem.Canvas.handle, 0, 0, width, height, FGolgeGenislik, -FGolgeIntensity, FGolgePozisyon, FGolgeYogunluk);
  inherited canvas.CopyRect(ClientRect,CanvasMem.Canvas,ClientRect);
  CanvasMem.free;
end;

procedure TGolge.SetGolgeIntensity(Value: integer);
begin
  FGolgeIntensity := Value;
  Refresh;
end;

procedure TGolge.SetGolgeYogunluk(Value: TYogunluk);
begin
  FGolgeYogunluk := Value;
  Refresh;
end;

procedure TGolge.SetGolgePozisyon(Value: TGolgePos);
begin
  FGolgePozisyon := Value;
  Refresh;
end;

procedure TGolge.SetGolgeGenislik(Value: integer);
begin
  FGolgeGenislik := Value;
  Refresh;
end;

procedure TGolge.DrawGolge(Handle : HDC; left,top,right,bottom,width,intensity : integer;
          GolgePos:TGolgePos; Yogunluk : TYogunluk);
begin
  case GolgePos of
    Yuksol:
    begin
      DrawFilter(Handle,left+width+1,top,right-width,top+width,intensity,Yogunluk);
      DrawFilter(Handle,left,top,left+width,bottom-width,intensity,Yogunluk);
    end;
    Yuksag:
    begin
      DrawFilter(Handle,left+width,top,right-width-1,top+width,intensity,Yogunluk);
      DrawFilter(Handle,right-width,top,right,bottom-width,intensity,Yogunluk);
    end;
    Asgsag:
    begin
      DrawFilter(Handle,left+width,bottom-width,right-width-1,bottom,intensity,Yogunluk);
      DrawFilter(Handle,right-width,top+width,right,bottom,intensity,Yogunluk);
    end;
    Asgsol:
    begin
      DrawFilter(Handle,left+width+1,bottom-width,right-width,bottom,intensity,Yogunluk);
      DrawFilter(Handle,left,top+width,left+width,bottom,intensity,Yogunluk);
    end;
  end;
end;

procedure TGolge.DrawFilter(Handle : HDC; left,top,right,bottom,intensity : integer; Yogunluk : TYogunluk);
var
  x,y   : integer;
  width : integer;
  Red   : integer;
  Cv    : TCanvas;
begin
  x := left;
  repeat
    y := top;
    repeat
      case Yogunluk of
        Dusuk : if (odd(x)=odd(y)) then setpixel(Handle,x,y,PixelChanged(getpixel(Handle,x,y),Intensity));
        Yuksek  : setpixel(Handle,x,y,PixelChanged(getpixel(Handle,x,y),Intensity));
      end;
      inc(y);
    until y>bottom;
    inc(x);
  until x>right;
end;

function TGolge.PixelChanged(Color:TColor; value:integer) : TColor;
var
  r,g,b : integer;
begin
  r := getrvalue(ColorToRGB(Color));
  g := getgvalue(ColorToRGB(Color));
  b := getbvalue(ColorToRGB(Color));
  if value>0 then
  begin
    if r+value>255 then r := 254 else inc(r,value);
    if g+value>255 then g := 254 else inc(g,value);
    if b+value>255 then b := 254 else inc(b,value);
  end else
  begin
    if r+value<0 then r := 1 else inc(r,value);
    if g+value<0 then g := 1 else inc(g,value);
    if b+value<0 then b := 1 else inc(b,value);
  end;
  result := rgb(r,g,b);
end;

end.

[rsimsek]

Güzel bir paylaşım, teşekkürler

[White Rose]

önemli değil üstad

[ender_arslanturk]

teşekkür ederim. güzel bir bilgi