admin/expertcad
1
0
Fork 0
mirror of http://gitlab.expertsoft.com.ua/git/expertcad synced 2026-01-11 22:45:39 +02:00
Code Issues Packages Projects Releases Wiki Activity
expertcad/POWERCAD30/Plugin Source/Power Paint/PaintForm.pas
ShevaIV 00e2ad8635 initial commit
2025-05-12 10:07:51 +03:00

3174 lines
88 KiB
ObjectPascal
Raw Permalink Blame History

unit PaintForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, ComCtrls, ToolWin, Menus, Grids, StdCtrls, ImgList, jpeg,
ExtDlgs,Math, Spin,imgfx, Buttons,ClipBrd;
type
pRGBArray = ^TRGBArray; // Use SysUtils.pByteArray for 8-bit color
TRGBArray = ARRAY[0..32767] OF TRGBTriple;
TDoublePoint = record
x: Double;
y: Double;
end;
TBmpLayer = class(TObject)
Name: String;
Source: TBitmap;
Bitmap: TBitmap;
p1,p2,p3,p4: TPoint;
Opaq: Integer;
Transparent: Boolean;
Visible: Boolean;
SelMode: Integer;
Skewed: Boolean;
Rotated: Boolean;
Scaled: Boolean;
Procedure Move(dx,dy:Integer);
Procedure Modify(mIndex: Integer);
Procedure Scale(mIndex:Integer; perx,pery: Double);
Function Duplicate: TBmpLayer;
Destructor Destroy;
end;
TSelObject = class(TMyObject)
xType: Integer; //1:rect 2:ellipse 3:polygon
CMode: Integer;
pCount: Integer;
points: array of TPoint;
Constructor Create(aType,aMode:Integer);
Procedure AddPoint(pt:TPoint);
Destructor destroy;
end;
TfrmPaint = class(TForm)
scmain: TScrollBox;
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
ScrollBox2: TScrollBox;
Panel6: TPanel;
scH: TScrollBar;
scV: TScrollBar;
pc: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
lGrid: TStringGrid;
Panel5: TPanel;
pBox: TPaintBox;
Panel4: TPanel;
Panel7: TPanel;
Label1: TLabel;
Label2: TLabel;
ImageList1: TImageList;
ImageList2: TImageList;
TabSheet3: TTabSheet;
ToolBar2: TToolBar;
ToolButton8: TToolButton;
ToolButton7: TToolButton;
ToolButton9: TToolButton;
ToolButton10: TToolButton;
ToolButton13: TToolButton;
ToolButton16: TToolButton;
ToolButton14: TToolButton;
ToolButton15: TToolButton;
Panel8: TPanel;
ScrollBox3: TScrollBox;
Panel9: TPanel;
Shape1: TShape;
ColorDialog1: TColorDialog;
Button1: TButton;
chRatio: TCheckBox;
opd: TOpenPictureDialog;
Image1: TImage;
TabSheet4: TTabSheet;
chLayer: TCheckBox;
Label3: TLabel;
Bevel1: TBevel;
tblayer: TTrackBar;
Label4: TLabel;
Edit1: TEdit;
Label5: TLabel;
ToolBar3: TToolBar;
lb1: TToolButton;
lb2: TToolButton;
lb3: TToolButton;
lb4: TToolButton;
ToolButton20: TToolButton;
ToolButton21: TToolButton;
ToolBar5: TToolBar;
ToolButton24: TToolButton;
lb5: TToolButton;
lb6: TToolButton;
lb7: TToolButton;
ToolButton30: TToolButton;
lb8: TToolButton;
lb9: TToolButton;
pnOptions: TPanel;
PageControl2: TPageControl;
TabSheet5: TTabSheet;
TabSheet6: TTabSheet;
pnPen: TPanel;
pnBrush: TPanel;
cbFHand: TCheckBox;
spPen: TSpinEdit;
Label6: TLabel;
bGrid: TStringGrid;
ToolButton25: TToolButton;
mEdit1: TEdit;
mEdit2: TEdit;
cmbFilter: TComboBox;
tbEffect: TTrackBar;
Label7: TLabel;
Button2: TButton;
Shape2: TShape;
pbFilter: TPaintBox;
lb10: TToolButton;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
ToolBar1: TToolBar;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
procedure Shape1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure pBoxPaint(Sender: TObject);
procedure ToolButton8Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure medit1Change(Sender: TObject);
procedure medit2Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure lGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure lGridClick(Sender: TObject);
procedure chLayerClick(Sender: TObject);
procedure tblayerChange(Sender: TObject);
procedure Edit1Change(Sender: TObject);
procedure pBoxMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure pBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure pBoxMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure lGridMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure lb4Click(Sender: TObject);
procedure lb1Click(Sender: TObject);
procedure lb2Click(Sender: TObject);
procedure lb3Click(Sender: TObject);
procedure lGridMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure lGridMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure lGridDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure lGridDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure scmainResize(Sender: TObject);
procedure FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure scVChange(Sender: TObject);
procedure scHChange(Sender: TObject);
procedure lb6Click(Sender: TObject);
procedure lb7Click(Sender: TObject);
procedure lb5Click(Sender: TObject);
procedure lb8Click(Sender: TObject);
procedure lb9Click(Sender: TObject);
procedure bGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure mEdit1KeyPress(Sender: TObject; var Key: Char);
procedure pcChange(Sender: TObject);
procedure pbFilterPaint(Sender: TObject);
procedure cmbFilterChange(Sender: TObject);
procedure tbEffectChange(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure lb10Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure ToolButton5Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
Procedure DrawSel;
Procedure DrawTempSel;
Procedure DrawTempPolygon;
Function CreatePolyRegion(pList:array of TPoint;scaled: Boolean):HRGN;
Procedure PolyPointsToSelObj(sObj:TSelObject);
Procedure ClearPointLists;
Procedure AddSelPoint(pt:TPoint);
Procedure SelectLayerBounds;
Function CheckModPoint(x,y:Integer):Integer;
Procedure HandleMod(x,y:Integer);
Procedure ModifyPoints(x,y:Integer);
Procedure BlankLayer;
Procedure FlattenImage;
Procedure MergeVisible;
Procedure Clearlayers;
Procedure LayerFix;
public
{ Public declarations }
mp: Integer;
rpx,rpy: Integer;
rotPoint: TPoint;
LockScroll: Boolean;
SelVisible:Boolean;
MGridDown : Boolean;
isMod: Boolean;
mgx,mgy: Integer;
ClickIndex: Integer;
SelRgn: HRGN;
mvx,mvy: Integer;
isMoving: Boolean;
Layers: TList;
CommandId: Integer;
SelMode: Integer;
Ratio: Double;
lock1,lock2: Boolean;
cLayer: TBmpLayer;
rp1,trp1: Tpoint;
rp2,trp2,trp3,trp4: Tpoint;
dw,dh: Integer;
PointList: Array of TPoint;
tPointList: Array of TPoint;
SelLayer: Integer;
SelObjects: TList;
SelModified : Boolean;
locx : Integer;
locy : Integer;
Procedure DrawBuffer(hasback:Boolean=True);
Function EditBitmap(var xBmp:Tbitmap;mStream:TStream):Boolean;
Function NewLayer(bmp: TBitmap;lName:String;x:Integer = 0;y:Integer=0):TBmpLayer;
Procedure InsertBitmap;
Procedure ShowLayerOptions;
Procedure HandleCommand(x,y:Integer;up:Boolean; shift: TShiftState);
Procedure KillSelections;
Function CreateSelRegion(Scaled: Boolean = True):HRGN;
Procedure MoveSelObjects(dx,dy:Integer);
Procedure ClearSelObjects;
Procedure DrawlayerSel;
Procedure DrawLine(x1,y1,x2,y2: Integer);
Procedure DrawFreeHand;
Procedure DrawFreeBrush;
Function GetBSize: Integer;
Function bCircle:Boolean;
Function GetBmpColor(x,y:Integer; var cl: TColor):Boolean;
Procedure BucketFill(x,y:Integer);
Function GetFilterBitmap: TBitmap;
Function GetSelBitmap: TBitmap;
Procedure RedrawFilter;
Procedure ApplyFilter;
Procedure SaveToStream(mStream:Tstream);
Procedure LoadFromStream(mStream:TStream);
Procedure CopySelection;
Procedure PasteFromCBoard;
Procedure CutSelection;
Procedure ClearSelection;
end;
function BitmapToRegion(Bitmap: TBitmap; TransColor: TColor;dx,dy:Integer;selList:TList): HRGN;
Procedure DrawGlassBitmap(BCanvas: TBitmap; FBitmap:TBitmap; sx,sy,Transity: Integer;
FTransColor: TColor;isTrans: Boolean);
Procedure ConvertPoint(var x,y: Integer);
Procedure DeConvertPoint(var x,y: Integer);
Procedure RotateBitmap(var BitmapOriginal,BitmapRotated: TBitmap; Teta: Double; isTrans: Boolean);
Function SkewBitmap(p1,p2,p3,p4: TPoint; pic: TBitmap; var ResultBmp: TBitmap;isTrans:Boolean): Boolean;
Function RotatePoint(cpoint, opoint: Tpoint; ang: real):TPoint;
Function ScalePoint(cpoint, opoint: Tpoint; px,py: real):TPoint;
Function MPoint(p1,p2:TPoint):TPoint;
Function MVPoint(p:TPoint;dy:Integer):TPoint;
Function MHPoint(p:TPoint;dx:Integer):TPoint;
Function MXPoint(p:TPoint;dx,dy:Integer):TPoint;
Function GetRadOfLine(cp,p: TPoint):Real;
Function GetLineSegmentPoint(p1,p2:TDoublePoint; ratio: double):TDoublePoint;overload;
Function GetLineSegmentPoint(p1,p2:TPoint; ratio: double):TDoublePoint;overload;
Function DP2P(pt:TDoublepoint):TPoint;
function GetLineLenght(p1,p2: TPoint):Real;
Function ReadStringFromStream(Stream:TStream):String;
Procedure WriteString(Stream:TStream; str:string);
var
frmPaint: TfrmPaint;
Buffer,temp: TBitmap;
Scale: Integer;
dy,dx: Integer;
mp1,mp2,mp3,mp4: TPoint;
op1,op2,op3,op4: TPoint;
oPanel: TPanel;
px,py: Integer;
FilterBitmap,FilteredBmp : Tbitmap;
FilterRgn: HRGN;
implementation
const
crZoomp = crDefault + 31;
crZoomm = crDefault + 32;
crPen = crDefault + 33;
crBrush = crDefault + 35;
crBucket = crDefault + 36;
crDropper = crDefault + 37;
crPan = crDefault + 38;
crMove = crDefault + 39;
crMoveS = crDefault + 40;
crCrossp = crDefault + 41;
crCrossm = crDefault + 42;
crCrossn = crDefault + 43;
{$R *.DFM}
{$R *.RES}
{ TfrmPaint }
Function TfrmPaint.EditBitmap(var xBmp:Tbitmap; mStream: TStream):Boolean;
var orgBmp: TBitmap;
BackBmp: TBitmap;
begin
pc.ActivePageIndex := 0;
pc.Height := 110;
tabsheet2.DoubleBuffered := True;
cmbFilter.ItemIndex := 0;
Scale := 100;
mvx := 0;
mvy := 0;
mp := 0;
isMoving := False;
SelVisible := True;
LockScroll := False;
scmain.DoubleBuffered := True;
isMod := False;
oPanel := nil;
lock1 := true;
lock2 := true;
cLayer := nil;
lGrid.RowCount := 0;
cLayer := nil;
SelModified := False;
locx := 0;
locy := 0;
ClickIndex := 0;
OrgBmp := nil;
Buffer:= nil;
FilterBitmap := nil;
FilteredBmp := nil;
if assigned(mStream) then begin
LoadFromStream(mStream);
end else if assigned(xBmp) then begin
OrgBmp := TBitmap.Create;
orgBmp.Width := xBmp.Width;
orgBmp.Height := xBmp.Height;
medit1.Text := inttostr(orgbmp.width);
medit2.Text := inttostr(orgbmp.height);
orgbmp.canvas.Draw(0,0,xBmp);
end else begin
medit1.Text := '500';
medit2.Text := '500';
end;
if assigned(OrgBmp) then begin
BackBmp := TBitmap.Create;
BackBmp.Width := strtoint(medit1.Text);
BackBmp.Height := strtoint(medit2.Text);
BackBmp.Canvas.Draw(0,0,orgBmp);
NewLayer(BackBmp,'BackGround');
end;
bGrid.Row := 0;
bGrid.Col := 0;
FilterBitmap := Tbitmap.Create;
FilterBitmap.Width := 200;
FilterBitmap.Height := 200;
FilteredBmp := Tbitmap.Create;
FilteredBmp.Width := 200;
FilteredBmp.Height := 200;
CommandId := 1;
pbox.Cursor := crMove;
SelObjects := TList.Create;
Buffer := TBitmap.Create;
Buffer.Width := strtoint(medit1.Text);
Buffer.Height := strtoint(medit2.Text);
Buffer.PixelFormat := pf24bit;
Temp := TBitmap.Create;
Temp.Width := strtoint(medit1.Text);
Temp.Height := strtoint(medit2.Text);
Temp.PixelFormat := pf24bit;
drawbuffer;
ratio := strtoint(medit1.Text) / strtoint(medit1.Text);
lock1 := false;
lock2 := false;
SelRgn := 0;
ShowLayerOptions;
SelLayer := -1;
MGridDown := False;
ShowModal;
if ModalResult = mrOk then
begin
if Layers.Count > 0 then begin
DrawBuffer(False);
if not assigned(xBmp) then xBmp := Tbitmap.Create;
xbmp.Width := Buffer.Width;
xBmp.Height := Buffer.Height;
xBmp.Canvas.Draw(0,0,Buffer);
result := true;
end;
end;
if assigned(orgBmp) then begin
orgBmp.free;
end;
end;
procedure TfrmPaint.Shape1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
colordialog1.color := shape1.brush.color;
if colordialog1.Execute then begin
shape1.Brush.color := colordialog1.color;
Self.BringToFront;
end;
end;
procedure TfrmPaint.pBoxPaint(Sender: TObject);
var pw,ph: Integer;
Procedure CalculateScrolls;
begin
scH.Visible := (dw > pw);
scV.Visible := (dh > ph);
if scH.Visible then begin
sch.Min := 0;
sch.Max := dw-pw;
sch.Position := 0;
end;
if scV.Visible then begin
scv.Min := 0;
scv.Max := dh-ph;
scv.Position := 0;
end;
end;
begin
Temp.Canvas.Draw(0,0,Buffer);
pW := pbox.width;
ph := pbox.height;
dw := Round(Buffer.Width* (Scale/100));
dh := Round(Buffer.Height* (Scale/100));
if dw >= pw then dx := 0 else dx := (pw-dw) div 2;
if dh >= ph then dy := 0 else dy := (ph-dh) div 2;
if SelModified then
begin
lockScroll := True;
CalculateScrolls;
DeConvertPoint(locx,locy);
if dx = 0 then begin
dx := (pw div 2) - locx;
if dx < -(scH.Max) then dx := -(sch.Max);
if dx > 0 then dx := 0;
sch.Position := -dx;
end;
if dy = 0 then begin
dy := (ph div 2) - locy;
if dy < -(scV.Max) then dy := -(scV.Max);
if dy > 0 then dy := 0;
scv.Position := -dy;
end;
lockScroll := False;
end else begin
if dx = 0 then dx := -(scH.Position);
if dy = 0 then dy := -(scV.Position);
end;
pbox.Canvas.StretchDraw(Rect(dx,dy,dx+dw,dy+dh),Temp);
if SelModified then begin
DeleteObject(SelRgn);
selRgn := CreateSelRegion(true);
SelModified := False;
SelVisible := True;
RedrawFilter;
end;
if selVisible then DrawSel;
DrawLayerSel;
end;
procedure TfrmPaint.ToolButton8Click(Sender: TObject);
begin
CommandId := TToolButton(Sender).Tag;
if assigned(oPanel) then oPanel.Visible := False;
Case CommandId of
4: oPanel := pnBrush;
5: oPanel := pnPen;
else oPanel := nil;
end;
if assigned(oPanel) then
begin
oPanel.Parent := pnOptions;
oPanel.Visible := True;
end;
case commandId of
1: pbox.Cursor := crMove;
2: pbox.Cursor := crCrossn;
3: pbox.Cursor := crCrossn;
4: pbox.Cursor := crBrush;
5: pbox.Cursor := crPen;
6: pbox.Cursor := crDropper;
7: pbox.Cursor := crPan;
8: pbox.Cursor := crZoomp;
9: pbox.Cursor := crCrossn;
10:pbox.Cursor := crBucket;
else pbox.Cursor := crDefault;
end;
end;
procedure TfrmPaint.pBoxMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (CommandId = 1) and (SelLayer <> -1) then
begin
mp := CheckModPoint(x,y);
if mp > 0 then begin
op1 := mp1;op2 := mp2;op3 := mp3;op4 := mp4;
rpx := x;
rpy := y;
isMod := True;
DrawTempSel;
exit;
end;
end;
if (commandId = 1) or (CommandId = 7) then begin
isMoving := True;
mvx := x;
mvy := y;
end;
if (CommandId = 2) or (CommandId = 3) then begin
trp1 := point(x,y);
trp2 := point(x,y);
end;
if CommandId = 9 then begin
ClearPointLists;
ClickIndex := 1;
AddSelPoint(Point(x,y));
end;
if (commandId = 5) then begin
isMoving := True;
trp1 := point(x,y);
trp2 := point(x,y);
if cbFHand.Checked then begin
ClearPointLists;
AddselPoint(point(x,y));
end;
end;
if (commandId = 4) then begin
isMoving := True;
trp1 := point(x,y);
trp2 := point(x,y);
ClearPointLists;
AddselPoint(point(x,y));
end;
ConvertPoint(x,y);
HandleCommand(x,y,false,shift);
end;
procedure TfrmPaint.Button1Click(Sender: TObject);
begin
buffer.width := strtoint(medit1.Text);
buffer.Height := strtoint(medit2.Text);
temp.width := Buffer.Width;
temp.height := Buffer.height;
ratio := strtoint(medit1.Text)/strtoint(medit2.Text);
DrawBuffer;
SelModified := true;
pbox.refresh;
end;
procedure TfrmPaint.DrawBuffer(hasback:Boolean=True);
var i: Integer;
xLayer: TBmpLayer;
x,y,xMax,xMin,yMax,yMin: Integer;
dSize: Integer;
clpRgn: HRGN;
points: array [0..3] of TPoint;
gBitmap: Tbitmap;
begin
if not assigned(buffer) then exit;
Buffer.Canvas.Brush.Color := clWhite;
Buffer.Canvas.Brush.Style := bsSolid;
Buffer.Canvas.FillRect(rect(0,0,Buffer.Width,Buffer.Height));
if hasback then begin
Buffer.Canvas.Brush.Color := RGB(220,220,220);
x := 0;y := 0;dSize := 10;
i := 0;
repeat
Buffer.Canvas.FillRect(rect(x,y,x+dSize,y+dsize));
x := x+dsize*2;
if x > Buffer.Width then begin
i := i+1;
if odd(i) then x := dSize else x := 0;
y := y+(dsize);
end;
until y >= Buffer.Height;
end;
for i := Layers.Count-1 downto 0 do
begin
xLayer := TBmpLayer(layers[i]);
if xLayer.Visible then begin
xLayer.Bitmap.Transparent := xLayer.Transparent;
points[0] := xlayer.p1;points[1] := xlayer.p2;
points[2] := xlayer.p3;points[3] := xlayer.p4;
clpRgn := CreatePolygonRgn(points,4,ALTERNATE);
SelectClipRgn(Buffer.Canvas.Handle,ClpRgn);
xmax := MaxIntValue([xlayer.p1.x,xlayer.p2.x,xlayer.p3.x,xlayer.p4.x]);
ymax := MaxIntValue([xlayer.p1.y,xlayer.p2.y,xlayer.p3.y,xlayer.p4.y]);
xmin := MinIntValue([xlayer.p1.x,xlayer.p2.x,xlayer.p3.x,xlayer.p4.x]);
ymin := MinIntValue([xlayer.p1.y,xlayer.p2.y,xlayer.p3.y,xlayer.p4.y]);
if xLayer.Opaq = 100 then
Buffer.Canvas.StretchDraw(Rect(xmin,ymin,xmax,ymax),xLayer.Bitmap)
else begin
gbitmap := TBitmap.Create;
gbitmap.Width := xmax-xmin;
gbitmap.Height := ymax-ymin;
gbitmap.Canvas.CopyRect(Rect(0,0,gbitmap.Width,gbitmap.Height),Buffer.Canvas,Rect(xmin,ymin,xmax,ymax));
DrawGlassBitmap(gbitmap,xLayer.Bitmap,0,0,xlayer.Opaq,
xLayer.Bitmap.Canvas.Pixels[0,Height-1],xLayer.Transparent);
Buffer.Canvas.StretchDraw(Rect(xmin,ymin,xmax,ymax),gBitmap);
gbitmap.free;
end;
SelectClipRgn(Buffer.Canvas.Handle,0);
DeleteObject(clprgn);
end;
end;
end;
procedure TfrmPaint.medit1Change(Sender: TObject);
begin
if lock1 then exit;
if medit1.text = '' then medit1.text := '5';
lock2 := true;
if (ratio <> 0) and (chRatio.Checked) then
begin
medit2.Text := Inttostr(round(StrToInt(medit1.text)/ratio));
end;
lock2 := false;
end;
procedure TfrmPaint.medit2Change(Sender: TObject);
begin
if lock2 then exit;
if medit2.text = '' then medit2.text := '5';
lock1 := true;
if (chRatio.Checked) then medit1.text := Inttostr(Round(StrToInt(medit2.text)*ratio));
lock1 := false;
end;
procedure TfrmPaint.FormCreate(Sender: TObject);
begin
screen.Cursors[crZoomp] := LoadCursor(HInstance,'CRZOOMP');
screen.Cursors[crZoomm] := LoadCursor(HInstance,'CRZOOMM');
screen.Cursors[crPen] := LoadCursor(HInstance,'CRPEN');
screen.Cursors[crBrush] := LoadCursor(HInstance,'CRBRUSH');
screen.Cursors[crBucket] := LoadCursor(HInstance,'CRBUCKET');
screen.Cursors[crDropper] := LoadCursor(HInstance,'CRDROPPER');
screen.Cursors[crPan] := LoadCursor(HInstance,'CRPAN');
screen.Cursors[crMove] := LoadCursor(HInstance,'CRMOVE');
screen.Cursors[crMoveS] := LoadCursor(HInstance,'CRMOVES');
screen.Cursors[crCrossp] := LoadCursor(HInstance,'CRCROSSP');
screen.Cursors[crCrossm] := LoadCursor(HInstance,'CRCROSSM');
screen.Cursors[crCrossn] := LoadCursor(HInstance,'CRCROSSN');
Layers := TList.Create;
opd.Filter := GraphicFilter(TGraphic);
end;
Function TfrmPaint.NewLayer(bmp: TBitmap;lName:String;x:Integer = 0;y:Integer=0):TBmpLayer;
var xlayer: TBmplayer;
begin
xLayer := TBmpLayer.Create;
xLayer.Source := TBitmap.Create;
xLayer.Source.Width := bmp.Width;
xlayer.Source.Height := bmp.Height;
xLayer.Source.Canvas.Draw(0,0,bmp);
xLayer.Source.PixelFormat := pf24Bit;
xlayer.Bitmap := bmp;
xLayer.Name := lName;
xLayer.Transparent := False;
xLayer.Visible := True;
xLayer.Opaq := 100;
xLayer.Skewed := False;
xLayer.Rotated := False;
xLayer.Scaled := False;
xLayer.p1 := Point(x,y);
xLayer.p2 := Point(x+bmp.Width,y);
xLayer.p3 := Point(x+bmp.Width,y+bmp.Height);
xLayer.p4 := Point(x,y+bmp.Height);
xLayer.SelMode := 0;
Layers.Insert(0,xLayer);
lGrid.RowCount := layers.count;
lGrid.Row := 0;
Result := xLayer;
ShowLayerOptions;
if SelLayer <> -1 then SelLayer := SelLayer+1;
DrawBuffer;
end;
procedure TfrmPaint.InsertBitmap;
var TempPic : TPicture;
Picturename: String;
LayerBmp: Tbitmap;
begin
if OPD.Execute then
begin
TempPic := TPicture.Create;
PictureName := extractFileName(opd.fileName);
try
TempPic.LoadFromFile(opd.fileName);
LayerBmp := TBitmap.Create;
LayerBmp.Width := TempPic.Graphic.Width;
LayerBmp.Height := TempPic.Graphic.Height;
LayerBmp.Canvas.Draw(0,0,TempPic.Graphic);
LayerBmp.PixelFormat := pf24bit;
NewLayer(LayerBmp,PictureName);
DrawBuffer;
Self.BringToFront;
pbox.refresh;
except
on EInvalidGraphic do
begin
ShowMessage('Not a valid picture format');
end;
end;
end;
end;
procedure TfrmPaint.ToolButton1Click(Sender: TObject);
begin
InsertBitmap;
end;
procedure TfrmPaint.lGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var xlayer: TBmplayer;
procedure drawthumb;
var ww,hh,w,h,x,y: Integer;
xRect: Trect;
begin
ww := xLayer.Bitmap.Width;
hh := xLayer.Bitmap.Height;
if ww > hh then begin
w := 30;
h := Round(30* (hh/ww));
x := 0;
y := (30 - h) div 2;
end
else begin
h := 30;
w := Round(30* (ww/hh));
y := 0;
x := (30 - w) div 2;
end;
lGrid.Canvas.StretchDraw(Classes.rect(rect.left+2+x,rect.top+2+y,rect.left+2+x+w,rect.top+2+y+h),xLayer.Bitmap);
end;
begin
Lgrid.Canvas.Brush.Color := clWhite;
LGrid.Canvas.Brush.Style := bsSolid;
Lgrid.Canvas.Fillrect(rect);
if Layers.Count = 0 then exit;
xLayer := TBmpLayer(Layers[aRow]);
lGrid.Canvas.Font := lgrid.Font;
if gdSelected in State then
begin
Lgrid.Canvas.Brush.Color := clRed;
lGrid.Canvas.Font.Color := clWhite;
end
else
begin
Lgrid.Canvas.Brush.Color := clWhite;
lGrid.Canvas.Font.Color := clBlack;
end;
LGrid.Canvas.Brush.Style := bsSolid;
Lgrid.Canvas.Fillrect(rect);
if acol = 0 then begin
if xLayer.Visible then
lGrid.Canvas.Draw(rect.left+2,rect.top+4,image1.picture.bitmap);
end else if acol = 1 then begin
DrawThumb;
lGrid.Canvas.TextOut(rect.left+36,rect.top+4,xLayer.name);
end;
LGrid.Canvas.Pen.Color := clBlack;
LGrid.Canvas.Pen.Style := psSolid;
LGrid.Canvas.Pen.Width := 1;
LGrid.Canvas.MoveTo(rect.left,rect.bottom-1);
LGrid.Canvas.LineTo(rect.right,rect.bottom-1);
end;
procedure TfrmPaint.lGridClick(Sender: TObject);
begin
ShowLayerOptions;
end;
procedure TfrmPaint.ShowLayerOptions;
begin
//***
if Layers.Count = 0 then exit;
if (LGrid.Row > -1) and (lGrid.row < Layers.count) then
begin
cLayer := TBmpLayer(layers[lGrid.Row]);
edit1.Text := cLayer.Name;
label3.Caption := cLayer.Name + ' Options';
chLayer.Checked := clayer.Transparent;
tblayer.Position := cLayer.Opaq;
edit1.enabled := true;
chlayer.Enabled := true;
tbLayer.Enabled := True;
lb1.Enabled := true;lb2.Enabled := true;
lb3.Enabled := true;lb4.Enabled := true;
lb6.Enabled := True;lb7.Enabled := True;
end else begin
edit1.Text := '';
edit1.enabled := false;
label3.Caption := 'No Layer Selected';
chLayer.Checked := false;
chlayer.Enabled := false;
tbLayer.Position := 100;
tbLayer.Enabled := False;
lb1.Enabled := false;lb2.Enabled := false;
lb3.Enabled := false;lb4.Enabled := false;
lb6.Enabled := false;lb7.Enabled := false;
end;
RedrawFilter;
end;
procedure TfrmPaint.chLayerClick(Sender: TObject);
begin
if not assigned(cLayer) then exit;
cLayer.Transparent := chLayer.Checked;
DrawBuffer;
pBox.Refresh;
lGrid.Refresh;
end;
procedure TfrmPaint.tblayerChange(Sender: TObject);
begin
if not assigned(cLayer) then exit;
cLayer.Opaq := tbLayer.Position;
DrawBUffer;
pBox.Refresh;
end;
procedure TfrmPaint.Edit1Change(Sender: TObject);
begin
if not assigned(cLayer) then exit;
cLayer.Name := edit1.text;
ShowLayerOptions;
lGrid.Refresh;
end;
procedure TfrmPaint.pBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var dpx: Integer;
dpy: Integer;
pt1,pt2: TPoint;
begin
if isMod then begin
DrawTempSel;
ModifyPoints(x,y);
DrawTempSel;
end else if isMoving and (CommandId = 1) then begin
pt1 := Point(mvx,mvy);
pt2 := Point(x,y);
ConvertPoint(pt1.x,pt1.y);
ConvertPoint(pt2.x,pt2.y);
if ssCtrl in Shift then begin
if SelRgn <> 0 then begin
DrawSel;
MoveSelObjects(pt2.x-pt1.x,pt2.y-pt1.y);
OffsetRgn(SelRgn,x- mvx,y- mvy);
DrawSel;
end;
end else begin
if not assigned(cLayer) then exit;
cLayer.Move(pt2.x-pt1.x,pt2.y-pt1.y);
DrawBuffer;
pbox.refresh;
end;
mvx := x;
mvy := y;
end else if isMoving and (CommandId = 7) then begin
dpx := x- mvx;
dpy := y- mvy;
if (scV.Visible) and (abs(dpy) > 1) then scV.Position := scv.Position - dpy;
if (scH.Visible) and (abs(dpx) > 1) then scH.Position := scH.Position - dpx;
mvx := x;
mvy := y;
end else if ((ClickIndex = 1) and ((CommandId = 2) or (CommandId = 3))) or isMod then begin
DrawTempSel;
trp2 := Point(x,y);
DrawTempSel;
end else if (CommandId = 5) and isMoving then begin
if cbFHand.Checked then begin
trp1 := trp2;
trp2 := Point(x,y);
DrawTempSel;
AddselPoint(point(x,y));
end else begin
DrawTempSel;
trp2 := Point(x,y);
DrawTempSel;
end;
end else if (CommandId = 4) and isMoving then begin
trp1 := trp2;
trp2 := Point(x,y);
DrawTempSel;
AddselPoint(point(x,y));
end else if (ClickIndex > 0) and (CommandId = 9) then begin
DrawTempSel;
ClickIndex := ClickIndex+1;
AddSelPoint(Point(x,y));
DrawTempSel;
end;
end;
procedure TfrmPaint.pBoxMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if ismod then begin
HandleMod(x,y);
exit;
end;
isMoving := False;
ConvertPoint(x,y);
HandleCommand(x,y,true,shift);
end;
procedure TfrmPaint.lGridMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var aRow,aCol: Integer;
xLayer: TBmpLayer;
begin
if layers.count = 0 then exit;
lGrid.MouseToCell(x,y,aCol,aRow);
if arow = -1 then exit;
if (aCol = 0) then begin
xLayer := TBmpLayer(Layers[arow]);
xLayer.Visible := not xLayer.Visible;
lGrid.Refresh;
DrawBuffer;
pBox.Refresh;
end else begin
mGridDown := true;
mgx := x;
mgy := y;
end;
end;
procedure TfrmPaint.HandleCommand(x, y: Integer; Up: Boolean;shift: TShiftState);
var tRgn : HRGN;
SelObject: TSelObject;
cMode: Integer;
bColor:TColor;
begin
if (commandId = 8) and Up then begin
if ssctrl in shift then Scale := scale - 30
else Scale := Scale+10;
if scale <= 0 then scale := 10;
SelModified := True;
locx := x;
locy := y;
pbox.refresh;
end else if (commandId = 2) then begin
ClickIndex := ClickIndex+1;
if not up then begin
rp1 := Point(x,y);
rp2 := Point(x,y);
end
else if up then begin
rp2 := Point(x,y);ClickIndex := 0;
if pbox.Cursor = crCrossp then begin
cMode := RGN_OR;
end else if pbox.Cursor = crCrossm then begin
cMode := RGN_DIFF;
end else begin
cMode := 0;
ClearSelObjects;
end;
selObject := TSelObject.Create(1,cMode);
selObject.AddPoint(rp1);selObject.AddPoint(rp2);
SelObjects.Add(selObject);
SelModified := True;
pBox.refresh;
end;
end else if (commandId = 3) then begin
ClickIndex := ClickIndex+1;
if not up then begin
rp1 := Point(x,y);
rp2 := Point(x,y);
end
else if up then begin
rp2 := Point(x,y);ClickIndex := 0;
rp2 := Point(x,y);ClickIndex := 0;
if pbox.Cursor = crCrossp then begin
cMode := RGN_OR;
end else if pbox.Cursor = crCrossm then begin
cMode := RGN_DIFF;
end else begin
cMode := 0;
ClearSelObjects;
end;
selObject := TSelObject.Create(2,cMode);
selObject.AddPoint(rp1);selObject.AddPoint(rp2);
SelObjects.Add(selObject);
SelModified := True;
pBox.refresh;
end;
end else if (commandId = 4) then begin
if up then begin
DrawFreeBrush;
LayerFix;
Drawbuffer;
pbox.refresh;
end;
end else if (commandId = 10) then begin
if up then begin
BucketFill(x,y);
LayerFix;
Drawbuffer;
pbox.refresh;
end;
end else if (commandId = 5) then begin
if not up then begin
px := x; py := y;
end else begin
if not cbFHand.Checked then begin
DrawLine(px,py,x,y);
Layerfix;
Drawbuffer;
pbox.refresh;
end else begin
DrawFreehand;
LayerFix;
Drawbuffer;
pbox.refresh;
end;
end;
end else if (commandId = 6) and up then begin
if GetBmpColor(x,y,bcolor) then Shape1.Brush.Color := bcolor;
end else if (commandId = 9) and up then begin
if pbox.Cursor = crCrossp then begin
cMode := RGN_OR;
end else if pbox.Cursor = crCrossm then begin
cMode := RGN_DIFF;
end else begin
cMode := 0;
ClearSelObjects;
end;
selObject := TSelObject.Create(3,cMode);
PolyPointsToSelObj(selObject);
SelObjects.Add(selObject);
SelModified := True;
ClickIndex := 0;
pBox.refresh;
end;
end;
procedure TfrmPaint.ClearPointLists;
begin
SetLength(PointList,0);
SetLength(tPointList,0);
end;
type
PPoints = ^TPoints;
TPoints = array[0..0] of TPoint;
// Tolik 04/04/2019
Function TfrmPaint.CreatePolyRegion(pList: array of TPoint;scaled:Boolean):HRGN;
var ip: Pointer;
i,size: Integer;
p1: TPoint;
begin
size := Length(pList);
GetMem(ip,size*8);
for i := 0 to size -1 do begin
p1 := pList[i];
if scaled then DeConvertPoint(p1.x,p1.y);
PInt(PAnsiChar(ip)+i*8+0)^:= p1.x;
PInt(PAnsiChar(ip)+i*8+4)^:= p1.y;
end;
Result := CreatePolygonRgn(PPoints(ip)^,size,ALTERNATE);
FreeMem(ip,size*8);
end;
{
Function TfrmPaint.CreatePolyRegion(pList: array of TPoint;scaled:Boolean):HRGN;
var ip: Pointer;
i,size: Integer;
p1: TPoint;
begin
size := Length(pList);
GetMem(ip,size*8);
for i := 0 to size -1 do begin
p1 := pList[i];
if scaled then DeConvertPoint(p1.x,p1.y);
// Tolik 23/04/2019 --
// PInt(PChar(ip)+i*8+0)^:= p1.x;
// PInt(PChar(ip)+i*8+4)^:= p1.y;
PInt(PAnsiChar(ip)+i*8+0)^:= p1.x;
PInt(PAnsiChar(ip)+i*8+4)^:= p1.y;
//
end;
Result := CreatePolygonRgn(PPoints(ip)^,size,ALTERNATE);
FreeMem(ip,size*8);
end;
}
procedure TfrmPaint.DrawTempPolygon;
begin
pBox.Canvas.PolyLine(tPointList);
end;
procedure TfrmPaint.DrawSel;
begin
pBox.Canvas.Pen.Mode := pmXor;
pBox.Canvas.Brush.Style := bsSolid;
pBox.Canvas.Brush.Color := clRed;
pBox.Canvas.Pen.color := clRed;
pBox.Canvas.Pen.Style :=psDash;
FillRgn(pBox.Canvas.Handle,selrgn,pBox.Canvas.Brush.Handle);
pBox.Canvas.Pen.Mode := pmCopy;
end;
procedure ConvertPoint(var x, y: Integer);
begin
x := Round((x-dx)/(scale/100));
y := Round((y-dy)/(Scale/100));
end;
procedure TfrmPaint.DrawTempSel;
begin
pbox.Canvas.Pen.Mode := pmXor;
pbox.Canvas.Brush.Style := bsClear;
pbox.Canvas.Pen.color := clLime;
pbox.Canvas.Pen.Style :=psDash;
if (CommandId = 1) then begin
pbox.Canvas.Polygon([mp1,mp2,mp3,mp4]);
end else if (CommandId = 2)then
pbox.Canvas.Rectangle(trp1.x,trp1.y,trp2.x,trp2.y)
else if CommandId = 3 then
pbox.Canvas.Ellipse(trp1.x,trp1.y,trp2.x,trp2.y)
else if CommandId = 9 then DrawTempPolygon
else if (CommandId = 5) or (CommandId = 4) then begin
pbox.Canvas.MoveTo(trp1.x,trp1.y);
pbox.Canvas.LineTo(trp2.x,trp2.y);
end;
pbox.Canvas.Pen.Mode := pmCopy;
end;
procedure TfrmPaint.AddSelPoint(pt: TPoint);
var cnt: Integer;
begin
cnt := Length(PointList);
Setlength(PointList,cnt+1);
Setlength(tPointList,cnt+1);
tPointList[cnt] := pt;
ConvertPoint(pt.x,pt.y);
PointList[cnt] := pt;
end;
function BitmapToRegion(Bitmap: TBitmap; TransColor: TColor;dx,dy:Integer;selList:TList): HRGN;
var
X, Y: Integer;
XStart: Integer;
SelObject: TSelObject;
cMode: Integer;
row: pRGBArray;
tRGB: TRGBTriple;
begin
Result := 0;
trgb.rgbtBlue := GEtBValue(TransColor);
trgb.rgbtRed := GEtRValue(TransColor);
trgb.rgbtGreen := GEtRValue(TransColor);
for Y := 0 to Bitmap.Height - 1 do begin
row := Bitmap.ScanLine[y];
X := 0;
while X < Bitmap.Width do begin
while (X < Bitmap.Width) and (row[X].rgbtBlue = tRgb.rgbtBlue )
and (row[X].rgbtRed = tRgb.rgbtRed )
and (row[X].rgbtGreen = tRgb.rgbtGreen )
do
Inc(X);
if X >= Bitmap.Width then
Break;
XStart := X;
while (X < Bitmap.Width) and not ((row[X].rgbtBlue = tRgb.rgbtBlue )
and (row[X].rgbtRed = tRgb.rgbtRed )
and (row[X].rgbtGreen = tRgb.rgbtGreen ))
do
Inc(X);
cMode := RGN_OR;
SelObject := TSelObject.Create(1,cMode);
SelObject.AddPoint(Point(XStart+dx, Y+dy));
SelObject.AddPoint(Point(X+dx, Y+dy + 1));
selList.add(SelObject);
end;
end;
end;
Procedure DrawGlassBitmap(BCanvas: TBitmap; FBitmap:TBitmap; sx,sy,Transity: Integer; FTransColor: TColor;isTrans: Boolean);
var
SL,BL: PRGBArray;
X, Y: Integer;
SWidth, SHeight: Integer;
pix:TRGBTriple;
trColor : TRGBTriple;
begin
SWidth := FBitmap.Width;
SHeight:= FBitmap.Height;
FBitmap.PixelFormat := pf24bit;
BCanvas.PixelFormat := pf24bit;
SL := FBitmap.ScanLine[SHeight - 1];
trColor := SL[0];
for Y := 0 to SHeight - 1 do begin
SL := FBitmap.ScanLine[Y];
if (sy+y < BCanvas.Height) and (sy+y > 0) then begin
BL := BCanvas.Scanline[sy+Y];
for X := 0 to SWidth - 1 do begin
try
if (sx+x < BCanvas.Width) and (sx+x > 0) then begin
pix := BL[sx+X];
if (isTrans) and (SL[x].rgbtBlue = trColor.rgbtBlue )
and (SL[x].rgbtGreen = trColor.rgbtGreen )
and (SL[x].rgbtRed = trColor.rgbtRed ) then
begin
end else begin
BL[sx+X].rgbtRed := (Transity * SL[X].rgbtRed + (100 - Transity) * pix.rgbtRed ) div 100;
BL[sx+X].rgbtGreen := (Transity * SL[X].rgbtGreen + (100 - Transity)* pix.rgbtGreen ) div 100;
BL[sx+X].rgbtBlue := (Transity * SL[X].rgbtBlue + (100 - Transity) * pix.rgbtBlue ) div 100;
end;
end;
except
end;
end;
end;
end;
end;
procedure TfrmPaint.lb4Click(Sender: TObject);
begin
SelectLayerBounds;
end;
procedure TfrmPaint.SelectLayerBounds;
var bmp: TBitmap;
SelObject:TSelObject;
xMin,yMin:Integer;
begin
if not assigned(cLayer) then exit;
ClearSelObjects;
SelLayer := -1;
bmp := cLayer.Bitmap;
if cLayer.Transparent then begin
xmin := MinIntValue([clayer.p1.x,clayer.p2.x,cLayer.p3.x,clayer.p4.x]);
ymin := MinIntValue([clayer.p1.y,clayer.p2.y,cLayer.p3.y,clayer.p4.y]);
BitmapToRegion(bmp,bmp.Canvas.Pixels[0,bmp.height-1],xMin,yMin,SelObjects);
SelModified := True;
pBox.refresh;
end else begin
SelObject := tSelObject.Create(3,0);
SelObject.AddPoint(Point(cLayer.p1.x,cLayer.p1.y));
SelObject.AddPoint(Point(cLayer.p2.x,cLayer.p2.y));
SelObject.AddPoint(Point(cLayer.p3.x,cLayer.p3.y));
SelObject.AddPoint(Point(cLayer.p4.x,cLayer.p4.y));
SelObjects.add(SelObject);
SelModified := True;
pBox.refresh;
end;
end;
procedure TfrmPaint.lb1Click(Sender: TObject);
begin
if not assigned(clayer) then exit;
KillSelections;
CLayer.SelMode := 1;
SelMode := 1;
SelLayer := Layers.IndexOf(CLayer);
pbox.Refresh;
end;
procedure TfrmPaint.KillSelections;
var i: Integer;
xLayer : TBmpLayer;
begin
SelLAyer := -1;
DeleteObject(SelRgn);
SelRgn := 0;
for i := 0 to Layers.Count -1 do
begin
xLayer := TBmpLayer(Layers[i]);
xLayer.SelMode := 0;
end;
pbox.Refresh;
end;
procedure TfrmPaint.lb2Click(Sender: TObject);
begin
if not assigned(clayer) then exit;
KillSelections;
CLayer.SelMode := 2;
SelMode := 2;
SelLayer := Layers.IndexOf(CLayer);
pbox.Refresh;
end;
procedure TfrmPaint.lb3Click(Sender: TObject);
begin
if not assigned(clayer) then exit;
KillSelections;
CLayer.SelMode := 3;
SelMode := 3;
SelLayer := Layers.IndexOf(CLayer);
pbox.Refresh;
end;
procedure TfrmPaint.PolyPointsToSelObj(sObj: TSelObject);
var i,size: Integer;
begin
size := Length(PointList);
for i := 0 to size -1 do
SObj.Addpoint(PointList[i]);
end;
Function TfrmPaint.CreateSelRegion(Scaled: Boolean = True):HRGN;
var i: Integer;
selObj: TSelObject;
xRgn: HRGN;
p1,p2: TPoint;
sRgn: HRGN;
begin
//**
sRgn := 0;
//DeleteObject(SelRgn);
for i := 0 to SelObjects.Count -1 do
begin
selObj := TSelObject(SelObjects[i]);
case selObj.xType of
1: begin
p1 := selObj.Points[0];p2 := selObj.Points[1];
if scaled then begin
DeConvertPoint(p1.x,p1.y);DeConvertPoint(p2.x,p2.y);
end;
xRgn := CreateRectRgn(p1.x,p1.y,p2.x,p2.y);
end;
2: begin
p1 := selObj.Points[0];p2 := selObj.Points[1];
if scaled then begin
DeConvertPoint(p1.x,p1.y);DeConvertPoint(p2.x,p2.y);
end;
xRgn := CreateEllipticRgn(p1.x,p1.y,p2.x,p2.y);
end;
3: xRgn := CreatePolyRegion(selObj.Points,Scaled);
end;
if i = 0 then
SRgn := xRgn
else
begin
CombineRgn(SRgn,sRgn,xRgn,selObj.cMode);
DeleteObject(xRgn);
end;
end;
result := sRgn;
end;
procedure TfrmPaint.ClearSelObjects;
var selObj: TSelObject;
i: Integer;
begin
SelLayer := -1;
for i := 0 to SelObjects.Count -1 do
begin
selObj := TSelObject(SelObjects[i]);
SetLength(selObj.Points,0);
selObj.Free;
end;
SelObjects.Clear;
end;
procedure DeConvertPoint(var x, y: Integer);
begin
x := Round(x*(scale/100))+dx;
y := Round(y*(Scale/100))+dy;
end;
procedure TfrmPaint.DrawlayerSel;
var xLayer:TBMPLayer;
x1,y1,x2,y2,x3,y3,x4,y4,xmin,ymin,xmax,ymax:Integer;
begin
if SelLayer = -1 then exit;
xLayer := TBmpLayer(Layers[SelLayer]);
pbox.Canvas.Pen.Mode := pmCopy;
pBox.Canvas.Pen.Color := clBlack;
pbox.Canvas.pen.Style := psSolid;
pBox.Canvas.Brush.Style := bsClear;
x1 := xLayer.p1.x; x2 := xLayer.p2.x; x3 := xLayer.p3.x; x4 := xLayer.p4.x;
y1 := xLayer.p1.y; y2 := xLayer.p2.y; y3 := xLayer.p3.y; y4 := xLayer.p4.y;
DeConvertPoint(x1,y1);DeConvertPoint(x2,y2);
DeConvertPoint(x3,y3);DeConvertPoint(x4,y4);
if selmode = 2 then begin
xmin := MinIntValue([x1,x2,x3,x4]);
xmax := MaxIntValue([x1,x2,x3,x4]);
ymin := MinIntValue([y1,y2,y3,y4]);
ymax := MaxIntValue([y1,y2,y3,y4]);
mp1 := Point(xmin,ymin);mp2 := Point(xmax,ymin);
mp3 := Point(xmax,ymax);mp4 := Point(xmin,ymax);
end else begin
mp1 := Point(x1,y1);mp2 := Point(x2,y2);
mp3 := Point(x3,y3);mp4 := Point(x4,y4);
end;
pBox.Canvas.Polygon([mp1,mp2,mp3,mp4]);
pBox.Canvas.Brush.Style := bsSolid;
if selMode = 1 then pBox.Canvas.Brush.Color := clRed
else if selMode = 2 then pBox.Canvas.Brush.Color := clBlue
else if selMode = 3 then pBox.Canvas.Brush.Color := clGreen;
pbox.canvas.Ellipse(mp1.x-6,mp1.y-6,mp1.x+6,mp1.y+6);
pbox.canvas.Ellipse(mp2.x-6,mp2.y-6,mp2.x+6,mp2.y+6);
pbox.canvas.Ellipse(mp3.x-6,mp3.y-6,mp3.x+6,mp3.y+6);
pbox.canvas.Ellipse(mp4.x-6,mp4.y-6,mp4.x+6,mp4.y+6);
if SelMode = 1 then begin
RotPoint := MPoint(MPoint(mp1,mp2),MPoint(mp3,mp4));
pbox.canvas.Ellipse(RotPoint.x-6,RotPoint.y-6,RotPoint.x+6,RotPoint.y+6);
end;
end;
function TfrmPaint.CheckModPoint(x, y: Integer): Integer;
var d,dx,dy: Integer;
begin
result := 0;
dx := (x-mp1.x); dy := (y-mp1.y);
d := Round(sqrt(dx*dx+dy*dy));
if d < 6 then begin
result := 1;
exit;
end;
dx := (x-mp2.x); dy := (y-mp2.y);
d := Round(sqrt(dx*dx+dy*dy));
if d < 6 then begin
result := 2;
exit;
end;
dx := (x-mp3.x); dy := (y-mp3.y);
d := Round(sqrt(dx*dx+dy*dy));
if d < 6 then begin
result := 3;
exit;
end;
dx := (x-mp4.x); dy := (y-mp4.y);
d := Round(sqrt(dx*dx+dy*dy));
if d < 6 then begin
result := 4;
exit;
end;
end;
procedure TfrmPaint.HandleMod(x, y: Integer);
var xLayer: TBMPLayer;
selMode : Integer;
begin
isMod := false;
if (selLayer =-1) or (selLayer >= Layers.COunt) then exit;
xLayer := TBMPLayer(Layers[SelLayer]);
xLayer.Modify(mp);
DrawBuffer;
pbox.refresh;
end;
procedure TfrmPaint.ModifyPoints(x, y: Integer);
var hitPoint,orPoint: TPoint;
dax,day,ddx,ddy,distx,disty: Integer;
xAngle: Double;
a1,a2: Double;
begin
if selMode = 1 then begin
if mp = 5 then begin
//TraceFigure.RotPoint := DoublePoint(x,y);
end else begin
a1 := GetRadOfLine(rotPoint,Point(rpx,rpy));
a2 := GetRadOfLine(rotPoint,Point(x,y));
mp1 := RotatePoint(RotPoint,op1,a2-a1);
mp2 := RotatePoint(RotPoint,op2,a2-a1);
mp3 := RotatePoint(RotPoint,op3,a2-a1);
mp4 := RotatePoint(RotPoint,op4,a2-a1);
end;
end else if selmode = 2 then begin
if mp = 1 then
begin
mp1 := Point(x,y);
mp2.y := y;
mp4.x := x;
end else if mp = 2 then begin
mp2 := Point(x,y);
mp1.y := y;
mp3.x := x;
end else if mp = 3 then begin
mp3 := Point(x,y);
mp4.y := y;
mp2.x := x;
end else if mp = 4 then begin
mp4 := Point(x,y);
mp3.y := y;
mp1.x := x;
end;
end else if selmode = 3 then begin
if mp =1 then mp1 := Point(x,y)
else if mp = 2 then mp2 := Point(x,y)
else if mp = 3 then mp3 := Point(x,y)
else if mp = 4 then mp4 := Point(x,y);
end;
end;
procedure TfrmPaint.BlankLayer;
var bmp: TBitmap;
lName: String;
begin
lName := 'New Layer';
if InputQuery('New Layer Bitmap','Enter a name for the Layer',lName) then
begin
bmp := TBitmap.Create;
bmp.Width := buffer.Width;
bmp.Height := buffer.Height;
bmp.PixelFormat := pf24bit;
NewLayer(bmp,lname);
DrawBuffer;
pbox.refresh;
end;
end;
procedure TfrmPaint.FlattenImage;
var i: Integer;
xLayer: TBmpLayer;
x,y,xMax,xMin,yMax,yMin: Integer;
dSize: Integer;
clpRgn: HRGN;
points: array [0..3] of TPoint;
gBitmap: Tbitmap;
buf: Tbitmap;
lName: String;
begin
if layers.Count = 0 then exit;
Buf := Tbitmap.Create;
Buf.Width := Buffer.Width;
Buf.Height := Buffer.Height;
Buf.PixelFormat := pf24bit;
for i := Layers.Count-1 downto 0 do
begin
xLayer := TBmpLayer(layers[i]);
if xLayer.Visible then begin
xLayer.Bitmap.Transparent := xLayer.Transparent;
points[0] := xlayer.p1;points[1] := xlayer.p2;
points[2] := xlayer.p3;points[3] := xlayer.p4;
clpRgn := CreatePolygonRgn(points,4,ALTERNATE);
SelectClipRgn(Buffer.Canvas.Handle,ClpRgn);
xmax := MaxIntValue([xlayer.p1.x,xlayer.p2.x,xlayer.p3.x,xlayer.p4.x]);
ymax := MaxIntValue([xlayer.p1.y,xlayer.p2.y,xlayer.p3.y,xlayer.p4.y]);
xmin := MinIntValue([xlayer.p1.x,xlayer.p2.x,xlayer.p3.x,xlayer.p4.x]);
ymin := MinIntValue([xlayer.p1.y,xlayer.p2.y,xlayer.p3.y,xlayer.p4.y]);
if xLayer.Opaq = 100 then
buf.Canvas.StretchDraw(Rect(xmin,ymin,xmax,ymax),xLayer.Bitmap)
else begin
gbitmap := TBitmap.Create;
gbitmap.Width := xmax-xmin;
gbitmap.Height := ymax-ymin;
gbitmap.Canvas.CopyRect(Rect(0,0,gbitmap.Width,gbitmap.Height),buf.Canvas,Rect(xmin,ymin,xmax,ymax));
DrawGlassBitmap(gbitmap,xLayer.Bitmap,0,0,xlayer.Opaq,
xLayer.Bitmap.Canvas.Pixels[0,Height-1],xLayer.Transparent);
buf.Canvas.StretchDraw(Rect(xmin,ymin,xmax,ymax),gBitmap);
gbitmap.free;
end;
SelectClipRgn(buf.Canvas.Handle,0);
DeleteObject(clprgn);
end;
end;
lName := TBmpLayer(Layers[layers.Count-1]).Name;
ClearLayers;
NewLayer(buf,lName);
DrawBuffer;
lGrid.Row := 0;
ShowLayerOptions;
pbox.refresh;
end;
procedure TfrmPaint.Clearlayers;
var i: Integer;
xLayer : TBmpLayer;
begin
for i := 0 to Layers.Count-1 do
begin
xLayer := TbmpLayer(Layers[i]);
xLayer.Free;
end;
Layers.Clear;
LGrid.RowCount := 1;
SelLayer := -1;
cLayer := nil;
end;
procedure TfrmPaint.MergeVisible;
var i: Integer;
xLayer: TBmpLayer;
x,y,xMax,xMin,yMax,yMin: Integer;
dSize: Integer;
clpRgn: HRGN;
points: array [0..3] of TPoint;
gBitmap: Tbitmap;
buf: Tbitmap;
lName: String;
index: Integer;
begin
if layers.Count = 0 then exit;
Buf := Tbitmap.Create;
Buf.Width := Buffer.Width;
Buf.Height := Buffer.Height;
Buf.PixelFormat := pf24Bit;
lName := '';
index := -1;
for i := Layers.Count-1 downto 0 do
begin
xLayer := TBmpLayer(layers[i]);
if xLayer.Visible then begin
if lname = '' then lName := xLayer.name;
if index = -1 then index := i;
xLayer.Bitmap.Transparent := xLayer.Transparent;
points[0] := xlayer.p1;points[1] := xlayer.p2;
points[2] := xlayer.p3;points[3] := xlayer.p4;
clpRgn := CreatePolygonRgn(points,4,ALTERNATE);
SelectClipRgn(Buffer.Canvas.Handle,ClpRgn);
xmax := MaxIntValue([xlayer.p1.x,xlayer.p2.x,xlayer.p3.x,xlayer.p4.x]);
ymax := MaxIntValue([xlayer.p1.y,xlayer.p2.y,xlayer.p3.y,xlayer.p4.y]);
xmin := MinIntValue([xlayer.p1.x,xlayer.p2.x,xlayer.p3.x,xlayer.p4.x]);
ymin := MinIntValue([xlayer.p1.y,xlayer.p2.y,xlayer.p3.y,xlayer.p4.y]);
if xLayer.Opaq = 100 then
buf.Canvas.StretchDraw(Rect(xmin,ymin,xmax,ymax),xLayer.Bitmap)
else begin
gbitmap := TBitmap.Create;
gbitmap.Width := xmax-xmin;
gbitmap.Height := ymax-ymin;
gbitmap.Canvas.CopyRect(Rect(0,0,gbitmap.Width,gbitmap.Height),buf.Canvas,Rect(xmin,ymin,xmax,ymax));
DrawGlassBitmap(gbitmap,xLayer.Bitmap,0,0,xlayer.Opaq,
xLayer.Bitmap.Canvas.Pixels[0,Height-1],xLayer.Transparent);
buf.Canvas.StretchDraw(Rect(xmin,ymin,xmax,ymax),gBitmap);
gbitmap.free;
end;
SelectClipRgn(buf.Canvas.Handle,0);
DeleteObject(clprgn);
end;
end;
if index = -1 then begin
buf.free;
exit;
end;
for i := Layers.Count-1 downto 0 do
begin
xLayer := TBmpLayer(layers[i]);
if xLayer.Visible then begin
Layers.Delete(i);
xLayer.Free;
end;
end;
NewLayer(buf,lName);
DrawBuffer;
pbox.refresh;
end;
procedure TfrmPaint.DrawLine(x1, y1, x2, y2: Integer);
var x,y: Integer;
begin
if not assigned(cLayer) then exit;
x := MinIntValue([clayer.p1.x,clayer.p2.x,clayer.p3.x,clayer.p4.x]);
y := MinIntValue([clayer.p1.y,clayer.p2.y,clayer.p3.y,clayer.p4.y]);
clayer.Bitmap.Canvas.Pen.Color := Shape1.Brush.Color;
clayer.Bitmap.Canvas.Pen.Width := spPen.Value;
clayer.Bitmap.Canvas.Pen.Style := psSolid;
cLayer.Bitmap.Canvas.MoveTo(x1-x,y1-y);
cLayer.Bitmap.Canvas.LineTo(x2-x,y2-y);
end;
procedure TfrmPaint.DrawFreeHand;
var i,x,y: Integer;
pt: TPoint;
begin
if not assigned(cLayer) then exit;
x := MinIntValue([clayer.p1.x,clayer.p2.x,clayer.p3.x,clayer.p4.x]);
y := MinIntValue([clayer.p1.y,clayer.p2.y,clayer.p3.y,clayer.p4.y]);
clayer.Bitmap.Canvas.Pen.Color := Shape1.Brush.Color;
clayer.Bitmap.Canvas.Pen.Width := spPen.Value;
clayer.Bitmap.Canvas.Pen.Style := psSolid;
for i := 0 to Length(PointList)-1 do
begin
pt := PointList[i];
if i = 0 then
cLayer.Bitmap.Canvas.MoveTo(pt.x-x,pt.y-y)
else
cLayer.Bitmap.Canvas.LineTo(pt.x-x,pt.y-y)
end;
end;
procedure TfrmPaint.DrawFreeBrush;
var i,x,y: Integer;
pt: TPoint;
sz: Integer;
crc: Boolean;
dx,dy: Integer;
begin
if not assigned(cLayer) then exit;
x := MinIntValue([clayer.p1.x,clayer.p2.x,clayer.p3.x,clayer.p4.x]);
y := MinIntValue([clayer.p1.y,clayer.p2.y,clayer.p3.y,clayer.p4.y]);
clayer.Bitmap.Canvas.Pen.Color := Shape1.Brush.Color;
clayer.Bitmap.Canvas.Brush.Color := Shape1.Brush.Color;
clayer.Bitmap.Canvas.Brush.Style := bsSolid;
clayer.Bitmap.Canvas.Pen.Width := 1;
clayer.Bitmap.Canvas.Pen.Style := psSolid;
sz := GetbSize;
crc := bCircle;
for i := 0 to Length(PointList)-1 do
begin
pt := PointList[i];
dx := pt.x-x;
dy := pt.y-y;
dx := dx - (sz div 2);
dy := dy - (sz div 2);
if crc then begin
cLayer.Bitmap.Canvas.Ellipse(dx,dy,dx+sz,dy+sz);
end else begin
cLayer.Bitmap.Canvas.Rectangle(dx,dy,dx+sz,dy+sz);
end;
end;
end;
function TfrmPaint.GetBSize: Integer;
begin
if (bGrid.Row = 0) or (bGrid.Row = 2) then begin
result := bGrid.Col+3;
end else begin
result := bGrid.Col+11;
end;
end;
function TfrmPaint.bCircle: Boolean;
begin
result := (bGrid.Row > 1);
end;
function TfrmPaint.GetBmpColor(x, y: Integer; var cl: TColor): Boolean;
var cx,cy: Integer;
begin
if not assigned(cLayer) then exit;
cx := MinIntValue([clayer.p1.x,clayer.p2.x,clayer.p3.x,clayer.p4.x]);
cy := MinIntValue([clayer.p1.y,clayer.p2.y,clayer.p3.y,clayer.p4.y]);
x := x-cx;
y := y-cy;
if (x < 0) or (y < 0) or (y > cLayer.Bitmap.Height-1) or (x > cLayer.Bitmap.Width-1)
then result := false else begin
result := true;
cl := cLayer.Bitmap.Canvas.Pixels[x,y];
end;
end;
procedure TfrmPaint.BucketFill(x, y: Integer);
var cx,cy: Integer;
begin
if not assigned(cLayer) then exit;
cx := MinIntValue([clayer.p1.x,clayer.p2.x,clayer.p3.x,clayer.p4.x]);
cy := MinIntValue([clayer.p1.y,clayer.p2.y,clayer.p3.y,clayer.p4.y]);
x := x-cx;
y := y-cy;
if not ((x < 0) or (y < 0) or (y > cLayer.Bitmap.Height-1) or (x > cLayer.Bitmap.Width-1))
then begin
cLayer.Bitmap.Canvas.Brush.Color := shape1.brush.color;
cLayer.Bitmap.Canvas.Brush.Style := bsSolid;
cLayer.Bitmap.Canvas.FloodFill(x,y,cLayer.Bitmap.Canvas.Pixels[x,y],fsSurface);
end;
end;
procedure TfrmPaint.MoveSelObjects(dx, dy: Integer);
var i,k: Integer;
selObj: TSelObject;
begin
for i := 0 to SelObjects.Count -1 do
begin
selObj := TSelObject(SelObjects[i]);
for k := 0 to selObj.pCount -1 do begin
selObj.Points[k] := Point(selObj.Points[k].x+dx,selObj.Points[k].y+dy);
end;
end;
end;
function TfrmPaint.GetFilterBitmap: TBitmap;
var resBmp: Tbitmap;
xRect: Trect;
srgn: HRGN;
xMin,ymin,w,h: Integer;
begin
result := nil;
Filterrgn := 0;
if not assigned(cLayer) then exit;
sRgn := CreateSelRegion(False);
if sRgn = 0 then begin
result := Tbitmap.Create;
result.width := 200;
result.Height := 200;
result.Canvas.Draw(0,0,cLayer.Bitmap);
end else begin
GetrgnBox(srgn,xRect);
if (xRect.Right = xRect.Left) and (xRect.Top = xRect.Bottom) then begin
result := Tbitmap.Create;
result.width := 200;
result.Height := 200;
result.Canvas.Draw(0,0,cLayer.Bitmap);
end else begin
result := Tbitmap.Create;
w := xRect.Right - xRect.left;
h := xRect.bottom - xRect.top;
result.width := 200;
result.Height := 200;
xmin := MinIntValue([clayer.p1.x,clayer.p2.x,cLayer.p3.x,clayer.p4.x]);
ymin := MinIntValue([clayer.p1.y,clayer.p2.y,cLayer.p3.y,clayer.p4.y]);
Offsetrgn(sRgn,-xmin,-ymin);
GetrgnBox(srgn,xRect);
Offsetrgn(sRgn,-xRect.left,-xrect.top);
FilterRgn := sRgn;
result.canvas.copyrect(Rect(0,0,200,200),cLayer.bitmap.canvas,
Rect(xRect.Left,xRect.top,xRect.left+200,xRect.top+200));
end;
end;
end;
procedure TfrmPaint.RedrawFilter;
var xBmp: Tbitmap;
begin
if not assigned(FilterBitmap) then exit;
if not assigned(FilteredBmp) then exit;
xbmp := nil;
xBmp := GetFilterBitmap;
if not assigned(xBmp) then exit;
FilterBitmap.Canvas.Brush.Color := clWhite;
FilterBitmap.Canvas.Brush.Style := bsSolid;
FilterBitmap.Canvas.FillRect(rect(0,0,200,200));
FilterBitmap.Canvas.Draw(0,0,xBmp);
FilteredBmp.Canvas.Draw(0,0,FilterBitmap);
xbmp.Free;
pbFilter.Repaint;
end;
procedure TfrmPaint.ApplyFilter;
var BB: Tbitmap;
amount: Integer;
xRect: Trect;
srgn: HRGN;
xMin,ymin,w,h: Integer;
full: Boolean;
isTrans: Boolean;
begin
if not assigned(cLayer) then exit;
isTrans := cLayer.Transparent;
sRgn := CreateSelRegion(False);
full := false;
if sRgn = 0 then begin
BB := Tbitmap.Create;
BB.Assign(cLayer.Bitmap);
full := true;
end else begin
GetrgnBox(srgn,xRect);
if (xRect.Right = xRect.Left) and (xRect.Top = xRect.Bottom) then begin
BB := Tbitmap.Create;
BB.Assign(cLayer.Bitmap);
full := true;
end else begin
BB := Tbitmap.Create;
w := xRect.Right - xRect.left;
h := xRect.bottom - xRect.top;
BB.width := w;
BB.Height := H;
xmin := MinIntValue([clayer.p1.x,clayer.p2.x,cLayer.p3.x,clayer.p4.x]);
ymin := MinIntValue([clayer.p1.y,clayer.p2.y,cLayer.p3.y,clayer.p4.y]);
Offsetrgn(sRgn,-xmin,-ymin);
GetrgnBox(srgn,xRect);
BB.canvas.copyrect(Rect(0,0,w,h),cLayer.bitmap.canvas,Rect(xRect.Left,xRect.top,xRect.left+w,xRect.top+h));
end;
end;
BB.PixelFormat := pf24bit;
amount := tbEffect.Position;
case cmbFilter.ItemIndex of
//Gaussian Blur
0: begin
if amount > 0 then GaussianBlur (BB,Amount div 10,isTrans);
end;
//Add Color Noise
1: begin
if amount > 0 then AddColorNoise (bb,amount*3,isTrans);
end;
//Antialias
2: begin
if amount = 1 then Antialias(BB,isTrans);
end;
//Contrast
3: begin
if amount > 0 then Contrast (bb,Amount*3,isTrans);
end;
//Lightness
4: begin
if amount > 0 then Lightness (BB,Amount*2,isTrans);
end;
//Darkness
5: begin
if amount > 0 then Darkness (BB,Amount*2,isTrans);
end;
//Saturation
6: begin
if amount > 0 then Saturation (BB,255-((Amount * 255) div 100),isTrans);
end;
//Mosaic
7: begin
if amount > 0 then Mosaic (BB,Amount div 2,isTrans);
end;
//Emboss
8: begin
if amount = 1 then begin
bb.width := bb.width+3;
bb.height := bb.Height+1;
bb.Canvas.StretchDraw(Rect(0,0,bb.width,bb.Height),FilterBitmap);
Emboss(BB,isTrans);
end;
end;
//Solorize
9: begin
if amount > 0 then Solorize (FilterBitmap,BB,255-((Amount * 255) div 100),isTrans);
end;
//Posterize
10: begin
if amount > 0 then Posterize (FilterBitmap,BB,((Amount * 255) div 100)+1,isTrans);
end;
//Grayscale
11: begin
if amount = 1 then Grayscale(BB,isTrans);
end;
//Invert
12: begin
if amount = 1 then PicInvert(BB,isTrans);
end;
end;
if full then begin
Clayer.Bitmap.Canvas.Draw(0,0,BB);
end else begin
SelectClipRgn(Clayer.Bitmap.Canvas.Handle,sRgn);
Clayer.Bitmap.Canvas.Draw(xRect.Left,xRect.top,BB);
SelectClipRgn(Clayer.Bitmap.Canvas.Handle,0);
end;
BB.Free;
DeleteObject(sRgn);
end;
procedure TfrmPaint.LayerFix;
var xmin,ymin,xmax,ymax: Integer;
begin
if not assigned(cLayer) then exit;
cLayer.Source.Assign(cLayer.Bitmap);
xmax := MaxIntValue([cLayer.p1.x,cLayer.p2.x,cLayer.p3.x,cLayer.p4.x]);
ymax := MaxIntValue([cLayer.p1.y,cLayer.p2.y,cLayer.p3.y,cLayer.p4.y]);
xmin := MinIntValue([cLayer.p1.x,cLayer.p2.x,cLayer.p3.x,cLayer.p4.x]);
ymin := MinIntValue([cLayer.p1.y,cLayer.p2.y,cLayer.p3.y,cLayer.p4.y]);
cLayer.p1 := Point(xmin,ymin);
cLayer.p2 := Point(xmax,ymin);
cLayer.p3 := Point(xmax,ymax);
cLayer.p4 := Point(xmin,ymax);
end;
procedure TfrmPaint.SaveToStream(mStream: Tstream);
var i: Integer;
xLayer:TBmpLayer;
xByte: Byte;
w,h:Integer;
xMin,yMin:Integer;
begin
w := buffer.Width;
h := buffer.height;
mStream.Write(w,4);
mStream.Write(h,4);
mStream.Write(layers.count,4);
for i := Layers.Count -1 downto 0 do
begin
xLayer := TBmpLayer(Layers[i]);
if xLayer.Transparent then xByte := 1 else xByte := 0;mStream.Write(xByte,1);
if xLayer.Visible then xByte := 1 else xByte := 0;mStream.Write(xByte,1);
mStream.Write(xlayer.Opaq,4);
xmin := MinIntValue([xlayer.p1.x,xlayer.p2.x,xlayer.p3.x,xlayer.p4.x]);
ymin := MinIntValue([xlayer.p1.y,xlayer.p2.y,xlayer.p3.y,xlayer.p4.y]);
mStream.Write(xMin,4);mStream.Write(yMin,4);
WriteString(mStream,xLayer.Name);
xLayer.Bitmap.SaveToStream(mStream);
end;
end;
procedure TfrmPaint.LoadFromStream(mStream: TStream);
var i: Integer;
xLayer:TBmpLayer;
xByte: Byte;
w,h:Integer;
x,y:Integer;
cnt: Integer;
vis,isTrans: Boolean;
opaq:Integer;
Bitmap: Tbitmap;
lName: String;
begin
mStream.Position := 0;
mStream.Read(w,4);
mStream.Read(h,4);
mStream.Read(cnt,4);
medit1.Text := inttostr(w);
medit2.Text := inttostr(h);
for i := 1 to cnt do
begin
mStream.Read(xByte,1);
isTrans := (xByte = 1);
mStream.Read(xByte,1);
vis := (xByte =1);
mStream.Read(opaq,4);
mStream.Read(x,4);
mStream.Read(y,4);
lname :=ReadStringFromStream(mStream);
Bitmap := Tbitmap.Create;
Bitmap.LoadFromStream(mStream);
xLayer := NewLayer(Bitmap,lName,x,y);
xLayer.Transparent := isTrans;
xLayer.Opaq := Opaq;
xLayer.Visible := vis;
end;
end;
procedure TfrmPaint.ClearSelection;
var TrColor: TColor;
sRgn: HRGN;
xrect: Trect;
xMin,ymin : Integer;
brs: HBRUSh;
begin
if not assigned(cLayer) then exit;
sRgn := CreateSelRegion(False);
if sRgn = 0 then exit;
GetrgnBox(srgn,xRect);
if (xRect.Right = xRect.Left) and (xRect.Top = xRect.Bottom) then exit;
xmin := MinIntValue([clayer.p1.x,clayer.p2.x,cLayer.p3.x,clayer.p4.x]);
ymin := MinIntValue([clayer.p1.y,clayer.p2.y,cLayer.p3.y,clayer.p4.y]);
Offsetrgn(sRgn,-xmin,-ymin);
trColor := cLayer.Bitmap.Canvas.Pixels[0,cLayer.Bitmap.Height-1];
brs := CreateSolidBrush(trColor);
FillRgn(cLayer.Bitmap.Canvas.Handle,srgn,brs);
DeleteObject(brs);
DeleteObject(srgn);
LayerFix;
CLayer.Transparent := True;
Drawbuffer;
pbox.refresh;
end;
procedure TfrmPaint.CopySelection;
var bmp: TBitmap;
Format: Word;
Data: THandle;
Palette: HPALETTE;
begin
bmp := GetSelBitmap;
if bmp = nil then exit;
OpenClipBoard(0);
bmp.SaveToClipboardFormat(Format, Data, Palette);
SetClipboardData(Format, Data);
if Palette <> 0 then SetClipboardData(CF_PALETTE, Palette);
CloseClipBoard;
bmp.Free;
end;
procedure TfrmPaint.CutSelection;
var bmp: TBitmap;
Format: Word;
Data: THandle;
Palette: HPALETTE;
begin
bmp := GetSelBitmap;
if bmp = nil then exit;
OpenClipBoard(0);
bmp.SaveToClipboardFormat(Format, Data, Palette);
SetClipboardData(Format, Data);
if Palette <> 0 then SetClipboardData(CF_PALETTE, Palette);
CloseClipBoard;
bmp.Free;
ClearSelection;
end;
procedure TfrmPaint.PasteFromCBoard;
var bmp: TBitmap;
begin
if IsClipboardFormatAvailable(CF_BITMAP) then begin
bmp := TBitmap.Create;
bmp.Assign(ClipBoard);
NewLayer(bmp,'ClipBoard Bitmap',0,0);
DrawBuffer;
pBox.refresh;
end;
end;
function TfrmPaint.GetSelBitmap: TBitmap;
var resBmp: Tbitmap;
xRect: Trect;
srgn: HRGN;
xMin,ymin,w,h: Integer;
begin
result := nil;
if not assigned(cLayer) then exit;
sRgn := CreateSelRegion(False);
if sRgn = 0 then exit;
GetrgnBox(srgn,xRect);
if (xRect.Right = xRect.Left) and (xRect.Top = xRect.Bottom) then exit;
result := Tbitmap.Create;
w := xRect.Right - xRect.left;
h := xRect.bottom - xRect.top;
result.width := w;
result.Height := h;
xmin := MinIntValue([clayer.p1.x,clayer.p2.x,cLayer.p3.x,clayer.p4.x]);
ymin := MinIntValue([clayer.p1.y,clayer.p2.y,cLayer.p3.y,clayer.p4.y]);
Offsetrgn(sRgn,-xmin,-ymin);
GetrgnBox(srgn,xRect);
Offsetrgn(sRgn,-xRect.left,-xrect.top);
SelectCliprgn(result.canvas.handle,sRgn);
result.canvas.copyrect(Rect(0,0,w,h),cLayer.bitmap.canvas,
Rect(xRect.Left,xRect.top,xRect.left+w,xRect.top+h));
SelectCliprgn(result.canvas.handle,0);
DeleteObject(srgn);
end;
{ TSelObject }
procedure TSelObject.AddPoint(pt:TPoint);
begin
pCount := pCount+1;
SetLength(points,pCount);
points[pCount-1] := pt;
end;
constructor TSelObject.Create(aType,aMode:Integer);
begin
inherited Create;
xType := aType;
cMode := aMode;
pCount := 0;
end;
Destructor destroy;
begin
SetLength(points,0);
inherited;
end;
procedure TfrmPaint.lGridMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if (mGridDown) and (abs(x- mgx) > 2) and (abs(y-mgy)> 2) then begin
mGridDown := False;
lGrid.BeginDrag(True);
end;
end;
procedure TfrmPaint.lGridMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
mGridDown := False;
end;
procedure TfrmPaint.lGridDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
if Source = Sender then Accept := True;
end;
procedure TfrmPaint.lGridDragDrop(Sender, Source: TObject; X, Y: Integer);
var acol,arow: Integer;
r1,r2: Integer;
sLayer: Pointer;
begin
if (sender = source) and (Layers.Count > 0) then
begin
lGrid.MouseToCell(x,y,acol,arow);
if arow = -1 then arow := lGrid.RowCount-1;
if arow <> Lgrid.Row then begin
r1 := LGrid.row;
r2 := arow;
if SelLayer <> -1 then begin
sLayer := Layers[SelLayer];
end;
Layers.Move(r1,r2);
if SelLayer <> -1 then selLayer := Layers.IndexOf(slayer);
LGrid.Row := aRow;
DrawBuffer;
PBox.Refresh;
lGrid.Refresh;
end;
end;
end;
procedure TfrmPaint.scmainResize(Sender: TObject);
begin
SelModified := True;
end;
procedure TfrmPaint.FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
var pt: TPoint;
begin
if (ssCtrl in Shift) and (Key = Ord('H')) then
begin
selVisible := not selVisible;
pBox.Refresh;
end else if (ssCtrl in Shift) and (Key = Ord('C')) then
begin
CopySelection;
end else if (ssCtrl in Shift) and (Key = Ord('X')) then
begin
CutSelection;
end else if (ssCtrl in Shift) and (Key = Ord('V')) then
begin
PasteFromCBoard;
end else if (Key = vk_delete) or (Key = vk_escape) then
begin
ClearSelection;
end else if (Key = vk_escape) then
begin
ClearSelObjects;
DeleteObject(SelRgn);
pbox.refresh;
end else if (CommandId = 8) and (key = vk_control) and (pbox.cursor <> crZoomp) then begin
pbox.Cursor := crZoomp;
GetCursorPos(pt);SetCursorPos(pt.x,pt.y);
end else if (CommandId = 1) and (key = vk_control) and (pbox.cursor <> crMove) then begin
pbox.Cursor := crMove;
GetCursorPos(pt);SetCursorPos(pt.x,pt.y);
end else if (CommandId in [2,3,9]) then
begin
if (key = vk_control) and (ssShift in Shift) then
begin
pBox.Cursor := crCrossm;
GetCursorPos(pt);SetCursorPos(pt.x,pt.y);
end
else if (key = vk_control) then
begin
pBox.Cursor := crCrossn;
GetCursorPos(pt);SetCursorPos(pt.x,pt.y);
end
else if (key = vk_shift) and (ssCtrl in Shift) then
begin
pBox.Cursor := crCrossp;
GetCursorPos(pt);SetCursorPos(pt.x,pt.y);
end
else if (key = vk_shift) then begin
pBox.Cursor := crCrossn;
GetCursorPos(pt);SetCursorPos(pt.x,pt.y);
end;
end;
end;
procedure TfrmPaint.scVChange(Sender: TObject);
begin
if not lockScroll then pbox.Refresh;
end;
procedure TfrmPaint.scHChange(Sender: TObject);
begin
if not lockScroll then pbox.Refresh;
end;
{ TBmpLayer }
destructor TBmpLayer.Destroy;
begin
source.free;
bitmap.free;
inherited destroy;
end;
function TBmpLayer.Duplicate: TBmpLayer;
var xlayer: TBmplayer;
begin
xLayer := TBmpLayer.Create;
xLayer.Source := TBitmap.Create;
xLayer.Source.Width := Source.Width;
xlayer.Source.Height := Source.Height;
xLayer.Source.Canvas.Draw(0,0,Source);
xLayer.Source.PixelFormat := pf24Bit;
xLayer.Bitmap := TBitmap.Create;
xLayer.Bitmap.Width := Bitmap.Width;
xlayer.Bitmap.Height := Bitmap.Height;
xLayer.Bitmap.Canvas.Draw(0,0,Bitmap);
xLayer.Bitmap.PixelFormat := pf24Bit;
xLayer.Name := Name+' Copy';
xLayer.Transparent := Transparent;
xLayer.Visible := True;
xLayer.Opaq := Opaq;
xLayer.Skewed := Skewed;
xLayer.Rotated := Rotated;
xLayer.Scaled := Scaled;
xLayer.p1 := p1;
xLayer.p2 := p2;
xLayer.p3 := p3;
xLayer.p4 := p4;
xLayer.SelMode := 0;
result := xLayer;
end;
procedure TBmpLayer.Modify(mIndex: Integer);
var tBmp: TBitmap;
x,y: Integer;
a: double;
oh,ow,h,w: Double;
np1,np2,np3,np4: TPoint;
perx,pery: Double;
xmin,ymin,xmax,ymax: Integer;
begin
ow := GetLineLenght(op1,op2);
oh := GetLineLenght(op2,op3);
x := mp1.x; y := mp1.y; ConvertPoint(x,y); np1 := Point(x,y);
x := mp2.x; y := mp2.y; ConvertPoint(x,y); np2 := Point(x,y);
x := mp3.x; y := mp3.y; ConvertPoint(x,y); np3 := Point(x,y);
x := mp4.x; y := mp4.y; ConvertPoint(x,y); np4 := Point(x,y);
w := GetLineLenght(mp1,mp2);
h := GetLineLenght(mp2,mp3);
if SelMode <> 2 then begin
p1 := np1; p2 := np2; p3 := np3; p4 := np4;
end else begin
perx := w/ow;
pery := h/oh;
if rotated then
if perx < pery then pery := perx else perx := pery;
Scale(mIndex,perx,pery);
Scaled := True;
end;
if skewed or (selmode = 3) then begin
SkewBitmap(p1,p2,p3,p4,Source,Bitmap,Transparent);
Skewed := True;
end else if rotated or (SelMode = 1) then begin
a := - GetRadOfLine(p1,p2);
if scaled then
begin
w := GetLineLenght(p1,p2);
h := GetLineLenght(p2,p3);
tBmp := TBitmap.Create;
tbmp.Height := Source.Height;
tbmp.Width := Round((Source.Height) *(w/h));
tbmp.Canvas.StretchDraw(rect(0,0,tbmp.Width,tbmp.Height),Source);
tbmp.PixelFormat := pf24Bit;
RotateBitmap(tbmp,Bitmap,a,Transparent);
xmax := MaxIntValue([p1.x,p2.x,p3.x,p4.x]);
ymax := MaxIntValue([p1.y,p2.y,p3.y,p4.y]);
xmin := MinIntValue([p1.x,p2.x,p3.x,p4.x]);
ymin := MinIntValue([p1.y,p2.y,p3.y,p4.y]);
tbmp.Width := abs(xmax-xmin);
tbmp.Height := abs(ymax-ymin);
Bitmap.Transparent := false;
tbmp.Canvas.StretchDraw(Rect(0,0,tbmp.Width,tbmp.Height),Bitmap);
tbmp.PixelFormat := pf24Bit;
tbmp.Transparent := Transparent;
Bitmap.Free;
Bitmap := tbmp;
end else
RotateBitmap(Source,Bitmap,a,Transparent);
Rotated := True;
end else if selmode = 2 then begin
Scaled := True;
tbmp := Tbitmap.Create;
tbmp.Width := abs(p2.x-p1.x);
tbmp.Height := abs(p3.y-p1.y);
Bitmap.Transparent := false;
tbmp.Canvas.StretchDraw(Rect(0,0,tbmp.Width,tbmp.Height),Source);
tbmp.PixelFormat := pf24Bit;
tbmp.Transparent := Transparent;
Bitmap.Free;
Bitmap := tbmp;
end;
end;
procedure TBmpLayer.Move(dx, dy: Integer);
begin
p1.x := p1.x+dx;
p2.x := p2.x+dx;
p3.x := p3.x+dx;
p4.x := p4.x+dx;
p1.y := p1.y+dy;
p2.y := p2.y+dy;
p3.y := p3.y+dy;
p4.y := p4.y+dy;
end;
Function SkewBitmap(p1,p2,p3,p4: TPoint; pic: TBitmap; var ResultBmp: TBitmap;isTrans:Boolean): Boolean;
var i,k: Integer;
RowOriginal : pRGBArray;
RowRotated : pRGBArray;
pa,pb: TDoublePoint;
px: Tpoint;
bRect: Trect;
x,y,h,w: Integer;
CalCPoints: array of array of TPoint;
begin
Screen.Cursor := crHourGlass;
if (p1.x = p4.x) and (p2.x = p3.x) and (p1.y = p2.y) and (p4.y = p3.y) then
begin
ResultBmp.Width := pic.width;
ResultBmp.Height := pic.Height;
ResultBmp.PixelFormat := pf24bit;
Resultbmp.Canvas.Draw(0,0,pic);
ResultBmp.Transparent := isTrans;
Screen.Cursor := crDefault;
exit;
end;
bRect.TopLeft := p1;
bRect.BottomRight := p3;
if p1.x < bRect.Left then bRect.Left := p1.x;
if p2.x < bRect.Left then bRect.Left := p2.x;
if p3.x < bRect.Left then bRect.Left := p3.x;
if p4.x < bRect.Left then bRect.Left := p4.x;
if p1.x > bRect.Right then bRect.Right := p1.x;
if p2.x > bRect.Right then bRect.Right := p2.x;
if p3.x > bRect.Right then bRect.Right := p3.x;
if p4.x > bRect.Right then bRect.Right := p4.x;
if p1.y < bRect.top then bRect.top := p1.y;
if p2.y < bRect.top then bRect.top := p2.y;
if p3.y < bRect.top then bRect.top := p3.y;
if p4.y < bRect.top then bRect.top := p4.y;
if p1.y > bRect.bottom then bRect.bottom := p1.y;
if p2.y > bRect.bottom then bRect.bottom := p2.y;
if p3.y > bRect.bottom then bRect.bottom := p3.y;
if p4.y > bRect.bottom then bRect.bottom := p4.y;
ResultBmp.Width := bRect.right-bRect.left;
ResultBmp.Height := bRect.bottom-bRect.top;
ResultBmp.PixelFormat := pf24bit;
//if isTrans then begin
ResultBmp.Canvas.Brush.Color := pic.Canvas.Pixels[0,pic.Height-1];
ResultBmp.Canvas.Brush.Style := bsSolid;
ResultBmp.Canvas.FillRect(Rect(0,0,ResultBmp.Width,ResultBmp.Height));
//end;
SetLength(CalcPoints,ResultBmp.Width);
for i := 0 to ResultBmp.Width-1 do begin
SetLength(CalcPoints[i],ResultBmp.Height);
for k := 0 to ResultBmp.Height-1 do CalcPoints[i,k] := Point(-1,-1);
end;
for i := 0 to pic.Height-1 do
begin
pa := GetLineSegmentPoint(p1,p4,(i/(pic.Height-1)));
pb := GetLineSegmentPoint(p2,p3,(i/(pic.Height-1)));
for k := 0 to pic.Width-1 do
begin
px := DP2P(GetLineSegmentPoint(pa,pb,(k/(pic.Width-1))));
px.x := px.x-bRect.left;
px.y := px.y-bRect.top;
if px.y < 0 then px.y := 0;
if px.y > ResultBmp.Height-1 then px.y := ResultBmp.Height-1;
if px.x < 0 then px.x := 0;
if px.x > ResultBmp.Width-1 then px.x := ResultBmp.Width-1;
CalcPoints[px.x,px.y] := Point(k,i);
end;
end;
h := ResultBmp.Height-1;
w := ResultBmp.Width-1;
for i := 0 to ResultBmp.Height -1 do
begin
RowRotated := ResultBmp.Scanline[i];
for k := 0 to ResultBmp.Width -1 do
begin
px := CalcPoints[k,i];
if (px.y = -1) and (i > 0) then px := CalcPoints[k,i-1];
if (px.y = -1) and (k > 0) then px := CalcPoints[k-1,i];
if (px.y = -1) and (k > 0) and (i > 0) then px := CalcPoints[k-1,i-1];
if (px.y = -1) and (i < h) then px := CalcPoints[k,i+1];
if (px.y = -1) and (k < w) then px := CalcPoints[k+1,i];
if (px.y = -1) and (k < w) and (i < h) then px := CalcPoints[k+1,i+1];
if (px.y = -1) and (k < w) and (i > 0) then px := CalcPoints[k+1,i-1];
if (px.y = -1) and (k > 0) and (i < h) then px := CalcPoints[k-1,i+1];
if (px.y <> -1) then
begin
RowOriginal := pic.ScanLine[px.y];
RowRotated[k] := RowOriginal[px.x];
end;
end;
end;
ResultBmp.Transparent := isTrans;
Screen.Cursor := crDefault;
end;
Procedure RotateBitmap(var BitmapOriginal,BitmapRotated: TBitmap; Teta: Double; isTrans: Boolean);
VAR
cosTheta : DOUBLE;
i : INTEGER;
iRotationAxis : INTEGER;
iOriginal : INTEGER;
iPrime : INTEGER;
iPrimeRotated : INTEGER;
j : INTEGER;
jRotationAxis : INTEGER;
jOriginal : INTEGER;
jPrime : INTEGER;
jPrimeRotated : INTEGER;
RowOriginal : pRGBArray;
RowRotated : pRGBArray;
sinTheta : DOUBLE;
Theta : DOUBLE; // radians
OldHeight : integer;
OldWidth : integer;
NewWidth : integer;
NewHeight : integer;
NB : INTEGER;
NG : INTEGER;
NR : INTEGER;
add: integer;
begin
RowOriginal := BitmapOriginal.Scanline[0];
NB:=RowOriginal[0].rgbtBlue;
NG:=RowOriginal[0].rgbtGreen;
NR:=RowOriginal[0].rgbtRed;
Theta := teta;
sinTheta := SIN(Theta);
cosTheta := COS(Theta);
OldWidth := BitmapOriginal.Width;
OldHeight := BitmapOriginal.Height;
NewWidth := abs(round(OldHeight * sinTheta)) + abs(round(OldWidth *cosTheta));
NewHeight := abs(round(OldWidth * sinTheta)) + abs(round(OldHeight *cosTheta));
BitmapRotated.Width := NewWidth;
BitmapRotated.Height := NewHeight;
BitmapRotated.PixelFormat := pf24bit;
iRotationAxis := OldWidth div 2;
jRotationAxis := OldHeight div 2;
// Step through each row of rotated image.
FOR j := BitmapRotated.Height-1 DOWNTO 0 DO
BEGIN
RowRotated := BitmapRotated.Scanline[j];
jPrime := 2*(j - (NewHeight - OldHeight) div 2 - jRotationAxis) + 1 ;
FOR i := BitmapRotated.Width-1 DOWNTO 0 DO
BEGIN
// offset origin by the growth factor (NewWidth - OldWidth) div 2
iPrime := 2*(i - (NewWidth - OldWidth) div 2 - iRotationAxis) + 1;
iPrimeRotated := ROUND(iPrime * CosTheta - jPrime * sinTheta);
jPrimeRotated := ROUND(iPrime * sinTheta + jPrime * cosTheta);
// Transform back to pixel coordinates of image, including translation
// of origin from axis of rotation to origin of image.
iOriginal := (iPrimeRotated - 1) DIV 2 + iRotationAxis;
jOriginal := (jPrimeRotated - 1) DIV 2 + jRotationAxis;
// Make sure (iOriginal, jOriginal) is in BitmapOriginal. If not,
// assign blue color to corner points.
IF (iOriginal >= 0) AND (iOriginal <= BitmapOriginal.Width-1) AND
(jOriginal >= 0) AND (jOriginal <= BitmapOriginal.Height-1)
THEN BEGIN
// Assign pixel from rotated space to current pixel in BitmapRotated
RowOriginal := BitmapOriginal.Scanline[jOriginal];
RowRotated[i] := RowOriginal[iOriginal]
END
ELSE BEGIN
//if isTrans then add := 0 else add := 100;
add := 0;
RowRotated[i].rgbtBlue := NB+add; // assign "corner" color
RowRotated[i].rgbtGreen := NG+add;
RowRotated[i].rgbtRed := NR+add;
END
END
END;
END;
Function RotatePoint(cpoint, opoint: Tpoint; ang: real):TPoint;
var p:Tpoint;
begin
oPoint := Point (oPoint.x-cpoint.x,oPoint.y-cPoint.y);
p.y := round(oPoint.x * sin(ang) + oPoint.y*cos(ang));
p.x := round(oPoint.x * cos(ang) - oPoint.y*sin(ang));
p := Point(p.x+cpoint.x,p.y+cpoint.y);
result := p;
end;
Function ScalePoint(cpoint, opoint: Tpoint; px,py: real):TPoint;
var respoint: TPoint;
deltax,deltay : double;
begin
if px = 1 then begin
respoint.x := oPoint.x;
end else begin
deltax := cPoint.x - oPoint.x;
deltax := deltax * px;
respoint.x := Round(cpoint.x - deltax);
end;
if py = 1 then begin
respoint.y := oPoint.y;
end else begin
deltay := cPoint.y - oPoint.y;
deltay := deltay * py;
respoint.y := Round(cpoint.y - deltay);
end;
result := respoint;
end;
Function MPoint(p1,p2:TPoint):TPoint;
begin
Result := Point((p1.x+p2.x)div 2,(p1.y+p2.y) div 2);
end;
Function MVPoint(p:TPoint;dy:Integer):TPoint;
begin
Result := Point(p.x,p.y+dy);
end;
Function MHPoint(p:TPoint;dx:Integer):TPoint;
begin
Result := Point(p.x+dx,p.y);
end;
Function MXPoint(p:TPoint;dx,dy:Integer):TPoint;
begin
Result := Point(p.x+dx,p.y+dy);
end;
Function DP2P(pt:TDoublepoint):TPoint;
begin
Result := Point(Round(pt.x),Round(pt.y));
end;
function GetLineLenght(p1,p2: TPoint):Real;
begin
result := sqrt(sqr(p1.x - p2.x)+sqr(p1.y - p2.y));
end;
Function ReadStringFromStream(stream:TStream):String;
var xByte: Byte;
res:string;
begin
xByte := 0;
res := '';
repeat
stream.Read(xByte,1);
if xByte <> 0 then res := res+ chr(xByte);
until xByte = 0;
result := res;
end;
Procedure WriteString(Stream:TStream; str:string);
var xByte: Byte;
begin
xByte := 0;
Stream.Write(pchar(str)^,length(str));
Stream.Write(xByte,1);
end;
Function GetLineSegmentPoint(p1,p2:TPoint; ratio: double):TDoublePoint;overload;
var a,l: double;
dx,dy,dx0,dy0: double;
begin
l := sqrt(sqr(p1.x - p2.x)+sqr(p1.y - p2.y));
if l > 0 then begin
dx := p2.x-p1.x;
dy := p2.y-p1.y;
a := ratio*l;
dx0 := (a*dx)/l;
dy0 := (a*dy)/l;
end else begin
dx0 := 0;
dy0 := 0;
end;
result.x := p1.x+dx0;
result.y := p1.y+dy0;
end;
Function GetLineSegmentPoint(p1,p2:TDoublePoint; ratio: double):TDoublePoint;
var a,l: double;
dx,dy,dx0,dy0: double;
begin
l := sqrt(sqr(p1.x - p2.x)+sqr(p1.y - p2.y));
if l > 0 then begin
dx := p2.x-p1.x;
dy := p2.y-p1.y;
a := ratio*l;
dx0 := (a*dx)/l;
dy0 := (a*dy)/l;
end else begin
dx0 := 0;
dy0 := 0;
end;
result.x := p1.x+dx0;
result.y := p1.y+dy0;
end;
Function GetRadOfLine(cp,p: TPoint):Real;
var dx,dy: integer;
ang: real;
reg:integer;
Begin
dx := abs(p.x - cp.x);
dy := abs(p.y - cp.y);
if (dx=0) and (dy=0) then // error
begin
result := 0;
exit;
end;
if dx = 0 then
begin
if p.y > cp.y then result := pi/2
else result := pi*1.5;
end
else if dy = 0 then
begin
if p.x > cp.x then result := 0
else result := pi;
end
else
begin
ang := arctan(dy/dx);
if (p.x > cp.x) and (p.y > cp.y) then begin
ang := ang; reg := 1; end
else if (p.x < cp.x) and (p.y > cp.y) then begin
ang := PI - ang; reg := 2; end
else if (p.x < cp.x) and (p.y < cp.y) then begin
ang := PI + ang; reg := 3; end
else if (p.x > cp.x) and (p.y < cp.y) then begin
ang := 2*PI - ang; reg := 4; end;
Result := ang;
end;
end;
procedure TBmpLayer.Scale(mIndex: Integer; perx, pery: Double);
var cp: TPoint;
begin
//**
Case mIndex of
1: cp := p3;
2: cp := p4;
3: cp := p1;
4: cp := p2;
end;
p1 := ScalePoint(cp,p1,perx,pery);
p2 := ScalePoint(cp,p2,perx,pery);
p3 := ScalePoint(cp,p3,perx,pery);
p4 := ScalePoint(cp,p4,perx,pery);
end;
procedure TfrmPaint.lb6Click(Sender: TObject);
var xlayer: TBmPlayer;
slayer: Pointer;
begin
if not assigned(clayer) then exit;
if SelLayer <> -1 then sLayer := Layers[SelLayer];
xLayer := CLayer.Duplicate;
Layers.Insert(Layers.IndexOf(cLayer),xLayer);
lGrid.RowCount := layers.count;
lGrid.Row := Layers.IndexOf(xlayer);
if SelLayer <> -1 then SelLayer := Layers.IndexOf(slayer);
ShowLayerOptions;
DrawBuffer;
pbox.refresh;
end;
procedure TfrmPaint.lb7Click(Sender: TObject);
var xlayer: TBmPlayer;
slayer: Pointer;
index: Integer;
begin
if not assigned(clayer) then exit;
if SelLayer <> -1 then sLayer := Layers[SelLayer];
index := Layers.IndexOf(clayer);
if sLayer = cLayer then SelLayer := -1;
Layers.Remove(cLayer);
lGrid.RowCount := lGrid.RowCount-1;
cLayer.Free;
if (Index >= Layers.Count) then Index := Layers.Count-1;
if Layers.Count > 0 then lGrid.Row := Index;
if SelLayer <> -1 then SelLayer := Layers.IndexOf(slayer);
ShowLayerOptions;
DrawBuffer;
pbox.refresh;
lgrid.Refresh;
end;
procedure TfrmPaint.lb5Click(Sender: TObject);
begin
BlankLayer;
end;
procedure TfrmPaint.lb8Click(Sender: TObject);
begin
FlattenImage;
end;
procedure TfrmPaint.lb9Click(Sender: TObject);
begin
MergeVisible;
end;
procedure TfrmPaint.bGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var xrect: TRect;
w,h: Integer;
procedure DrawRect(sz: Integer);
var d: Integer;
begin
d := (w - sz) div 2;
xRect := classes.Rect(rect.left+d,rect.top+d,rect.left+d+sz,rect.top+d+sz);
bGrid.Canvas.Rectangle(xRect);
end;
procedure DrawCircle(sz: Integer);
var d: Integer;
begin
d := (w - sz) div 2;
xRect := classes.Rect(rect.left+d,rect.top+d,rect.left+d+sz,rect.top+d+sz);
bGrid.Canvas.Ellipse(xRect);
end;
begin
if gdSelected in State then
bGrid.Canvas.Brush.Color := clRed
else
bGrid.Canvas.Brush.Color := clWhite;
bGrid.Canvas.Brush.Style := bsSolid;
bGrid.Canvas.FillRect(Rect);
w := 22; h := 22;
bGrid.Canvas.Brush.Color := $00FF6464;
bGrid.Canvas.Brush.Style := bsSolid;
bGrid.Canvas.pen.Style := psSolid;
bGrid.Canvas.pen.Width := 1;
bGrid.Canvas.pen.Color := $00FF6464;;
if arow = 0 then begin
DrawRect(acol+3);
end else if arow = 1 then begin
DrawRect(acol+11);
end else if arow = 2 then begin
DrawCircle(acol+3);
end else if arow = 3 then begin
DrawCircle(acol+11);
end;
end;
procedure TfrmPaint.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var pt: TPoint;
begin
if (CommandId = 8) and (key = vk_control) and (pbox.cursor <> crZoomm) then
begin
pbox.Cursor := crZoomm;
GetCursorPos(pt);SetCursorPos(pt.x,pt.y);
end else if (CommandId = 1) and (key = vk_control) and (pbox.cursor <> crMoves) then
begin
pbox.Cursor := crMoveS;
GetCursorPos(pt);SetCursorPos(pt.x,pt.y);
end else if (CommandId in [2,3,9]) and (key = vk_control) and (pbox.cursor <> crCrossp) then
begin
pbox.Cursor := crCrossp;
GetCursorPos(pt);SetCursorPos(pt.x,pt.y);
end else if (CommandId in [2,3,9]) and (key = vk_shift) and (pbox.cursor <> crCrossm) then
begin
pbox.Cursor := crCrossm;
GetCursorPos(pt);SetCursorPos(pt.x,pt.y);
end;
end;
procedure TfrmPaint.mEdit1KeyPress(Sender: TObject; var Key: Char);
begin
if not (((Key >= '0') and (Key <= '9')) or
(Key = chr(8)) or (key = Chr(13)))
then begin
Key := Chr(0);
beep;
end;
end;
procedure TfrmPaint.pcChange(Sender: TObject);
begin
if pc.ActivePageIndex = 0 then begin
pc.Height := 110;
end else if pc.ActivePageIndex = 1 then begin
pc.Height := 360;
end else if pc.ActivePageIndex = 2 then begin
pc.Height := 180;
end else if pc.ActivePageIndex = 3 then begin
pc.Height := 185;
end;
end;
procedure TfrmPaint.pbFilterPaint(Sender: TObject);
var w,h,x,y: Integer;
begin
pbFilter.Canvas.Draw(0,0,FilteredBmp);
end;
procedure TfrmPaint.cmbFilterChange(Sender: TObject);
begin
RedrawFilter;
tbEffect.Min := 0;
tbEffect.Max := 100;
tbEffect.Position := 0;
case cmbFilter.ItemIndex of
//Gaussian Blur
0: begin
tbEffect.Max := 5;
end;
//Add Color Noise
1: begin
end;
//Antialias
2: begin
tbEffect.Max := 1;
end;
//Contrast
3: begin
end;
//Lightness
4: begin
end;
//Darkness
5: begin
end;
//Saturation
6: begin
end;
//Mosaic
7: begin
end;
//Emboss
8: begin
tbEffect.Max := 1;
end;
//Solorize
9: begin
end;
//Posterize
10: begin
end;
//Grayscale
11: begin
tbEffect.Max := 1;
end;
//Invert
12: begin
tbEffect.Max := 1;
end;
end;
end;
procedure TfrmPaint.tbEffectChange(Sender: TObject);
var BB: Tbitmap;
amount: Integer;
begin
BB := TBitmap.Create;
BB.Assign (FilterBitmap);
BB.PixelFormat := pf24bit;
amount := tbEffect.Position;
case cmbFilter.ItemIndex of
//Gaussian Blur
0: begin
if amount > 0 then GaussianBlur (BB,Amount div 10,false);
end;
//Add Color Noise
1: begin
if amount > 0 then AddColorNoise (bb,amount*3,false);
end;
//Antialias
2: begin
if amount = 1 then Antialias(BB,false);
end;
//Contrast
3: begin
if amount > 0 then Contrast (bb,Amount*3,false);
end;
//Lightness
4: begin
if amount > 0 then Lightness (BB,Amount*2,false);
end;
//Darkness
5: begin
if amount > 0 then Darkness (BB,Amount*2,false);
end;
//Saturation
6: begin
if amount > 0 then Saturation (BB,255-((Amount * 255) div 100),false);
end;
//Mosaic
7: begin
if amount > 0 then Mosaic (BB,Amount div 2,false);
end;
//Emboss
8: begin
if amount = 1 then begin
bb.width := bb.width+3;
bb.height := bb.Height+1;
bb.Canvas.StretchDraw(Rect(0,0,bb.width,bb.Height),FilterBitmap);
Emboss(BB,false);
end;
end;
//Solorize
9: begin
if amount > 0 then Solorize (FilterBitmap,BB,255-((Amount * 255) div 100),false);
end;
//Posterize
10: begin
if amount > 0 then Posterize (FilterBitmap,BB,((Amount * 255) div 100)+1,false);
end;
//Grayscale
11: begin
if amount = 1 then Grayscale(BB,false);
end;
//Invert
12: begin
if amount = 1 then PicInvert(BB,false);
end;
end;
SelectClipRgn(FilteredBmp.Canvas.Handle,FilterRgn);
FilteredBmp.Canvas.Draw(0,0,BB);
BB.Free;
pbFilter.repaint;
end;
procedure TfrmPaint.Button2Click(Sender: TObject);
begin
ApplyFilter;
LayerFix;
DrawBuffer;
pbox.refresh;
end;
procedure TfrmPaint.lb10Click(Sender: TObject);
begin
InsertBitmap;
end;
procedure TfrmPaint.SpeedButton1Click(Sender: TObject);
begin
modalresult := mrok;
end;
procedure TfrmPaint.SpeedButton2Click(Sender: TObject);
begin
modalresult := mrcancel;
end;
procedure TfrmPaint.ToolButton2Click(Sender: TObject);
begin
CopySelection;
end;
procedure TfrmPaint.ToolButton5Click(Sender: TObject);
begin
ClearSelection;
end;
procedure TfrmPaint.ToolButton3Click(Sender: TObject);
begin
CutSelection;
end;
procedure TfrmPaint.ToolButton4Click(Sender: TObject);
begin
PastefromCBoard;
end;
procedure TfrmPaint.FormDestroy(Sender: TObject);
begin
if assigned(buffer) then buffer.free;
end;
end.
Reference in New Issue View Git Blame Copy Permalink