jvdrawimage.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvDrawImage.PAS, released on 2002-06-15.

The Initial Developer of the Original Code is Jan Verhoeven [jan1 dott verhoeven att wxs dott nl]
Portions created by Jan Verhoeven are Copyright (C) 2002 Jan Verhoeven.
All Rights Reserved.

Contributor(s): Robert Love [rlove att slcdug dott org].

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvDrawImage.pas,v 1.32 2005/02/17 10:20:26 marquardt Exp $

unit JvDrawImage;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows,
  {$IFDEF VCL}
  Messages,
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  QForms,
  {$ENDIF VisualCLX}
  Classes, Graphics, Controls, ExtCtrls,
  JvAirBrush, JvPaintFX;

type
  TSmartResizeMode = (rmWidth, rmHeight, rmSquare);
  TMorphBrush = (mbVerBox, mbHorBox, mbVerOval, mbHorOval);
  TDigitalFilter = array [0..4, 0..4] of Smallint;
  TColorPicked = procedure(Sender: TObject; AColor: TColor) of object;

  TJvDrawImage = class(TImage)
  private
    FGonio: array [0..180, 0..1] of Extended;
    FSinPixs: array [0..255] of Byte;
    FShape: string;
    FShapes: TStringList;
    FZoomClip: TBitmap;
    FAirBrush: TJvAirBrush;
    FPolygonChecked: Boolean;
    FOnColorPicked: TColorPicked;
    FBlocks: Integer;
    FStars: Integer;
    FStarPoints: Integer;
    FSpirals: Integer;
    function GetShapes: TStrings;
    procedure EscapePaint(X, Y: Integer; Shift: TShiftState);
    procedure CopyClip;
    procedure SetClip(AColor: TColor);
    procedure InitPlasma;
    function MixColors(Color1, Color2: TColor): TColor;
    function GetBlue(AColor: TColor): Byte;
    function GetGreen(AColor: TColor): Byte;
    function GetRed(AColor: TColor): Byte;
    procedure SetSyms(X, Y: Integer);
    function Rotate(Origin, Endpoint: TPoint; Angle: Real): TPoint;
    procedure DrawPlasma(X, Y: Integer; Amount: Extended);
    procedure DrawEffectBrush(X, Y, Radius: Integer; Amount: Extended;
      Style: TLightBrush);
    procedure Rimple(Src, Dst: TBitmap; Amount: Extended);
    procedure DrawStretchBrush(X, Y, Radius: Integer; Amount: Extended;
      Style: TMorphBrush);
    procedure SampleStretch(Src, Dst: TBitmap);
    procedure DrawLightBrush(X, Y, Radius, Amount: Integer;
      Style: TLightBrush);
    procedure DrawColorCircle(X, Y, Mode: Integer);
    procedure ColorCircle(var bm: TBitmap; center: TPoint; Radius,
      Mode: Integer);
    procedure DrawDarkerCircle(X, Y, Mode: Integer);
    procedure DrawLighterCircle(X, Y, Mode: Integer);
    procedure DrawGradientBrush(Color1, Color2: TColor; X1, X2,
      Y: Integer);
    procedure HorGradientLine(Bitmap: TBitmap; XOrigin, XFinal, Y: Integer;
      R1, G1, B1, R2, G2, B2: Byte; Smooth: Boolean);
    procedure SmoothPnt(Bitmap: TBitmap; xk, yk: Integer);
    procedure DrawVGradientBrush(Color1, Color2: TColor; Y1, Y2,
      X: Integer);
    procedure VerGradientLine(Bitmap: TBitmap; YOrigin, YFinal, X: Integer;
      R1, G1, B1, R2, G2, B2: Byte; Smooth: Boolean);
    procedure DrawCube;
    function PointToBlock(X, Y: Integer): TRect;
    procedure DrawSkew;
    procedure DrawTriangle;
    procedure PutClip(M: TRect);
    procedure DrawSyms(X, Y: Integer);
    procedure DrawTexLines(X0, Y0, X, Y: Integer);
    function BlendColors(const Color1, Color2: Integer;
      Opacity: Integer): Longint;
    function TexHighlight(Colr: Integer): Longint;
    function TexShadow(Colr: Integer): Longint;
    procedure DrawTexOvals(X0, Y0, X, Y: Integer);
    procedure DrawBlurOvals(X0, Y0, X, Y: Integer);
    procedure DrawTexCurves(X0, Y0, X, Y: Integer);
    procedure DrawBlurCurves(X0, Y0, X, Y: Integer);
    procedure DrawTexPoly(X0, Y0, X, Y: Integer);
    procedure DrawBlurPoly(X0, Y0, X, Y: Integer);
    procedure DrawTexRects(X0, Y0, X, Y: Integer);
    procedure DrawBlurRects(X0, Y0, X, Y: Integer);
    procedure DrawBlurLines(X0, Y0, X, Y: Integer);
    procedure InterpRect(X1, Y1, X2, Y2: Integer);
    procedure InterpolateRect(Bmp: TBitmap; X1, Y1, X2, Y2: Integer);
    procedure DrawColumn(X1, Y1, X2, Y2: Integer);
    procedure Column(Bitmap: TBitmap; XOrigin, XFinal, YOrigin,
      YFinal: Integer; R1, G1, B1, R2, G2, B2: Byte; Smooth: Boolean);
    procedure DrawSphere(Color1, Color2: TColor; X1, Y1, X2, Y2: Integer);
    procedure Sphere(Bitmap: TBitmap; xcenter, a, ycenter, b: Integer; R1,
      G1, B1, R2, G2, B2: Byte; Smooth: Boolean);
    procedure DrawMultiSphere(Color1, Color2: TColor; X1, Y1, X2,
      Y2: Integer);
    procedure DrawDropletSphere(Color1, Color2: TColor; X1, Y1, X2,
      Y2: Integer);
    procedure DrawWaveSphere(Color1, Color2: TColor; X1, Y1, X2,
      Y2: Integer);
    procedure DrawRisingWaveSphere(Color1, Color2: TColor; X1, Y1, X2,
      Y2: Integer);
//    function GetAngle(Origin, Endpoint: TPoint): Integer;
//    procedure TextRotate(X, Y, Angle: Integer; AText: string; AFont: TFont);
    function ReduceVector(Origin, Endpoint: TPoint; Factor: Real): TPoint;
    procedure Star(X, Y: Integer);
    procedure SetPolygonChecked(const Value: Boolean);
    procedure DrawSpiro(center, Radius: TPoint);
    procedure DrawBars(X1, Y1, X2, Y2: Integer);
    procedure Drawborders(X1, Y1, X2, Y2: Integer);
    procedure SetonColorPicked(const Value: TColorPicked);
    procedure SetShape(const Value: string);
    procedure SetAirBrush(const Value: TJvAirBrush);
    procedure SetTransformer(const Value: TJvPaintFX);
    procedure BuildShapeList;
    procedure SetBlocks(const Value: Integer);
    procedure SetSpirals(const Value: Integer);
    procedure SetStarPoints(const Value: Integer);
    procedure SetStars(const Value: Integer);
    procedure FillGonio;
    procedure FillSinPixs;
    procedure Shear(ABitmap: TBitmap; Amount: Integer);
    procedure XFormA(Amount: Integer);
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure ColorPicked(AColor: TColor);
    procedure Loaded; override;
  public
    Clip: TBitmap;
    TraceB: Byte;
    FX: TJvPaintFX;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ClipAll;
    procedure Effects;
    procedure Backgrounds;
    procedure Preview(ABitmap: TBitmap);
    procedure ApplyFilter(var Dst: TBitmap; DF: TDigitalFilter);
    procedure BlurBarChange(Sender: TObject);
    procedure ColorNoiseBarChange(Sender: TObject);
    procedure ContrastBarChange(Sender: TObject);
    procedure DrawBlend;
    procedure DrawMandelJulia(Mandel: Boolean);
    procedure DrawMap;
    procedure DrawSolarize;
    procedure DrawTriangles;
    procedure EmbossBarChange;
    procedure FilterBlueBarChange;
    procedure FilterGreenBarChange;
    procedure FilterRedBarChange;
    procedure FilterXBlueBarChange;
    procedure FilterXGreenBarChange;
    procedure FilterXRedBarChange;
    procedure FisheyeBarChange;
    procedure LightnessBarChange(Sender: TObject);
    procedure Marble2BarChange;
    procedure Marble3BarChange;
    procedure Marble4BarChange;
    procedure Marble5BarChange;
    procedure Marble6BarChange;
    procedure Marble7BarChange;
    procedure Marble8BarChange;
    procedure MarbleBarChange;
    procedure MonoNoiseBarChange(Sender: TObject);
    procedure MosaicBarChange;
    procedure PlasmaBarChange;
    procedure Posterize;
    procedure RippleRandom;
    procedure RippleTooth;
    procedure RippleTriangle;
    procedure RotateBar;
    procedure SaturationBarChange(Sender: TObject);
    procedure SeamBarChange;
    procedure ShearBarChange;
    procedure SmoothBarChange(Sender: TObject);
    procedure SplitBlurBarChange(Sender: TObject);
    procedure SplitRoundBarChange;
    procedure SplitWasteBarChange;
    procedure SqueezeBotBarChange;
    procedure SqueezeDiamondBarChange;
    procedure SqueezeHorBarChange;
    procedure SqueezeRound2BarChange;
    procedure SqueezeRoundBarChange;
    procedure SqueezeTopBarChange;
    procedure SqueezeWasteBarChange;
    procedure TexturizeOverlap;
    procedure TexturizeTile;
    procedure TwistBarChange;
    procedure WaveBarChange;
    procedure WaveExtraChange;
    procedure WaveInfChange;
    procedure XFormABarChange;
    procedure Trace;
    property AirBrush: TJvAirBrush read FAirBrush write SetAirBrush;
    property Transformer: TJvPaintFX read FX write SetTransformer;
    property Shapes: TStrings read GetShapes;
  published
    property Shape: string read FShape write SetShape;
    property PolygonChecked: Boolean read FPolygonChecked write SetPolygonChecked;
    property Stars: Integer read FStars write SetStars;
    property StarPoints: Integer read FStarPoints write SetStarPoints;
    property Blocks: Integer read FBlocks write SetBlocks;
    property Spirals: Integer read FSpirals write SetSpirals;
    property OnColorPicked: TColorPicked read FOnColorPicked write SetOnColorPicked;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvDrawImage.pas,v $';
    Revision: '$Revision: 1.32 $';
    Date: '$Date: 2005/02/17 10:20:26 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  SysUtils, Math, Dialogs, Clipbrd,
  JvResample, JvPainterEffectsForm, JvQuickPreviewForm, JvPainterQBForm,
  JvTypes, JvResources;

const
  // Texture constants
  DarkStrength = 0.82;
  StrongBlend = 52;
  WeakBlend = 36;

  BlurFilter: TDigitalFilter =
   ((1, 1, 1, 1, 1),
    (1, 0, 0, 0, 1),
    (1, 0, 0, 0, 1),
    (1, 0, 0, 0, 1),
    (1, 1, 1, 1, 1));

type
  TFColor = record
    B: Byte;
    G: Byte;
    R: Byte;
  end;

var
  PainterEffectsF: TPainterEffectsForm;
  QuickPreviewF: TQuickPreviewForm;
  PainterQBF: TPainterQBForm;

  mycliprect: TRect;
  UserFilter: TDigitalFilter;

  RangeTransColor: TColor;

  NSpiro: Integer;
  Wavepen, Wavebrush: TColor;
  decoX, decoY: Integer;

  mybezier: array [0..3] of TPoint;
  myskew: array [0..4] of TPoint;
  mychord: array [1..8] of Integer;
  myorigin, myprevpoint: TPoint;
  myslinedir: string;
  myslinetol: Integer;
  myDraw: Boolean;
  mypen: TPenMode;
  mypenstyle: TPenStyle;
  myoldbrushstyle: TBrushStyle;
  myoldpenwidth: Integer;
  myround: Integer;

  clipcm: TCopyMode;

  pointarray: array [0..12] of TPoint;
  spiralfactor: Real;
  spiraldir: Integer;
  TargetPoint: TPoint;
  zoomrect: TRect;
  freepoly: array [0..100] of TPoint;
  freepolycount: Integer;
  bezierfix1, bezierfix2: Boolean;

function TrimInt(N, Min, Max: Integer): Integer;
begin
  if N > Max then
    Result := Max
  else
  if N < Min then
    Result := Min
  else
    Result := N;
end;

function IntToByte(N: Integer): Byte;
begin
  if N > 255 then
    Result := 255
  else
  if N < 0 then
    Result := 0
  else
    Result := N;
end;

constructor TJvDrawImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 256;
  Height := 256;
  Clip := TBitmap.Create;
  FZoomClip := TBitmap.Create;
  FAirBrush := TJvAirBrush.Create(Self);
  FX := TJvPaintFX.Create(Self);
  TargetPoint := Point(0, 0);
  NSpiro := 40;
  RangeTransColor := clWhite;
  zoomrect := Rect(0, 0, 50, 50);
  mycliprect := Rect(0, 0, 256, 256);
  //spiral number, direction and Factor
  Spirals := 3;
  spiralfactor := 0.99;
  spiraldir := 1;
  // number of points for Star shape
  StarPoints := 5;
  Stars := 1;
  // tolerance for straight line Drawing
  myslinetol := 5;

  mypenstyle := psSolid;
  // number of Blocks wide and heigh
  Blocks := 32;
  // rounding of roundrect
  myround := 10;
  // default Drawing Mode
  Shape := 'line';
  FillSinPixs;
  FillGonio;
  TraceB := $00;
  FShapes := TStringList.Create;
  BuildShapeList;
  PainterEffectsF := TPainterEffectsForm.Create(Self);
  PainterEffectsF.setDrawImage(Self);
  QuickPreviewF := TQuickPreviewForm.Create(Self);
  QuickPreviewF.SetDrawImage(Self);
  PainterQBF := TPainterQBForm.Create(Self);
  PainterQBF.setDrawImage(Self);
end;

destructor TJvDrawImage.Destroy;
begin
  FShapes.Free;
  Clip.Free;
  FZoomClip.Free;
  FAirBrush.Free;
  FX.Free;
  PainterEffectsF.Free;
  QuickPreviewF.Free;
  PainterQBF.Free;
  inherited Destroy;
end;

function TJvDrawImage.GetShapes: TStrings;
begin
  Result := FShapes;
end;

// Start of filter procedures

procedure TJvDrawImage.FillGonio;
var
  A0: Extended;
  I: Integer;
begin
  A0 := Pi / 180;
  for I := 0 to 180 do
    SinCos(A0 * (I - 90), FGonio[I, 0], FGonio[I, 1]);
end;

procedure TJvDrawImage.FillSinPixs;
var
  I: Integer;
begin
  for I := 0 to 255 do
    FSinPixs[I] := Variant(Sin(I / 255 * Pi / 2) * 255);
end;

procedure TJvDrawImage.Shear(ABitmap: TBitmap; Amount: Integer);
var
  bm: TBitmap;
  p1, p2: PByteArray;
  X, dx, Y, h, w, c1, c2: Integer;
  f: Extended;
begin
  bm := TBitmap.Create;
  h := ABitmap.Height;
  w := ABitmap.Width;
  bm.Width := w;
  bm.Height := h;
  f := w / (w + (Amount / 100) * h);
  bm.PixelFormat := pf24bit;
  ABitmap.PixelFormat := pf24bit;
  for Y := 0 to h - 1 do
  begin
    p1 := ABitmap.ScanLine[Y];
    p2 := bm.ScanLine[Y];
    dx := Round(Amount / 100 * Y);
    for X := 0 to w - 1 do
    begin
      c1 := X * 3;
      c2 := Round(f * (X + dx)) * 3;
      p2[c2] := p1[c1];
      p2[c2 + 1] := p1[c1 + 1];
      p2[c2 + 2] := p1[c1 + 2];
    end;
  end;
  ABitmap.Assign(bm);
  bm.Free;
end;

procedure TJvDrawImage.XFormA(Amount: Integer);
var
  X, Y, i: Integer;
  p1: pbytearray;
begin
  for i := 1 to Amount do
    for Y := 0 to Clip.Height - 1 do
    begin
      p1 := Clip.ScanLine[Y];
      for X := 0 to Clip.Width - 1 do
      begin
        p1[X * 3] := FSinPixs[p1[X * 3]];
        p1[X * 3 + 1] := FSinPixs[p1[X * 3 + 1]];
        p1[X * 3 + 2] := FSinPixs[p1[X * 3 + 2]];
      end;
    end;
end;

procedure TJvDrawImage.Drawborders(X1, Y1, X2, Y2: Integer);
var
  h, w: Integer;
begin
  h := clientheight;
  w := clientwidth;