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...
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.