AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Projekte Farbmixer in Lazarus

Farbmixer in Lazarus

Ein Thema von DeepValues · begonnen am 8. Feb 2021
Antwort Antwort
DeepValues
Registriert seit: 8. Feb 2021
Hier der Basis Code für einen Farbmixer ihr müsst natürlich Dinge anpassen bei Problemen aber sollte vielen helfen.

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls;

type

{ TForm1 }

TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
PaintBox1: TPaintBox;
Panel1: TPanel;
sbRed: TScrollBar;
sbGreen: TScrollBar;
sbBlue: TScrollBar;
procedure FormCreate(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure sbColorChange(Sender: TObject);
private

public

end;

var
Form1: TForm1;

implementation

{$R *.lfm}

uses
FPImage, IntfGraphics, LCLType;

{ TForm1 }

function Distance2(i, j: Integer; P: TPoint): Integer;
begin
Result := sqr(i-P.X) + sqr(j-P.Y);
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
var
P1, P2, P3: TPoint;
R, Rsq: Integer;
bmp: TBitmap;
img: TLazIntfImage;
HBmp, HMask: HBitmap;
clr: TFPColor;
i, j: Integer;
begin
R := Paintbox1.Width div 3;
Rsq := R*R;
P1 := Point(R, R);
P2 := Point(Paintbox1.Width - R, R);
P3 := Point(Paintbox1.Width div 2, PaintBox1.Height - R);

bmp := TBitmap.Create;
try
bmp.SetSize(Paintbox1.Width, Paintbox1.Height);
bmp.PixelFormat := pf24bit;
bmp.Canvas.Brush.Color := clBlack;
bmp.Canvas.FillRect(0, 0, bmp.Width, bmp.Height);

img := bmp.CreateIntfImage;
try
for j := 0 to img.Height-1 do
for i := 0 to img.Width - 1 do
begin
clr := img.Colors[i, j];
if Distance2(i, j, P1) <= Rsq then
clr.Red := sbRed.Position shl 8;
if Distance2(i, j, P2) <= Rsq then
clr.Green := sbGreen.Position shl 8;
if Distance2(i, j, P3) <= Rsq then
clr.Blue := sbBlue.Position shl 8;
img.Colors[i, j] := clr;
end;
img.CreateBitmaps(HBmp, HMask);
bmp.BitmapHandle := HBmp;
bmp.MaskHandle := HMask;
finally
img.Free;
end;
Paintbox1.Canvas.Draw(0, 0, bmp);
finally
bmp.Free;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
sbColorChange(nil);
end;

procedure TForm1.sbColorChange(Sender: TObject);
begin
Paintbox1.Invalidate;
Panel1.Color := RGBToColor(sbRed.Position, sbGreen.Position, sbBlue.Position);
Panel1.Caption := Format('#%.2x%.2x%.2x', [sbRed.Position, sbGreen.Position, sbBlue.Position]);
if sbRed.Position + sbGreen.Position + sbBlue.Position > 3*128 then
Panel1.Font.Color := clBlack
else
Panel1.Font.Color := clWhite;
end;

end.


gebt gerne Feedback und Hilfe wenn ihr wollt

Geändert von DeepValues ( 9. Mär 2021 um 18:10 Uhr)
 
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +2. Es ist jetzt 18:32 Uhr.
Powered by vBulletin® Copyright ©2000 - 2021, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2021 by Daniel R. Wolf