Einzelnen Beitrag anzeigen

Satty67

Registriert seit: 24. Feb 2007
Ort: Baden
1.566 Beiträge
 
Delphi 2007 Professional
 
#7

Re: Verlauf mit "gewichteter" Farbe mittels Log?

  Alt 4. Apr 2009, 14:23
Ok, dann hatte ich das falsch verstanden. (aber macht nicht, das experimentieren mit Farben macht mit am meisten Spass)

Hier dann mal ein anderer Ansatz (im Anhang das Projekt zum Testen)
Delphi-Quellcode:
function GetColorBetween(FromColor, ToColor: TColor; Distributor : Byte;
                         LoRange, HiRange, Position : Integer): TColor;
type
  TRGB = packed record
    R,G,B,P : Byte;
  end;
var
  FromClr, ToClr, ResultClr : TRGB;
  i,j, FirstPart, SecondPart, FullRange : Integer;
begin
  i := ColorToRGB(FromColor);
  FromClr := TRGB(i);
  i := ColorToRGB(ToColor);
  ToClr := TRGB(i);

  // Verlauf berechnen
  FullRange := (HiRange - LoRange);
  FirstPart := (Distributor * FullRange) div 100;
  SecondPart := FullRange - FirstPart;

  if Position < FirstPart then begin
    j := (Position * 50) div FirstPart;
  end else begin
    j := ((Position- FirstPart) * 50) div SecondPart;
    j := j + 50;
  end;

  i := (j * 255) div 100;

  ResultClr.R := ( (ToClr.R * i) + (FromClr.R * (255 - i)) ) div 255;
  ResultClr.G := ( (ToClr.G * i) + (FromClr.G * (255 - i)) ) div 255;
  ResultClr.B := ( (ToClr.B * i) + (FromClr.B * (255 - i)) ) div 255;
  ResultClr.P := 0;

  Result := TColor(ResultClr);
end;

procedure FillGradient(Canvas: TCanvas; FromClr, ToClr: TColor;
                       Distributor: Byte; aRect: TRect; Vertical : Boolean);
var
  i : Integer;
begin
  if Vertical then begin
    for i := aRect.Top to aRect.Bottom do begin
      Canvas.Pen.Color := GetColorBetween(FromClr, ToClr, Distributor, aRect.Top, aRect.Bottom, i);
      Canvas.MoveTo(aRect.Left, i);
      Canvas.LineTo(aRect.Right, i);
    end;
  end else begin
    for i := aRect.Left to aRect.Right do begin
      Canvas.Pen.Color := GetColorBetween(FromClr, ToClr, Distributor, aRect.Left, aRect.Right, i);
      Canvas.MoveTo(i, aRect.Top);
      Canvas.LineTo(i, aRect.Bottom);
    end;
  end;
end;

procedure TFormFarbverlauf.Button2Click(Sender: TObject);
begin
  If ColorDialog1.Execute then PanelFrom.Color := ColorDialog1.Color;
end;

procedure TFormFarbverlauf.Button3Click(Sender: TObject);
begin
  If ColorDialog1.Execute then PanelTo.Color := ColorDialog1.Color;
end;

procedure TFormFarbverlauf.TrackBar1Change(Sender: TObject);
begin
  LabelTrackbar.Caption := IntToStr(TrackBar1.Position)+' %';
  FillGradient(PaintBox1.Canvas, PanelFrom.Color, PanelTo.Color, TrackBar1.Position, PaintBox1.ClientRect,False);
end;
Angehängte Dateien
Dateityp: 7z farbverlauf2_143.7z (911,8 KB, 7x aufgerufen)
  Mit Zitat antworten Zitat