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.