1. Accueil
  2. Tous les snippets
  3. Snippets Delphi / Pascal
  4. Transposition de point vers une image résultat

Transposition de point vers une image résultat

Soyez le premier à donner votre avis sur cette source.

Snippet vu 1 154 fois - Téléchargée 1 fois

Commenter

Contenu du snippet 

unit tabcolor;

//Si vous savez comprendre les équations vous pouvez aussi réaliser et assimiler 
//cette transposition de N points en couleurs vers cette image résultat :
//https://www.facebook.com/profile.php?id=100078461530518

interface

{copyright denis bertin 20.02.2008 version 1.3}
{Tableau des couleurs passagères}
{modification du dessin avec un bitmap en cache (c) denis bertin}

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, math, Clipbrd;

const k_max_counter = 10;

type
  TForme_tableau_des_couleurs = class(TForm)
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    ColorDialog1: TColorDialog;
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    procedure FormPaint(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure Draw_the_filling(where:tcanvas);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Button2Click(Sender: TObject);
  private
    { Déclarations privées }
    down:boolean;
    counter : integer;
    current_color:tcolorref;
    Tab_pt: array [0..k_max_counter] of tpoint;
    Tab_color: array[0..k_max_counter] of tcolorref;
    index_sur:integer;
  public
    { Déclarations publiques }
  end;

var Forme_tableau_des_couleurs: TForme_tableau_des_couleurs;

implementation

uses tabcolor_help,wformebm,col_plan,wmain,wmenuk,wutil,g_base,u_object,gdipobj,gdipapi;

{$R *.dfm}

procedure TForme_tableau_des_couleurs.FormCreate(Sender: TObject);
begin
counter:=0;
down:=false;
current_color:=0;
index_sur:=-1;
postmessage(self.Handle,wm_mousemove,0,0);
end;

procedure TForme_tableau_des_couleurs.FormPaint(Sender: TObject);
var i:integer;
   brush:TGPSolidBrush;
   un_graphics:gdipobj.TGPGraphics;
    une_couleur:tcolorRef;
begin
Canvas.Brush.Color:=rgb(255,255,255);
Canvas.rectangle(10,10,310,310);
un_graphics:=TGPGraphics.Create(Canvas.Handle);
un_graphics.SetSmoothingMode(SmoothingModeAntiAlias);
un_graphics.SetSmoothingMode(SmoothingModeHighQuality);
for i:=1 to counter do
  if true then
   begin
    une_couleur:=Tab_color[i];
   brush:=TGPSolidBrush.Create(MakeColor(255,GetRvalue(une_couleur),GetGvalue(une_couleur),GetBvalue(une_couleur)));
    with Tab_pt[i] do un_graphics.FillEllipse(brush,x-8,y-8,16,16);
    brush.Free;
    end
  else
   begin
   Canvas.Brush.Color:=Tab_color[i];
   with Tab_pt[i] do
     Canvas.ellipse(x-5,y-5,x+5,y+5);
   end;
un_graphics.Free;
end;

function distance(a,b,x,y:integer):real;
    var da,db,c:real;
    begin
    da:=abs(longint(a)-longint(x));
    db:=abs(longint(b)-longint(y));
    c:=da*da+db*db;
    if c=0 then
      distance:=0
    else
      distance:=sqrt(c);
  end;

procedure TForme_tableau_des_couleurs.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
down:=true;
index_sur:=-1;
end;

procedure TForme_tableau_des_couleurs.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var i:integer;
begin
if index_sur=-1 then
  begin
  for i:=1 to counter do
    begin
    if distance(x,y,Tab_pt[i].x,Tab_pt[i].y)<10 then
      index_sur:=i;
    end;
  end;
if index_sur<>-1 then
  begin
  setcursor(loadcursor(0,IDC_CROSS));
  end
else
  begin
  setcursor(loadcursor(0,IDC_ARROW));
  end;
BitBtn1.Enabled:=counter>=2;
end;

procedure TForme_tableau_des_couleurs.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if (x<20) or (x>290) or (y<20) or (y>290) then exit;
down:=false;
if index_sur<>-1 then
  begin
  Tab_pt[index_sur].x:=x;
  Tab_pt[index_sur].y:=y;
  index_sur:=-1;
  end
else
  begin
  if counter=k_max_counter then exit;
  inc(counter);
  Tab_pt[counter].x:=x;
  Tab_pt[counter].y:=y;
  Tab_color[counter]:=current_color;
  end;
invalidaterect(self.Handle,nil,false);
end;

procedure TForme_tableau_des_couleurs.Draw_the_filling(where:tcanvas);
var i,j,k:integer;
    dist,max_distance:real;
    cette_couleur:tcolorref;
begin
if counter=0 then exit;

for i:=0 to pred(300) do
  for j:=0 to pred(300) do
    begin
    max_distance:=0;
    for k:=1 to counter do
      begin
      with Tab_pt[k] do
        dist:=distance(i,j,x,y);
      if dist>max_distance then
        max_distance:=dist;
      end;
    cette_couleur:=0;
    for k:=1 to counter do
      begin
      with Tab_pt[k] do
        dist:=distance(i,j,x,y);

      cette_couleur:=rgb(
        math.min(255,getrvalue(cette_couleur)+
          round(getrvalue(Tab_color[k])*(max_distance-dist)/max_distance)),
        math.min(255,getgvalue(cette_couleur)+
          round(getgvalue(Tab_color[k])*(max_distance-dist)/max_distance)),
        math.min(255,getbvalue(cette_couleur)+
          round(getbvalue(Tab_color[k])*(max_distance-dist)/max_distance)));

      where.Pixels[i,j]:=cette_couleur;
      end;
    end;
end; {TForm1.Draw_the_filling}

procedure TForme_tableau_des_couleurs.BitBtn1Click(Sender: TObject);
var aBitmap:tbitmap;
begin
aBitmap:=tbitmap.Create;
aBitmap.width:=300;
aBitmap.height:=300;
Draw_the_filling(aBitmap.canvas);
Self.Canvas.Draw(10,10,aBitMap);
end;

procedure TForme_tableau_des_couleurs.BitBtn2Click(Sender: TObject);
begin
postmessage(self.Handle,wm_mousemove,0,0);
counter:=0;
invalidaterect(self.Handle,nil,false);
end;

procedure TForme_tableau_des_couleurs.BitBtn3Click(Sender: TObject);
begin
if ColorDialog1.Execute then
  current_color:=ColorDialog1.Color;
end;

procedure TForme_tableau_des_couleurs.Button1Click(Sender: TObject);
begin
invalidaterect(self.Handle,nil,false);
end;

procedure TForme_tableau_des_couleurs.BitBtn4Click(Sender: TObject);
var aBitmap:tbitmap;
begin
aBitmap:=tbitmap.Create;
aBitmap.width:=300;
aBitmap.height:=300;
Draw_the_filling(aBitmap.canvas);
Clipboard.Assign(aBitmap);
end;

procedure TForme_tableau_des_couleurs.Button5Click(Sender: TObject);
  var aBitmap:tbitmap;
  var une_forme_BitMap:wformebm.Tforme_TBitMap;
  var un_Calque_actif:col_plan.TCalque;
  var old:boolean;
  begin
  aBitmap:=tbitmap.Create;
  aBitmap.width:=300;
  aBitmap.height:=300;
  Draw_the_filling(aBitmap.canvas);
  un_Calque_actif:=col_plan.TCalque(wmain.MainWindow.wmsg.col_dessin.Get_calque_actif);
  if un_Calque_actif<>nil then
    begin
    old:=wmain.MainWindow.bool_show_cursor_when_redraw;
    wmain.MainWindow.bool_show_cursor_when_redraw:=false;
    une_forme_BitMap:=wformebm.Tforme_TBitMap.Create(0,0,10000,10000,
      aBitmap,0,'',12,wutil.kpc_font_arial,g_base.rgb_noir,'');
    un_Calque_actif.add(une_forme_BitMap); {écrit par denis bertin le 13.3.2015}
    un_Calque_actif.vide_selection;
    un_Calque_actif.select_dernier;
    wmain.MainWindow.redraw(wmenuk.ANUL_inserer_une_image);
    MainWindow_selection_changer;
    wmain.MainWindow.bool_show_cursor_when_redraw:=old;
    end;
  end; {TForme_tableau_des_couleurs.Button5Click}



procedure TForme_tableau_des_couleurs.Button2Click(Sender: TObject);
begin
Tableau_couleur_help.ShowModal;
end;

end.

Compatibilité : 1.0

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (denisbertin)