Nouvelle DLL pour faire une copie d'écran

library PrintScreen;

{
i% = dll_call1("ScreenCopy",x%) : ' x%=0--> tout l'écran  x%=1--> la fenêtre active
i% = dll_call0("Rotate90") : ' rotation de l'image interne de 90 degrés
i% = dll_call0("RotateM90") : ' rotation de l'image interne de -90 degrés
i% = dll_call0("Rotate180") : ' rotation de l'image interne de 180 degrés
i% = dll_call0("LoadPicture") : ' charger l'image du presse-papier dans l'image interne
i% = dll_call0("SavePicture") : recopier l'image interne dans le presse-papier
i% = dll_call6("ModifyPicture,x%,y%,T%,R%,G%,B%) : incruster l'image du presse-papier dans l'image interne
                                '  à partir de (x%,y%) avec la couleur de transparence R%,G%,B%
                                '  T% est le taux de transparence de l'image dans le presse-papier (0-100)
i% = dll_call2("ResizePicture,h%,w%) : redimensionner l'image du presse-papier à largeur w%, hauteur h%
                                '  comme s'il y avait un STRETCH_ON sur le presse-papier
i% = dll_call0("GetPictureHeight") : ' retourner la hauteur de l'image interne
i% = dll_call0("GetPictureWidth") : ' retourner la largeur de l'image interne
i% = dll_call0("GetClipboardPictureWidth") : ' retourner la largeureur de l'image dans le presse-papier
i% = dll_call0("GetClipboardPictureHeight") : ' retourner la hauteur de l'image dans le presse-papier
i% = dll_call3("SetPictureFilter",R%,G%,W%) : ' appliquer des filtres couleur sur l'image interne
                                ' une valeur de -1 signifie "inchangé"
i% = dll_call0("SetPictureGrayScale") : ' transformer une image en niveaux de gris
i% = dll_call1("SetPictureBrightness",d%) : ' ajuster la brillancede +/- d% (-255...+255)
i% = dll_call1("SetPictureGamma",g%) : ' ajuster le Gamma 0:plus foncé  <>0:plus clair
i% = dll_call4("CreatePictureGradientColor",adr(start$,adr(adresse$),adr(couleur_debut$),adr(couleur_fin$))
            ' remplir l'image interne par un dégradé entre les couleurs début et fin
            ' start$ donne le type de dégradé:
            '    L[ine] = dégradé par lignes  C[olonne] = dégradé en colonnes
            '    P[oint] = dégradé à partir d'un point  R[onds] = dégradé en ronds (cercle) autour d'un point
            '    B[ulles] = bulles dégradées autour d'un point
            '    adresse$ = numéro de départ (ligne, colonne ou coordonnées x,y d'un point)
            '    couleur_debut$, couleur_fin$ = valeurs R,G,B de la couleur
i% = dll_call1("SetImmediateMode",m%) : ' si m%>0: mettre systématiquement le presse-papier à jour
}

uses
  Windows,
  SysUtils,
  ClipBrd,
  Graphics,
  Math,
  StrUtils,
  Dialogs,
  Classes;
// Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
//  StdCtrls, ExtCtrls;

{$R *.res}

TYPE
  TRGBArray = ARRAY[0..32768-1]  of TRGBTriple;
  pRGBArray = ^TRGBArray;
var
  BInterne, B1: TBitmap;
  update_clipboard, BInterne_loaded: boolean;

function Rotate90:integer; stdcall; export;
type
  TRGBArray = ARRAY[0..65535] of TRGBTriple;
  pTRGBArray = ^TRGBArray;
  TArrayLigneCible = Array[0..65535] of pTRGBArray;

var
  BitmapSource, BitmapCible : TBitmap;
  x,y : integer;
  LigneSource, LigneCible : pTRGBArray;

begin
  result := 1;
  if not BInterne_loaded then exit;
  BitmapSource := TBitmap.Create;
  BitmapCible := TBitmap.Create;

  try
    BitmapSource.assign (Binterne);
    BitmapSource.pixelformat := pf24bit;
    BitmapCible.pixelformat := pf24bit;

    BitmapCible.Height := BitmapSource.Width;
    BitmapCible.Width := BitmapSource.Height;

    for y:=0 to BitmapSource.Height - 1 do
    begin
      LigneSource := BitmapSource.ScanLine[y];
      for x:=0 to BitmapSource.Width - 1 do
      begin
          LigneCible := BitmapCible.ScanLine[x];
          LigneCible[BitmapSource.Height - 1 - y] := LigneSource[x];
      end;
    end;
    BInterne.assign(BitmapCible);
    if update_clipboard then clipboard.Assign(BInterne);
  finally
    BitmapSource.free;
    BitmapCible.free;
  end;
  result := 0;
end;

function RotateM90:integer; stdcall; export;
type
  TRGBArray = ARRAY[0..65535] of TRGBTriple;
  pTRGBArray = ^TRGBArray;
  TArrayLigneCible = Array[0..65535] of pTRGBArray;

var
  BitmapSource, BitmapCible : TBitmap;
  x,y : integer;
  LigneSource, LigneCible : pTRGBArray;

begin
  result := 1;
  if not BInterne_loaded then exit;
  BitmapSource := TBitmap.Create;
  BitmapCible := TBitmap.Create;

  try
    BitmapSource.assign (Binterne);
    BitmapSource.pixelformat := pf24bit;
    BitmapCible.pixelformat := pf24bit;

    BitmapCible.Height := BitmapSource.Width;
    BitmapCible.Width := BitmapSource.Height;

    for y:=0 to BitmapSource.Height - 1 do
    begin
      LigneSource := BitmapSource.ScanLine[y];
      for x:=0 to BitmapSource.Width - 1 do
      begin
          LigneCible := BitmapCible.ScanLine[BitmapSource.Width - x - 1];
          LigneCible[y] := LigneSource[x];
      end;
    end;
    BInterne.assign(BitmapCible);
    if update_clipboard then clipboard.Assign(BInterne);
  finally
    BitmapSource.free;
    BitmapCible.free;
  end;
  result := 0;
end;

function Rotate180:integer; stdcall; export;
begin
  Rotate90;
  Rotate90;
  result := 0;
end;

function ScreenCopy(x:integer):integer; stdcall; export;
var
  m: integer;
begin
  m := x;
  if m<>0 then m := 1;
  keybd_event(VK_SNAPSHOT, m, 0, 0);
  keybd_event(VK_SNAPSHOT, m, KEYEVENTF_KEYUP, 0);
  result := 0;
end;

function LoadPicture:integer; stdcall; export;
begin
  if Clipboard.HasFormat(CF_PICTURE) then begin
    if not BInterne_loaded then BInterne := TBitmap.Create;
    BInterne.Assign(Clipboard);
    BInterne.PixelFormat := pf24bit;
    BInterne_loaded := true;
    result := 0;
  end else begin
    result := 1;
  end;
end;

function SavePicture:integer; stdcall; export;
begin
  result := 1;
  if not BInterne_loaded then exit;
  clipboard.Assign(BInterne);
  BInterne.Free;
  result := 1;
  BInterne_loaded := false;
  result := 0;
end;

function GetPictureHeight:integer; stdcall; export;
begin
  result := 1;
  if not BInterne_loaded then exit;
  result := BInterne.Height;
end;

function GetPictureWidth:integer; stdcall; export;
begin
  result := 1;
  if not BInterne_loaded then exit;
  result := BInterne.Width;
end;

function GetClipboardPictureWidth:integer; stdcall; export;
begin
  B1 := TBitmap.Create;
  B1.PixelFormat := pf24bit;
  B1.Assign(clipboard);
  result := B1.Width;
  B1.Free;
end;

function GetClipboardPictureHeight:integer; stdcall; export;
begin
  B1 := TBitmap.Create;
  B1.PixelFormat := pf24bit;
  B1.Assign(clipboard);
  result := B1.Height;
  B1.Free;
end;

function ResizePicture(h,w:integer):integer; stdcall; export;
var
  R: TRect;
begin
  B1:= TBitmap.Create;
  B1.PixelFormat := pf24bit;
  B1.Assign(clipboard);

  R.Left := 0;
  R.Top := 0;
  R.Right := w;
  R.Bottom := h;

  B1.Canvas.StretchDraw(R,B1);
  B1.Width := R.Right;
  B1.Height := R.Bottom;

  clipboard.Assign(B1);
  B1.Free;
  result := 0;
end;

function GetMergedBitmap(BackImage, TopImage: TBitmap; x,y,T,R,G,B: integer): TBitmap;
var
i, j, tw, th, TBack, TTop: Integer;
ft, fb: real;
BackRow, TopRow, ResultRow: pByteArray;
br, bg, bb, tr, tg, tb: integer;
begin
  tw := TopImage.Width;
  th := TopImage.Height;
  if x+tw>BackImage.Width-1 then tw := BackImage.Width - x - 1;
  if y+th>BackImage.Height-1 then th := BackImage.Height - y - 1;
  if BackImage.PixelFormat <>pf24bit then BackImage.PixelFormat := pf24bit;
  if TopImage.PixelFormat <>pf24bit then TopImage.PixelFormat := pf24bit;
  Result := TBitmap.Create;
  Result.Width := BackImage.Width;
  Result.Height := BackImage.Height;
  Result.PixelFormat := pf24bit;
  TTop := T;
  if TTop<0 then TTop := 0;
  if TTop>100 then TTop := 100;
  TBack := 100 - TTop;
  ft := TTop/100;
  fb := TBack/100;
  try
    for j := 0 to BackImage.Height - 1 do begin
      BackRow := BackImage.ScanLine[j];
      ResultRow := Result.ScanLine[j];
      if (j>=y) and (j<y+th) then begin
        TopRow := TopImage.ScanLine[j-y];
      end; // end if (j>=y) and (j<y+th)
      for i := 0 to BackImage.Width - 1 do begin
        br := BackRow[i * 3 + 2];
        bg := BackRow[i * 3 + 1];
        bb := BackRow[i * 3 + 0];
        ResultRow[i * 3 + 2] := br;
        ResultRow[i * 3 + 1] := bg;
        ResultRow[i * 3 + 0] := bb;
        if (i>=x) and (i<x+tw) then begin
          if (j>=y) and (j<y+th) then begin
            tr := TopRow[(i-x) * 3 + 2];
            tg := TopRow[(i-x) * 3 + 1];
            tb := TopRow[(i-x) * 3 + 0];
            if (tr <> R) or (tg <> G) or (tb <> B) then begin
              ResultRow[i * 3 + 2] := round(tr*ft + br*fb);
              ResultRow[i * 3 + 1] := round(tg*ft + bg*fb);
              ResultRow[i * 3 + 0] := round(tb*ft + bb*fb);
            end; // end if (tr <> R) or (tg <> G) or (tb <> B)
          end; // end if (j>=y) and (j<y+th)
        end; // end if (i>=x) and (i<x+tw)
      end; // end for i := 0 to BackImage.Width - 1
    end; // end for j := 0 to BackImage.Height - 1
  except
    on E : Exception do begin
      showmessage('Erreur:  j='+inttostr(j)+'  i='+inttostr(i)+'  y='+inttostr(y)+'  x='+inttostr(x));
      ShowMessage('Exception message = '+E.Message);
    end;
  end;  // end try
end;  // end function GetMergedBitmap

function ModifyPicture(x,y,T,R,G,B:integer):integer; stdcall; export;
{ CONST
  Yellow:  TRGBTriple =
          (rgbtBlue: 0; rgbtGreen: 255; rgbtRed: 255);    }
begin
  result := 1;
  if not BInterne_loaded then exit;
  B1:= TBitmap.Create;
  B1.PixelFormat := pf24bit;
  B1.Assign(clipboard);
  BInterne.Assign(GetMergedBitmap(BInterne,B1,x,y,T,R,G,B));
  if update_clipboard then clipboard.Assign(BInterne);
  B1.Free;
  result := 0;
end;

function SPF(R,G,B: integer):TBitmap; stdcall; export;
var
  h,w,i,j: integer;
  Row, InRow: pByteArray;
begin
  h := BInterne.Height - 1;
  w := BInterne.Width - 1;
  result := TBitmap.Create;
  result.Height := BInterne.Height;
  result.Width := BInterne.Width;
  result.PixelFormat := pf24bit;
  try
    for j:=0 to h do begin
      Row := result.ScanLine[j];
      InRow := BInterne.ScanLine[j];
      for i:=0 to w do begin
        if R>-1 then Row[i * 3 + 2] := R
          else Row[i * 3 + 2] := InRow[i * 3 + 2];
        if G>-1 then Row[i * 3 + 1] := G
          else Row[i * 3 + 1] := InRow[i * 3 + 1];
        if B>-1 then Row[i * 3 + 0] := B
          else Row[i * 3 + 0] := InRow[i * 3 + 0];
      end;
    end;
  except
    on E : Exception do begin
      showmessage('Erreur:  j='+inttostr(j)+'  i='+inttostr(i));
      ShowMessage('Exception message = '+E.Message);
    end;
  end;
end;

function SetPictureFilter(R,G,B: integer):integer; stdcall; export;
begin
  result := 1;
  if not BInterne_loaded then exit;
  BInterne.Assign(SPF(R,G,B));
  if update_clipboard then clipboard.Assign(BInterne);
  result := 0;
end;

procedure ConvertBitmapToGrayscale(const Bmp: TBitmap);
type
  TRGBArray = array[0..32767] of TRGBTriple;
  PRGBArray = ^TRGBArray;
var
  x, y, Gray: Integer;
  Row: PRGBArray;
begin
  for y := 0 to Bmp.Height - 1 do
  begin
    Row := Bmp.ScanLine[y];
    for x := 0 to Bmp.Width - 1 do
    begin
      Gray := (Row[x].rgbtRed + Row[x].rgbtGreen + Row[x].rgbtBlue) div 3;
      Row[x].rgbtRed := Gray;
      Row[x].rgbtGreen := Gray;
      Row[x].rgbtBlue := Gray;
    end;
  end;
end;

function SetPictureGrayScale:integer; stdcall; export;
begin
  result := 1;
  if not BInterne_loaded then exit;
  ConvertBitmapToGrayscale(BInterne);
  result := 0;
end;

function SetPictureBrightness(d:integer):integer; stdcall; export;
var
  delta, j, i, n: integer;
  RowIn, RowOut: PByteArray;
begin
  result := 1;
  if not BInterne_loaded then exit;
  if d>255 then delta := 255
    else if d<-255 then delta := -255
      else delta := d;
  B1 := TBitmap.Create;
  B1.Width := BInterne.Width;
  B1.Height := BInterne.Height;
  B1.PixelFormat := pf24bit;
  try
  for j:=0 to BInterne.Height-1 do begin
    RowIn  := BInterne.Scanline[j];
    RowOut := B1.Scanline[j];
    for i := 0 to 3 * BInterne.Width-1 do begin
        n := RowIn[i] + delta;
        if n>255 then n := 255
          else if n<0 then n := 0;
        RowOut[i] := Byte(n);
    end;
  end;
  except
    on E : Exception do begin
      showmessage('Erreur:  j='+inttostr(j)+'  i='+inttostr(i));
      ShowMessage('Exception message = '+E.Message);
    end;
  end;
  BInterne.Assign(B1);
  if update_clipboard then clipboard.Assign(BInterne);
  B1.Free;
  result := 0;
end;

function SetPictureGamma(d:integer):integer; stdcall; export;
var
  gamma, c: real;
  j, i, n: integer;
  RowIn, RowOut: PByteArray;
begin
  result := 1;
  if not BInterne_loaded then exit;
  if d=0 then gamma := 1.1
    else gamma := 1/1.1;
  B1 := TBitmap.Create;
  B1.Width := BInterne.Width;
  B1.Height := BInterne.Height;
  B1.PixelFormat := pf24bit;
  try
  for j:=0 to BInterne.Height-1 do begin
    RowIn  := BInterne.Scanline[j];
    RowOut := B1.Scanline[j];
    for i := 0 to 3 * BInterne.Width-1 do begin
        c := RowIn[i]/255;
        c := power(c,gamma);
        n := round(c*255);
        if n>255 then n:=255
          else if n<0 then n:=0;
        RowOut[i] := Byte(n);
    end;
  end;
  except
    on E : Exception do begin
      showmessage('Erreur:  j='+inttostr(j)+'  i='+inttostr(i));
      ShowMessage('Exception message = '+E.Message);
    end;
  end;
  BInterne.Assign(B1);
  if update_clipboard then clipboard.Assign(BInterne);
  B1.Free;
  result := 0;
end;

{
CreatePictureGradientColor(vertical/horizontal,aller simple/aller-retour,couleur1,couleur2)
start:
L=line  C=Colonne  P=Point
couleur:
D=couleur Début  F=couleur Fin

start:
  l[igne]
  c[olonne]
  p[point]

result:
  0=ok
  1=erreur "start"
  2=erreur "couleur début"
  3=erreur "couleur fin"
  4=erreur "adresse de début"
}

function isNumber(s:string):boolean;
var i:integer;
begin
  i:=1;
  while (i<=length(s)) and (s[i] in ['0'..'9','.','A'..'F','a'..'f']) do inc(i);
  result:=i>length(s);
end;

function decoder_color(couleur:string; var err:boolean):TRGBTriple;
var
  s1, s2: string;
  i,j, c: integer;
begin
  err := true;
  result.rgbtBlue := 0;
  result.rgbtGreen := 0;
  result.rgbtRed := 0;
  s1 := couleur;

  i := pos(',',s1);
  if i=0 then exit;
  s2 := leftstr(s1,i-1);
  if not isNumber(s2) then exit;
  val(s2,c,j);
  if (c<0) or (c>255) then exit;
  result.rgbtRed := c;
  s1 := midstr(s1,i+1,length(s1));

  i := pos(',',s1);
  if i=0 then exit;
  s2 := leftstr(s1,i-1);
  if not isNumber(s2) then exit;
  val(s2,c,j);
  if (c<0) or (c>255) then exit;
  result.rgbtGreen := c;
  s1 := midstr(s1,i+1,length(s1));

  s2 := s1;
  if not isNumber(s2) then exit;
  val(s2,c,j);
  if (c<0) or (c>255) then exit;
  result.rgbtBlue := c;
  err := false;
end;

function CreatePictureGradientColor(start,adresse,couleur_debut,couleur_fin:pchar):integer; stdcall; export;
var
  cd_r, cd_g, cd_b, cf_r, cf_g, cf_b: integer;
  sta, adr, adr_x, adr_y, cd, cf: string;
  int_sta, j, i, x0, y0, h, w, nr, ng, nb, x1, y1: integer;
  color_0, color_i, color_1: TRGBTriple;
  err: boolean;
  jmy02: real;
  d,r: integer;
  Row: PRGBArray;
begin
  result := 1;
  if not BInterne_loaded then exit;
  // analyser le type de départ
  sta := lowercase(pchar(pstring(start)^));
  sta := LeftStr(sta,1);
  result := 0;
  int_sta := pos(sta,'lcprb');
  if int_sta=0 then exit;

  // analyser l'adresse de départ
  result := 4;
  adr := pchar(pstring(adresse)^);
  case int_sta of
    1: begin; // ligne
        if not isnumber(adr) then exit;
        val(adr,y0,i);
        if (y0<0) or (y0>=BInterne.Height) then exit;
      end;
    2: begin ; // colonne
        if not isnumber(adr) then exit;
        val(adr,x0,i);
        if (x0<0) or (x0>=BInterne.Width) then exit;
      end;
    3,4,5: begin ; // point, ronds, bulles
        i := pos(',',adr);
        if i=0 then exit;
        adr_x := leftstr(adr,i-1);
        adr_y := midstr(adr,i+1,length(adr));
        if not isnumber(adr_x) then exit;
        if not isnumber(adr_y) then exit;
        val(adr_x,x0,i);
        val(adr_y,y0,i);
        if (x0<0) or (x0>=BInterne.Width) then exit;
        if (y0<0) or (y0>=BInterne.Height) then exit;
      end;
  end;

  // analyser la couleur de départ
  cd  := pchar(pstring(couleur_debut)^);
  result := 2;
  color_0 := decoder_color(cd,err);
  if err then exit;

  // analyser la couleur de fin
  cf  := pchar(pstring(couleur_fin)^);
  result := 3;
  color_1 := decoder_color(cf,err);
  if err then exit;

  // créer l'image temporaire
  B1 := TBitmap.Create;
  B1.Width := BInterne.Width;
  B1.Height := BInterne.Height;
  B1.PixelFormat := pf24bit;

  // traiter les différents cas
  case int_sta of
    1: begin ; // ligne
        h := B1.Height;
        w := B1.Width;
        for j:=0 to h-1 do begin
          Row := B1.ScanLine[j];
          if j>=y0 then begin
            nr := color_0.rgbtRed  + round((color_1.rgbtRed-color_0.rgbtRed)*abs(j-y0)/(h-y0));
            ng := color_0.rgbtGreen + round((color_1.rgbtGreen-color_0.rgbtGreen)*abs(j-y0)/(h-y0));
            nb := color_0.rgbtBlue  + round((color_1.rgbtBlue-color_0.rgbtBlue)*abs(j-y0)/(h-y0));
          end else begin
            nr := color_0.rgbtRed  + round((color_1.rgbtRed-color_0.rgbtRed)*abs(j-y0)/(y0));
            ng := color_0.rgbtGreen + round((color_1.rgbtGreen-color_0.rgbtGreen)*abs(j-y0)/(y0));
            nb := color_0.rgbtBlue  + round((color_1.rgbtBlue-color_0.rgbtBlue)*abs(j-y0)/(y0));
          end;
{          nr := color_0.rgbtRed  + round((color_1.rgbtRed-color_0.rgbtRed)*abs(j-y0)/h);
          ng := color_0.rgbtGreen + round((color_1.rgbtGreen-color_0.rgbtGreen)*abs(j-y0)/h);
          nb := color_0.rgbtBlue  + round((color_1.rgbtBlue-color_0.rgbtBlue)*abs(j-y0)/h);      }
          for i := 0 to w-1 do begin
            Row[i].rgbtRed := nr;
            Row[i].rgbtGreen := ng;
            Row[i].rgbtBlue := nb;
          end;
        end;
      end;
    2: begin ; // colonne
        h := B1.Height;
        w := B1.Width;
        for j:=0 to h-1 do begin
          Row := B1.ScanLine[j];
          for i := 0 to w-1 do begin
            if i>= x0 then begin
              nr := color_0.rgbtRed  + round((color_1.rgbtRed-color_0.rgbtRed)*abs(i-x0)/(w-x0));
              ng := color_0.rgbtGreen + round((color_1.rgbtGreen-color_0.rgbtGreen)*abs(i-x0)/(w-x0));
              nb := color_0.rgbtBlue  + round((color_1.rgbtBlue-color_0.rgbtBlue)*abs(i-x0)/(w-x0));
            end else begin
              nr := color_0.rgbtRed  + round((color_1.rgbtRed-color_0.rgbtRed)*abs(i-x0)/(x0));
              ng := color_0.rgbtGreen + round((color_1.rgbtGreen-color_0.rgbtGreen)*abs(i-x0)/(x0));
              nb := color_0.rgbtBlue  + round((color_1.rgbtBlue-color_0.rgbtBlue)*abs(i-x0)/(x0));
            end;
            Row[i].rgbtRed := nr;
            Row[i].rgbtGreen := ng;
            Row[i].rgbtBlue := nb;
          end;
        end;
      end;
    3: begin ; // point
        h := B1.Height;
        w := B1.Width;
        for j:=0 to h-1 do begin
          Row := B1.ScanLine[j];
          for i:=0 to w-1 do begin
            if j>=y0 then begin
              if i>=x0 then begin // quart en bas à droite
                if i>=x0+(j-y0)*(w-x0)/(h-y0) then begin // partie droite de la ligne
                  nr := color_0.rgbtRed  + round((color_1.rgbtRed-color_0.rgbtRed)*abs(i-x0)/(w-x0));
                  ng := color_0.rgbtGreen + round((color_1.rgbtGreen-color_0.rgbtGreen)*abs(i-x0)/(w-x0));
                  nb := color_0.rgbtBlue  + round((color_1.rgbtBlue-color_0.rgbtBlue)*abs(i-x0)/(w-x0));
                end else begin    // partie gauche de la ligne
                  nr := color_0.rgbtRed  + round((color_1.rgbtRed-color_0.rgbtRed)*abs(j-y0)/(h-y0));
                  ng := color_0.rgbtGreen + round((color_1.rgbtGreen-color_0.rgbtGreen)*abs(j-y0)/(h-y0));
                  nb := color_0.rgbtBlue  + round((color_1.rgbtBlue-color_0.rgbtBlue)*abs(j-y0)/(h-y0));
                end;
              end else begin      // quart en bas à gauche
                if i>=x0-(j-y0)*(x0)/(h-y0) then begin // partie droite de la ligne
                  nr := color_0.rgbtRed  + round((color_1.rgbtRed-color_0.rgbtRed)*abs(j-y0)/(h-y0));
                  ng := color_0.rgbtGreen + round((color_1.rgbtGreen-color_0.rgbtGreen)*abs(j-y0)/(h-y0));
                  nb := color_0.rgbtBlue  + round((color_1.rgbtBlue-color_0.rgbtBlue)*abs(j-y0)/(h-y0));
                end else begin // partie gauche de la ligne
                  nr := color_0.rgbtRed  + round((color_1.rgbtRed-color_0.rgbtRed)*abs(i-x0)/(x0));
                  ng := color_0.rgbtGreen + round((color_1.rgbtGreen-color_0.rgbtGreen)*abs(i-x0)/(x0));
                  nb := color_0.rgbtBlue  + round((color_1.rgbtBlue-color_0.rgbtBlue)*abs(i-x0)/(x0));
                end;
              end;
            end else begin
              if i>=x0 then begin  // quart en haut à droite
                if i>=x0+(w-x0)*(y0-j)/y0 then begin // partie droite de la ligne
                  nr := color_0.rgbtRed  + round((color_1.rgbtRed-color_0.rgbtRed)*abs(i-x0)/(w-x0));
                  ng := color_0.rgbtGreen + round((color_1.rgbtGreen-color_0.rgbtGreen)*abs(i-x0)/(w-x0));
                  nb := color_0.rgbtBlue  + round((color_1.rgbtBlue-color_0.rgbtBlue)*abs(i-x0)/(w-x0));
                end else begin  // partie gauche de la ligne
                  nr := color_0.rgbtRed  + round((color_1.rgbtRed-color_0.rgbtRed)*abs(y0-j)/(y0));
                  ng := color_0.rgbtGreen + round((color_1.rgbtGreen-color_0.rgbtGreen)*abs(y0-j)/(y0));
                  nb := color_0.rgbtBlue  + round((color_1.rgbtBlue-color_0.rgbtBlue)*abs(y0-j)/(y0));
                end;
              end else begin      // quart en haut à gauche
                if i>=x0-(y0-j)*x0/y0 then begin // partie droite de la ligne
                  nr := color_0.rgbtRed  + round((color_1.rgbtRed-color_0.rgbtRed)*abs(y0-j)/(y0));
                  ng := color_0.rgbtGreen + round((color_1.rgbtGreen-color_0.rgbtGreen)*abs(y0-j)/(y0));
                  nb := color_0.rgbtBlue  + round((color_1.rgbtBlue-color_0.rgbtBlue)*abs(y0-j)/(y0));
                end else begin // partie gauche de la ligne
                  nr := color_0.rgbtRed  + round((color_1.rgbtRed-color_0.rgbtRed)*abs(i-x0)/(x0));
                  ng := color_0.rgbtGreen + round((color_1.rgbtGreen-color_0.rgbtGreen)*abs(i-x0)/(x0));
                  nb := color_0.rgbtBlue  + round((color_1.rgbtBlue-color_0.rgbtBlue)*abs(i-x0)/(x0));
                end;
              end;
            end;
            Row[i].rgbtRed := nr;
            Row[i].rgbtGreen := ng;
            Row[i].rgbtBlue := nb;
          end;
        end;
      end;
    4: begin ; // ronds
        h := B1.Height;
        w := B1.Width;
        x1 := (w-x0) * (w-x0);
        y1 := (h-y0) * (h-y0);
        r := round(max( sqrt(x0*x0+y0*y0) ,
                max( sqrt(x1+y0*y0) ,
                  max( sqrt(x0*x0+y1) ,
                    sqrt(x1+y1) ))));
        for j:=0 to h-1 do begin
          Row := B1.ScanLine[j];
          jmy02 := (j-y0)*(j-y0);
          for i:=0 to w-1 do begin
            d := round(sqrt(jmy02+(i-x0)*(i-x0)));
            Row[i].rgbtRed := round(Row[i].rgbtRed + (color_1.rgbtRed-color_0.rgbtRed)*d/r);
            Row[i].rgbtGreen := round(Row[i].rgbtGreen + (color_1.rgbtGreen-color_0.rgbtGreen)*d/r);
            Row[i].rgbtBlue := round(Row[i].rgbtBlue + (color_1.rgbtBlue-color_0.rgbtBlue)*d/r);
          end;
        end;
      end;
    5: begin ; // bulles
        h := B1.Height;
        w := B1.Width;
        x1 := (w-x0) * (w-x0);
        y1 := (h-y0) * (h-y0);
        r := max( sqr(x0*x0+y0*y0) ,
                max( sqr((w-x0)*(w-x0)+y0*y0) ,
                  max( sqr(x0*x0+(h-y0)*(h-y0)) ,
                    sqr((w-x0)*(w-x0)+(h-y0)*(h-y0)) )));
        for j:=0 to h-1 do begin
          Row := B1.ScanLine[j];
          jmy02 := (j-y0)*(j-y0);
          for i:=0 to w-1 do begin
            d := round(sqr(jmy02+(i-x0)*(i-x0)));
            Row[i].rgbtRed := round(Row[i].rgbtRed + (color_1.rgbtRed-color_0.rgbtRed)*d/r);
            Row[i].rgbtGreen := round(Row[i].rgbtGreen + (color_1.rgbtGreen-color_0.rgbtGreen)*d/r);
            Row[i].rgbtBlue := round(Row[i].rgbtBlue + (color_1.rgbtBlue-color_0.rgbtBlue)*d/r);
          end;
        end;
      end;
  end;
  // retourner le résultat
  BInterne.Assign(B1);
  if update_clipboard then clipboard.Assign(BInterne);
  B1.Free;
end;

function SetImmediateMode(m:integer):integer; stdcall; export;
begin
  update_clipboard := m<>0;
  result := 0;
end;

exports
  ScreenCopy,
  Rotate90,
  RotateM90,
  Rotate180,
  LoadPicture,
  SavePicture,
  ModifyPicture,
  ResizePicture,
  GetPictureHeight,
  GetPictureWidth,
  GetClipboardPictureWidth,
  GetClipboardPictureHeight,
  SetPictureFilter,
  SetPictureGrayScale,
  SetPictureBrightness,
  SetPictureGamma,
  CreatePictureGradientColor,
  SetImmediateMode;

begin
end.

i% = dll_call4("CreatePictureGradientColor",adr(start$,adr(adresse$),adr(couleur_debut$),adr(couleur_fin$))
            ' remplir l'image interne par un dégradé entre les couleurs début et fin
            ' start$ donne le type de dégradé:
            '    L[ine] = dégradé par lignes  C[olonne] = dégradé en colonnes
            '    P[oint] = dégradé à partir d'un point  R[onds] = dégradé en ronds (cercle) autour d'un point
            '    B[ulles] = bulles dégradées autour d'un point
            '    adresse$ = numéro de départ (ligne, colonne ou coordonnées x,y d'un point)
            '    couleur_debut$, couleur_fin$ = valeurs R,G,B de la couleur

i% = dll_call1("SetImmediateMode",m%) : ' si m%>0: mettre systématiquement le presse-papier à jour

i% = dll_call1("ScreenCopy",x%) : ' x%=0--> tout l'écran x%=1--> la fenêtre active
i% = dll_call0("Rotate90") : ' rotation de l'image interne de 90 degrés
i% = dll_call0("RotateM90") : ' rotation de l'image interne de -90 degrés
i% = dll_call0("Rotate180") : ' rotation de l'image interne de 180 degrés
i% = dll_call0("LoadPicture") : ' charger l'image du presse-papier dans l'image interne
i% = dll_call0("SavePicture") : recopier l'image interne dans le presse-papier
i% = dll_call6("ModifyPicture,x%,y%,T%,R%,G%,B%) : incruster l'image du presse-papier dans l'image interne
 ' à partir de (x%,y%) avec la couleur de transparence R%,G%,B%
 ' T% est le taux de transparence de l'image dans le presse-papier (0-100)
i% = dll_call2("ResizePicture,h%,w%) : redimensionner l'image du presse-papier à largeur w%, hauteur h%
 ' comme s'il y avait un STRETCH_ON sur le presse-papier
i% = dll_call0("GetPictureHeight") : ' retourner la hauteur de l'image interne
i% = dll_call0("GetPictureWidth") : ' retourner la largeur de l'image interne
i% = dll_call0("GetClipboardPictureWidth") : ' retourner la largeureur de l'image dans le presse-papier
i% = dll_call0("GetClipboardPictureHeight") : ' retourner la hauteur de l'image dans le presse-papier
i% = dll_call3("SetPictureFilter",R%,G%,W%) : ' appliquer des filtres couleur sur l'image interne
 ' une valeur de -1 signifie "inchangé"
i% = dll_call0("SetPictureGrayScale") : ' transformer une image en niveaux de gris
i% = dll_call1("SetPictureBrightness",d%) : ' ajuster la brillance de + ou - d% (-255...+255)
i% = dll_call1("SetPictureGamma",g%) : ' ajuster le Gamma 0:plus foncé <>0:plus clair
i% = dll_call4("CreatePictureGradientColor",adr(start$,adr(adresse$),adr(couleur_debut$),adr(couleur_fin$))
 ' remplir l'image interne par un dégradé entre les couleurs début et fin
 ' start$ donne le type de dégradé:
 ' L[ine] = dégradé par lignes C[olonne] = dégradé en colonnes
 ' P[oint] = dégradé à partir d'un point R[onds] = dégradé en ronds (cercle) autour d'un point
 ' B[ulles] = bulles dégradées autour d'un point
 ' adresse$ = numéro de départ (ligne, colonne ou coordonnées x,y d'un point)
 ' couleur_debut$, couleur_fin$ = valeurs R,G,B de la couleur
i% = dll_call1("SetImmediateMode",m%) : ' si m%>0: mettre systématiquement le presse-papier à jour