[delphi] plug-ins(filtre) pour adobe photoshop

0/5 (1 avis)

Vue 10 489 fois - Téléchargée 2 548 fois

Télécharger le projet
Commenter

Description

Un exemple de code qui montre comment créer un Plug-ins(Filtre) pour Adobe Photoshop avec Delphi en utilisant le composant(Photoshop SDK for Delphi)

Source / Exemple : 


unit couchecouleur;

{

PfA       A0E  ùùùfùNNNN.,M,  0¨¨oMPDMMM   M£,M+yooo¨   ¨AA     o*A   f01HH2M,0   ¨oMM,0oEEMM
ED¨       MM?  I+o       MD,  0oM     M,P  f0o     MM£  MZP     Zll  AND   SC,0o  MMPMMM?ùSùI
¨oM       ùùù  EMM       MCM  £Mf     ?¨£  ùAA     ùoo  o+:     IYd  Ddd  ddEAoE  Eoo
MfM       NN.  A£o       oo+  DP:    ds£   C o    dDd   dYI     ddd  EIZ fEùSùNN  NN.
TISM,0o£MMMM,  odDddIdddEIdd  A£A,,,AP     oddddd;nn      Yn::Y:!*   0¨¨ MPD MMM  £?ù CùZMCM£
PfA       A0E  A£A       ,,,  AP,          ZZY               EE,     ,*,Z,My ,NM          ooo
ED¨       MM?  ooo       +:d  s o          dAA               d¨¨     dd?ùCù  ZEf          ,,,
¨oM       ùùù  SZE       fEù  SùN          .NN              N.,      NM*nY   ddd  dddMM,M+ooo
MfM       NN.  I+o       MD,  0oM          M,P             fY0        f?¨£¨ùAAù   M*M£MZPZ+:d

Plug-ins(Filtre) pour Adobe Photoshop
Titre: Couche de couleur
Auteur: H@PPyZERØ5
E-mail: happy05@programmer.net

---------------------------
Installer les composants suivant:
www.g32.org pour Graphics32
www.centaurix.com pour Photoshop SDK for Delphi 
---------------------------

}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, GR32, GR32_LowLevel, Spin, Menus, ComCtrls,
  PIFilter, jpeg, PS_GR32_Image;

type
  TFormCouchecl = class(TForm)
    Panel1: TPanel;
    PSImgView: TPSImgView32;
    Panel2: TPanel;
    Label7: TLabel;
    Panel3: TPanel;
    cmbColor: TComboBox;
    Panel6: TPanel;
    BtnOk: TButton;
    BtnAnnuler: TButton;
    BtnDoAbout: TButton;
    procedure ScaleModeChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BtnOkClick(Sender: TObject);
    procedure BtnAnnulerClick(Sender: TObject);
    procedure PSImgViewPaintStage(Sender: TObject; Buffer: TBitmap32;
      StageNum: Cardinal);
    procedure BtnDoAboutClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    
    procedure ChangedHandler(Sender: TObject);
  end;

type
  TAboutBox = class(TForm)
  public
    procedure Display(const Text: string);
    procedure ExecMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  end;

  PGlobals = ^TGlobals;
  TGlobals = packed record
	  Result: PSmallInt;                // Must always be first in Globals.
  	FilterParamBlock: PFilterRecord;  // Must always be second in Globals.
    Color: TColor;
  end;

const
  PI_WWW     = 'www.centaurix.com';
  AboutText =
    'Plug-ins(Filtre) pour Adobe Photoshop' + #13#10 + #13#10 +
    'Titre: Couche de couleur' + #13#10 + 'Auteur: H@PPyZERØ5' + #13#10 +
    'E-mail: happy05@programmer.net' + #13#10 + '-------------------------------' +
     #13#10+'Developed with Borland Delphi' + #13#10 +
     'www.borland.com' + #13#10 +
    'API Conversion by Centaurix Interactive Designs' + #13#10 +'%s';

var
  Globals: PGlobals;

//
procedure InitGlobals(GlobalPtr: Pointer);

implementation

{$R *.dfm}

uses
  FilterCore, PIGeneral, PSGlobalProcs;

{******************************************************************************
Initialize globals with defaults


                                                                                                                                                              • }

procedure InitGlobals(GlobalPtr: Pointer);
begin
  with PGlobals(GlobalPtr)^ do
  begin
  Color := $000080;//clMaroon
  end;
end;

{******************************************************************************
procedure couchecouleur


                                                                                                                                                              • }

procedure couchecl(Bitmap: TBitmap32;XColor:TColor);
Var
  X, Y: Integer;
  CL: TColor;
begin
  For X := 0 to Bitmap.Width do
  begin
    For Y := 0 to Bitmap.Height do
    begin
       CL := Bitmap.Canvas.Pixels[X, Y];
       CL := (CL and XColor);
       Bitmap.Canvas.Pixels[X, Y] := CL;
    end;
  end;
end;

{******************************************************************************
AssignFromInData


                                                                                                                                                              • }

procedure AssignFromInData(Dst: TBitmap32);
var
  W, H: Integer;
  PDst: PColor32;
begin
  with FilterRecord^, FilterRecord^.InRect do
  begin
    W := Right - Left;
    H := Bottom - Top;
    Dst.SetSize(W, H);
    PDst := Dst.PixelPtr[0, 0];
    MoveLongWord(InData^, PDst^, W * H);
  end;
end;

{******************************************************************************
FormCreate


                                                                                                                                                              • }

procedure TFormCouchecl.FormCreate(Sender: TObject);
begin
  Globals := GlobalPtr;
  PSImgView.DoubleBuffered := True;

  // by default, PST_CLEAR_BACKGND is executed at this stage,
  // which, in turn, calls ExecClearBackgnd method of ImgView.
  // Here I substitute PST_CLEAR_BACKGND with PST_CUSTOM, so force ImgView
  // to call the OnPaintStage event instead of performing default action.
  with PSImgView.PaintStages[0]^ do
    if Stage = PST_CLEAR_BACKGND then Stage := PST_CUSTOM;

  AssignFromInData(PSImgView.Bitmap);//

  with Globals^ do
  couchecl(PSImgView.Bitmap,color);//procedure couchecl
  PSImgView.Bitmap.OnChange := ChangedHandler;//PSImgView.Invalidate;
end;

{******************************************************************************
ScaleModeChange


                                                                                                                                                              • }

procedure TFormCouchecl.ScaleModeChange(Sender: TObject);
begin
  with cmbColor do
  begin

  //---------------------------------
  //Standard Colors
   if Text = 'clMaroon' then begin
   Globals.Color:=$000080;
   end;

   if Text = 'clGreen' then begin
   Globals.Color:=$008000;
   end;

   if Text = 'clOlive' then begin
   Globals.Color:=$008080;
   end;

   if Text = 'clNavy' then begin
   Globals.Color:=$800000;
   end;

   if Text = 'clPurple' then begin
   Globals.Color:=$800080;
   end;

   if Text = 'clTeal' then begin
   Globals.Color:=$808000;
   end;

   if Text = 'clGray' then begin
   Globals.Color:=$808080;
   end;

   if Text = 'clSilver' then begin
   Globals.Color:=$C0C0C0;
   end;

   if Text = 'clRed' then begin
   Globals.Color:=$0000FF;
   end;

   if Text = 'clLime' then begin
   Globals.Color:=$00FF00;
   end;

   if Text = 'clYellow' then begin
   Globals.Color:=$00FFFF;
   end;

   if Text = 'clBlue' then begin
   Globals.Color:=$FF0000;
   end;

   if Text = 'clFuchsia' then begin
   Globals.Color:=$FF00FF;
   end;

   if Text = 'clAqua' then begin
   Globals.Color:=$FFFF00;
   end;

   if Text = 'clLtGray' then begin
   Globals.Color:=$C0C0C0;
   end;

   if Text = 'clDkGray' then begin
   Globals.Color:=$808080;
   end;

   if Text = 'clWhite' then begin
   Globals.Color:=$FFFFFF;
   end;

 //---------------------------------
 //Extended Colors

   if Text = 'clMoneyGreen' then begin
   Globals.Color:=$C0DCC0;
   end;

   if Text = 'clSkyBlue' then begin
   Globals.Color:=$F0CAA6;
   end;

   if Text = 'clCream' then begin
   Globals.Color:=$F0FBFF;
   end;

   if Text = 'clMedGray' then begin
   Globals.Color:=$A4A0A0;
   end;

  PSImgView.Bitmap.Clear;
  AssignFromInData(PSImgView.Bitmap);
  couchecl(PSImgView.Bitmap,Globals.Color);

  end;

 end;

{******************************************************************************
BtnOkClick


                                                                                                                                                              • }

procedure TFormCouchecl.BtnOkClick(Sender: TObject);
begin
  with FilterRecord^ do
  begin
    OutRect := FilterRect;
    OutLoPlane := 0;
    OutHiPlane := Planes - 1;
    OutPostDummyPlanes := 1;
    AdvanceState;
    
    with Globals^ do
    couchecl(PSImgView.Bitmap,color);

    MoveLongWord(PSImgView.Bitmap.Bits[0], OutData^, PSImgView.Bitmap.Width *
    PSImgView.Bitmap.Height);
  end;

  ModalResult := mrOK;
end;

{******************************************************************************
BtnAnnulerClick


                                                                                                                                                              • }

procedure TFormCouchecl.BtnAnnulerClick(Sender: TObject);
begin
  ModalResult := mrCancel;
end;

{******************************************************************************
PSImgViewPaintStage


                                                                                                                                                              • }

procedure TFormCouchecl.PSImgViewPaintStage(Sender: TObject; Buffer: TBitmap32;
  StageNum: Cardinal);
const
  Colors: array [0..1] of TColor32 = ($FFFFFFFF, $FFB0B0B0);
var
  W, I, J, Parity: Integer;
  Line1, Line2: TArrayOfColor32; // a buffer for a couple of scanlines
begin
  with PSImgView.Buffer do
  begin
    W := Width;
    SetLength(Line1, W);
    SetLength(Line2, W);
    for I := 0 to W - 1 do
    begin
      Parity := I shr 3 and $1;
      Line1[I] := Colors[Parity];
      Line2[I] := Colors[1 - Parity];
    end;
    for J := 0 to Height - 1 do
    begin
      Parity := J shr 3 and $1;
      if Boolean(Parity) then MoveLongword(Line1[0], ScanLine[J]^, W)
      else MoveLongword(Line2[0], ScanLine[J]^, W);
    end;
  end;
end;

{******************************************************************************
ChangedHandler


                                                                                                                                                              • }

procedure TFormCouchecl.ChangedHandler(Sender: TObject);
begin
  PSImgView.Invalidate;
end;

{******************************************************************************
TAboutBox.Display


                                                                                                                                                              • }

procedure TAboutBox.Display(const Text: string);
var
  L: TLabel;
begin
  Position := poScreenCenter;
  Font.Name := 'Myriad Pro';
  Font.Size := 12;
  BorderWidth := 12;
  BorderStyle := bsDialog;
  SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) and not WS_CAPTION);
  L := TLabel.Create(Self);
  L.Parent := Self;
  L.Caption := Text;
  L.Alignment := taCenter;
  L.OnMouseDown := ExecMouseDown;
  AutoSize := True;
  ShowModal;
end;

{******************************************************************************
TAboutBox.ExecMouseDown


                                                                                                                                                              • }

procedure TAboutBox.ExecMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  ModalResult := mrOK;
end;

{******************************************************************************
ShowPSAboutBox


                                                                                                                                                              • }

procedure ShowPSAboutBox(Text: string);
var
  Dlg: TAboutBox;
begin
  Dlg := TAboutBox.CreateNew(nil);
  Dlg.Display(Text);
  Dlg.Free;
end;

{******************************************************************************
DoAbout


                                                                                                                                                              • }

procedure DoAbout;
begin
  ShowPSAboutBox(Format(AboutText, [PI_WWW]));
end;

{******************************************************************************
BtnDoAboutClick


                                                                                                                                                              • }

procedure TFormCouchecl.BtnDoAboutClick(Sender: TObject);
begin
DoAbout;
end;

end.

//to be continued...
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire Commentaire
hocioran Messages postés 11 Date d'inscription lundi 4 décembre 2006 Statut Membre Dernière intervention 7 juillet 2017
7 juil. 2017 à 12:06
Bonjour,
on esssayant d'executer le projet une erreur sur pifilter.
j'ai téléchargé photoshop sdk cs4.
je travail avec delphi7 pour controler photoshop seulement je ne parvient pas à l'installer puisque l'extension des composant est .h au lieu de .pas ou .dcu
je souhaitte votre aide .
Merci.
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 (happy05)