close
دانلود فیلم
فرم به صورت Gradient

procedure FillGradientRect(Canvas: TCanvas; Recty: TRect; fbcolor, fecolor: TColor; fcolors: Integer);
var
  i, j, h, w, fcolor: Integer;
  R, G, B: Longword;
  beginRGBvalue, RGBdifference: array[0..2] of Longword;
begin
  beginRGBvalue[0] := GetRvalue(colortoRGB(FBcolor));
  beginRGBvalue[1] := GetGvalue(colortoRGB(FBcolor));
  beginRGBvalue[2] := GetBvalue(colortoRGB(FBcolor));

  RGBdifference[0] := GetRvalue(colortoRGB(FEcolor)) - beginRGBvalue[0];
  RGBdifference[1] := GetGvalue(colortoRGB(FEcolor)) - beginRGBvalue[1];
  RGBdifference[2] := GetBvalue(colortoRGB(FEcolor)) - beginRGBvalue[2];

  Canvas.pen.Style := pssolid;
  Canvas.pen.mode := pmcopy;
  j := 0;
  h := recty.Bottom - recty.Top;
  w := recty.Right - recty.Left;

  for i := fcolors downto 0 do
  begin
  recty.Left := muldiv(i - 1, w, fcolors);
  recty.Right := muldiv(i, w, fcolors);
  if fcolors1 then
  begin
  R := beginRGBvalue[0] + muldiv(j, RGBDifference[0], fcolors);
  G := beginRGBvalue[1] + muldiv(j, RGBDifference[1], fcolors);
  B := beginRGBvalue[2] + muldiv(j, RGBDifference[2], fcolors);
  end;
  Canvas.Brush.Color := RGB(R, G, B);
  patBlt(Canvas.Handle, recty.Left, recty.Top, Recty.Right - recty.Left, h, patcopy);
  Inc(j);
  end;
end;

// Case 1

procedure TForm1.FormPaint(Sender: TObject);
begin
  FillGradientRect(Form1.Canvas, rect(0, 0, Width, Height), $FF0000, $00000, $00FF);
end;


// Case 2
procedure TForm1.FormPaint(Sender: TObject);
var
  Row, Ht: Word;
  IX: Integer;
begin
  iX := 200;
  Ht := (ClientHeight + 512) div 256;
  for Row := 0 to 512 do
  begin
  with Canvas do
  begin
  Brush.Color := RGB(Ix, 0, row);
  FillRect(Rect(0, Row * Ht, ClientWidth, (Row + 1) * Ht));
  IX := (IX - 1);
  end;
  end;
end;


{
  Note, that the OnResize event should also call the FormPaint
  method if this form is allowed to be resizable.
  This is because if it is not called then when the
  window is resized the gradient will not match the rest of the form.
}

{***********************************************************}

{2. Another function}


procedure TForm1.Gradient(Col1, Col2: TColor; Bmp: TBitmap);
type
  PixArray = array [1..3] of Byte;
var
  i, big, rdiv, gdiv, bdiv, h, w: Integer;
  ts: TStringList;
  p: ^PixArray;
begin
  rdiv := GetRValue(Col1) - GetRValue(Col2);
  gdiv := GetgValue(Col1) - GetgValue(Col2);
  bdiv := GetbValue(Col1) - GetbValue(Col2);

  bmp.PixelFormat := pf24Bit;

  for h := 0 to bmp.Height - 1 do
  begin
  p := bmp.ScanLine[h];
  for w := 0 to bmp.Width - 1 do
  begin
  p^[1] := GetBvalue(Col1) - Round((w / bmp.Width) * bdiv);
  p^[2] := GetGvalue(Col1) - Round((w / bmp.Width) * gdiv);
  p^[3] := GetRvalue(Col1) - Round((w / bmp.Width) * rdiv);
  Inc(p);
  end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  BitMap1: TBitMap;
begin
  BitMap1 := TBitMap.Create;
  try
  Bitmap1.Width := 300;
  bitmap1.Height := 100;
  Gradient(clred, clBlack, bitmap1);
  // So könnte man das Bild dann zB in einem TImage anzeigen
  // To show the image in a TImage:
  Image1.Picture.Bitmap.Assign(bitmap1);
  finally
  Bitmap1.Free;
  end;
end;

لینک کوتاه پست
مطالب مرتبط با پست جاری
  • نکات مهم
    1- لطفا نظر خود را با زبان فارسی بیان کنید
    2- رایتم نظرات اسپم و تبلیغی شما را تایید نمی کند
    3- لطفا نظرات شما بدون ابهام و واضح باشد
  • نام
    ایمیل (منتشر نمی‌شود) (لازم)
    وبسایت
    :):(;):D;)):X:?:P:*=((:O@};-:B/:):S
    نظر خصوصی
    مشخصات شما ذخیره شود ؟[حذف مشخصات] [شکلک ها]
    کد امنیتی
به کانال تلگرام سایت ما بپیوندید