was ist neu ¦  programmier tips ¦  indy artikel ¦  intraweb artikel ¦  informationen ¦  links ¦  interviews
 sonstiges ¦  tutorials ¦  Add&Win Gewinnspiel

Tips (1541)

Dateien (137)
Datenbanken (90)
Drucken (35)
Grafik (114)
IDE (21)
Indy (5)
Internet / LAN (130)
IntraWeb (0)
Mathematik (76)
Multimedia (45)
Oberfläche (107)
Objekte/
ActiveX (51)

OpenTools API (3)
Sonstiges (126)
Strings (83)
System (266)
VCL (242)

Tips sortiert nach
Komponente


Tip suchen

Tip hinzufügen

Add&Win Gewinnspiel

Werbung

41 Visitors Online


 
...einen Farbverlauf auf eine Form zeichnen?
Autor: Doctor Nam
[ Tip ausdrucken ]  

Tip Bewertung (20):  
     




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 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;


 

Bewerten Sie diesen Tipp:

dürftig
ausgezeichnet


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners