From ec9f1ff081f78c877981aa0d270a83ca9e6e6b70 Mon Sep 17 00:00:00 2001 From: wp Date: Thu, 18 May 2017 20:53:49 +0000 Subject: [PATCH] GridExamples: Add demo for embedding images into a grid git-svn-id: trunk@54978 - --- .gitattributes | 4 + .../gridexamples/embedded_images/images.lpi | 78 ++++ .../gridexamples/embedded_images/images.lpr | 21 + .../gridexamples/embedded_images/imgmain.lfm | 117 +++++ .../gridexamples/embedded_images/imgmain.pas | 420 ++++++++++++++++++ 5 files changed, 640 insertions(+) create mode 100644 examples/gridexamples/embedded_images/images.lpi create mode 100644 examples/gridexamples/embedded_images/images.lpr create mode 100644 examples/gridexamples/embedded_images/imgmain.lfm create mode 100644 examples/gridexamples/embedded_images/imgmain.pas diff --git a/.gitattributes b/.gitattributes index a5cdf52f02..8a932fa27d 100644 --- a/.gitattributes +++ b/.gitattributes @@ -5670,6 +5670,10 @@ examples/gridexamples/columneditors/main.pas svneol=native#text/plain examples/gridexamples/columneditors/readme.txt svneol=native#text/plain examples/gridexamples/columneditors/stringgrideditor.lpi svneol=native#text/plain examples/gridexamples/columneditors/stringgrideditor.lpr svneol=native#text/plain +examples/gridexamples/embedded_images/images.lpi svneol=native#text/plain +examples/gridexamples/embedded_images/images.lpr svneol=native#text/plain +examples/gridexamples/embedded_images/imgmain.lfm svneol=native#text/plain +examples/gridexamples/embedded_images/imgmain.pas svneol=native#text/plain examples/gridexamples/grid_semaphor/TSemaphorDBGrid.xpm -text svneol=native#image/x-xpixmap examples/gridexamples/grid_semaphor/example/project1.lpi svneol=native#text/plain examples/gridexamples/grid_semaphor/example/project1.lpr svneol=native#text/pascal diff --git a/examples/gridexamples/embedded_images/images.lpi b/examples/gridexamples/embedded_images/images.lpi new file mode 100644 index 0000000000..e62a20400b --- /dev/null +++ b/examples/gridexamples/embedded_images/images.lpi @@ -0,0 +1,78 @@ + + + + + + + + + + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + </General> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="LCL"/> + </Item1> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="images.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="imgmain.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="imgMain"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="images"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Debugging> + <UseExternalDbgSyms Value="True"/> + </Debugging> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/examples/gridexamples/embedded_images/images.lpr b/examples/gridexamples/embedded_images/images.lpr new file mode 100644 index 0000000000..1042eb11f4 --- /dev/null +++ b/examples/gridexamples/embedded_images/images.lpr @@ -0,0 +1,21 @@ +program images; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, imgMain + { you can add units after this }; + +{$R *.res} + +begin + RequireDerivedFormResource := True; + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/examples/gridexamples/embedded_images/imgmain.lfm b/examples/gridexamples/embedded_images/imgmain.lfm new file mode 100644 index 0000000000..71f4a2f684 --- /dev/null +++ b/examples/gridexamples/embedded_images/imgmain.lfm @@ -0,0 +1,117 @@ +object Form1: TForm1 + Left = 280 + Height = 569 + Top = 130 + Width = 861 + Caption = 'Form1' + ClientHeight = 569 + ClientWidth = 861 + OnCreate = FormCreate + LCLVersion = '1.9.0.0' + object Panel1: TPanel + Left = 0 + Height = 36 + Top = 510 + Width = 861 + Align = alBottom + ClientHeight = 36 + ClientWidth = 861 + TabOrder = 0 + object Button1: TButton + Left = 9 + Height = 25 + Top = 4 + Width = 246 + AutoSize = True + Caption = 'Load new image && anchor at selected cell' + OnClick = Button1Click + TabOrder = 0 + end + object SpinEdit1: TSpinEdit + AnchorSideLeft.Control = Label2 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Button1 + AnchorSideTop.Side = asrCenter + Left = 490 + Height = 23 + Top = 5 + Width = 74 + Alignment = taRightJustify + BorderSpacing.Left = 8 + MinValue = -100 + TabOrder = 1 + end + object SpinEdit2: TSpinEdit + AnchorSideLeft.Control = Label3 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Button1 + AnchorSideTop.Side = asrCenter + Left = 594 + Height = 23 + Top = 5 + Width = 80 + Alignment = taRightJustify + BorderSpacing.Left = 8 + MinValue = -100 + TabOrder = 2 + end + object Label1: TLabel + AnchorSideLeft.Control = Button1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Button1 + AnchorSideTop.Side = asrCenter + Left = 271 + Height = 15 + Top = 9 + Width = 190 + BorderSpacing.Left = 16 + Caption = 'Image offset with respect to anchor:' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = Label1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label1 + Left = 477 + Height = 15 + Top = 9 + Width = 5 + BorderSpacing.Left = 16 + Caption = 'x' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = SpinEdit1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Button1 + AnchorSideTop.Side = asrCenter + Left = 580 + Height = 15 + Top = 9 + Width = 6 + BorderSpacing.Left = 16 + Caption = 'y' + ParentColor = False + end + end + object StatusBar1: TStatusBar + Left = 0 + Height = 23 + Top = 546 + Width = 861 + Panels = <> + end + object Panel2: TPanel + Left = 0 + Height = 26 + Top = 0 + Width = 861 + Align = alTop + Caption = 'Hold CTRL down and drag the images with the left mouse button to a new location' + TabOrder = 2 + end + object OpenDialog1: TOpenDialog + left = 137 + top = 93 + end +end diff --git a/examples/gridexamples/embedded_images/imgmain.pas b/examples/gridexamples/embedded_images/imgmain.pas new file mode 100644 index 0000000000..7808e8d484 --- /dev/null +++ b/examples/gridexamples/embedded_images/imgmain.pas @@ -0,0 +1,420 @@ +unit imgMain; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Grids, + ExtCtrls, StdCtrls, LMessages, Spin, ComCtrls; + +type + { TImageData is stored in the list FImageList of the modified string grid and + contains the image bitmap as well information on the position of the image. } + TImageData = class + Bitmap: TBitmap; // Bitmap to be overlayed + Col, Row: Integer; // Anchor of the bitmap in the grid + dx, dy: Integer; // Offset with respect to anchor, in pixels + destructor Destroy; override; + end; + + { Events for image clicking and moving } + TImageClickEvent = procedure(Sender: TObject; AShift: TShiftState; + AImageIndex, X, Y: Integer) of object; + TImageMoveEvent = procedure(Sender: TObject; AShift: TShiftState; + AImageIndex, dx, dy: Integer) of object; + + { Modified StringGrid with support of embedded images } + TStringGridEx = class(TStringGrid) + private + FImageList: TFPlist; + FMouseImgIndex: Integer; + FMouseDownPt: TPoint; + FOnImageClick: TImageCLickEvent; + FOnImageMove: TImageMoveEvent; + protected + procedure DoImageClick(Shift: TShiftState; X, Y: Integer); virtual; + procedure DoImageMove(Shift: TShiftState; dx, dy: Integer); virtual; + procedure DrawAllRows; override; + procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override; + procedure MouseMove(Shift: TShiftState; X,Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override; + procedure WMHScroll(var message : TLMHScroll); message LM_HSCROLL; + procedure WMVScroll(var message : TLMVScroll); message LM_VSCROLL; + + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure AddImage(APicture: TPicture; ACol, ARow: Integer; dx, dy: Integer; + AWidth: Integer = 0); + function GetImageRect(AImageIndex: Integer): TRect; + procedure MoveImageBy(AImageIndex, dx, dy: Integer); + function PointInImage(APoint: TPoint): Integer; + procedure UpdateImageAnchor(AImageIndex: Integer); + + published + property OnImageClick: TImageClickEvent read FOnImageClick write FOnImageClick; + property OnImageMove: TImageMoveEvent read FOnImageMove write FOnImageMove; + end; + +type + + { TForm1 } + + TForm1 = class(TForm) + Button1: TButton; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + OpenDialog1: TOpenDialog; + Panel1: TPanel; + Panel2: TPanel; + SpinEdit1: TSpinEdit; + SpinEdit2: TSpinEdit; + StatusBar1: TStatusBar; + procedure Button1Click(Sender: TObject); + procedure FormCreate(Sender: TObject); + private + Grid: TStringGridEx; + procedure AddImageFromFile(AFileName: String; ACol, ARow: Integer; + dx, dy: Integer; AScaledSize: Integer = 0); + procedure ImageClickHandler(Sender: TObject; Shift: TShiftState; + AImageIndex, X, Y: Integer); + procedure ImageMoveHandler(Sender: TObject; Shift: TShiftState; + AImageIndex, dX, dY: Integer); + + public + + end; + +var + Form1: TForm1; + +implementation + +{$R *.lfm} + +uses + Types, LCLIntf; + +const + JPEG_FILE = '../../../images/splash_source/cheetah.jpg'; + PNG_FILE1 = '../../../images/codetoolsdefines/da_block.png'; + PNG_FILE2 = '../../../images/icons/lazarus256x256.png'; + +{ TForm1 } + +procedure TForm1.AddImageFromFile(AFileName: String; ACol, ARow, dx, dy: Integer; + AScaledSize: Integer = 0); +// AScaledSize = 0 means: no size scaling +var + pic: TPicture; +begin + pic := TPicture.Create; + try + pic.LoadFromFile(AFileName); + Grid.AddImage(pic, ACol, ARow, dx, dy, AScaledSize); + finally + pic.Free; + end; +end; + +procedure TForm1.Button1Click(Sender: TObject); +begin + if OpenDialog1.Execute then + AddImageFromFile(OpenDialog1.FileName, Grid.Col, Grid.Row, SpinEdit1.Value, SpinEdit2.Value); +end; + +procedure TForm1.FormCreate(Sender: TObject); +var + i: Integer; +begin + Grid := TStringGridEx.Create(self); + Grid.Parent := self; + Grid.Align := alClient; + Grid.RowCount := 13; //100; + Grid.ColCount := 10; //30; + Grid.Options := Grid.Options + [goThumbTracking, goColSizing, goRowSizing, goEditing]; + Grid.MouseWheelOption := mwGrid; + Grid.Col := 3; + Grid.Row := 16; + Grid.OnImageClick := @ImageClickHandler; + Grid.OnImageMove := @ImageMoveHandler; + + for i:=1 to Grid.ColCount-1 do + Grid.Cells[i, 0] := 'column ' + IntToStr(i); + for i:=1 to Grid.RowCount-1 do + Grid.Cells[0, i] := 'row ' + IntToStr(i); + + ActiveControl := Grid; + + // col row dx dy width + AddImageFromFile(JPEG_FILE, 1, 1, 5, 5, 300); // Offset by 5 pixels, scaled to width 300 + AddImageFromFile(PNG_FILE1, 2, 12, 0, 0); + AddImageFromFile(PNG_FILE2, 5, 2, 0, 0); +end; + +procedure TForm1.ImageClickHandler(Sender: TObject; Shift: TShiftState; + AImageIndex, X, Y: Integer); +begin + Statusbar1.SimpleText := Format('Image #%d clicked at x = %d, y = %d', [AImageIndex, X, Y]); +end; + +procedure TForm1.ImageMoveHandler(Sender: TObject; Shift: TShiftState; + AImageIndex, dX, dY: Integer); +begin + if [ssLeft, ssCtrl] * Shift = [ssLeft, ssCtrl] then begin + // Moves the image by dx, dy pixels + Grid.MoveImageBy(AImageIndex, dx, dy); + // Resets the image anchor such that the top-left image corner is contained + // in the anchor cell. + Grid.UpdateImageAnchor(AImageIndex); + end; +end; + + +{ TImageData } + +destructor TImageData.Destroy; +begin + Bitmap.Free; + inherited; +end; + + +{ Modified TStringGrid } + +constructor TStringGridEx.Create(AOwner: TComponent); +begin + inherited; + FImageList := TFPList.Create; +end; + +destructor TStringGridEx.Destroy; +var + j: Integer; +begin + for j:=0 to FImageList.Count-1 do + TImageData(FImageList[j]).Free; + FImageList.Free; + inherited; +end; + +{ Adds a new image to the image list. ACol and ARow indicate the column and + row index of the anchor cell to which the image is attached. If the left or + top edge of the anchor cell is moved then the image follows. The image can + be shifted by dx and dy pixels from the top left corner of the anchor cell. + AWidth defines the width of the image in pixels; the image is automatically + rescaled. If AWidth is missing (or 0) the original size of the image is used.} +procedure TStringGridEx.AddImage(APicture: TPicture; ACol, ARow: Integer; + dx, dy: Integer; AWidth: Integer = 0); +var + bmp: TBitmap; + imgdata: TImageData; +begin + bmp := TBitmap.Create; + if AWidth <= 0 then begin + // Keep original image size + bmp.Width := APicture.Width; + bmp.Height := APicture.Height; + end else begin + // Scale image + bmp.Width := AWidth; + bmp.Height := round(bmp.Width / APicture.Width * APicture.Height); + end; + bmp.PixelFormat := pf32Bit; + bmp.Canvas.Brush.Color := clWhite; + bmp.Canvas.FillRect(0, 0, bmp.Width, bmp.Height); + bmp.Canvas.StretchDraw(Rect(0, 0, bmp.Width, bmp.Height), APicture.Graphic); + + imgData := TImageData.Create; + imgData.Bitmap := bmp; + imgData.Col := ACol; + imgData.Row := ARow; + imgData.dx := dx; + imgData.dy := dy; + FImageList.Add(imgData); + + Invalidate; +end; + +procedure TStringGridEx.DoImageClick(Shift: TShiftState; X, Y: Integer); +begin + if Assigned(FOnImageClick) then + FOnImageClick(self, Shift, FMouseImgIndex, X, Y); +end; + +procedure TStringGridEx.DoImageMove(Shift: TShiftState; dx, dy: Integer); +begin + if Assigned(FOnImageMove) then + FOnImageMove(self, Shift, FMouseImgIndex, dx, dy); +end; + +procedure TStringGridEx.DrawAllRows; +var + imgdata: TImagedata; + i: Integer; + clipArea: TRect; + ImgRect: TRect; + R: TRect; + tmp: Integer; +begin + inherited; + + // Calculate the clip area, i.e. the rectangle enclosing the non-fixed cells... + clipArea := Canvas.ClipRect; + ColRowToOffset(true, false, FixedCols, clipArea.Left, tmp); + ColRowToOffset(false, false, FixedRows, clipArea.Top, tmp); + + Canvas.SaveHandleState; + try + // ... and use it for clipping + IntersectClipRect(Canvas.Handle, clipArea.Left, clipArea.Top, clipArea.Right, clipArea.Bottom); + + for i := 0 to FImageList.Count-1 do begin + // Get bounding rectangle of the image + imgRect := GetImageRect(i); + + // Calculate the intersection of the image rectangle with the clip rectangle + // Nothing to do if the image rectangle does not intersect the clip rectangle + if not IntersectRect(R, clipArea, imgRect) then + continue; + + imgdata := TImageData(FImageList[i]); + Canvas.Draw(imgRect.Left, imgRect.Top, imgData.Bitmap); + end; + + finally + Canvas.RestoreHandlestate; + end; +end; + +{ Extracts, in pixels, the bounding rectangle of the image with the + specified index } +function TStringGridEx.GetImageRect(AImageIndex: Integer): TRect; +var + imgdata: TImageData; +begin + if (AImageIndex >= 0) and (AImageIndex < FImageList.Count) then + begin + // Extract image data from image list + imgdata := TImageData(FImageList[AImageIndex]); + // Find coordinates of cell anchor + Result := CellRect(imgdata.Col, imgdata.Row); + // Fix size of the image rectangle + Result.Right := Result.Left + imgData.Bitmap.Width; + Result.Bottom := Result.Top + imgData.Bitmap.Height; + // Shift image to final position + OffsetRect(Result, imgdata.dx, imgdata.dy); + end else + Result := Rect(0, 0, 0, 0); +end; + +procedure TStringGridEx.MouseDown(Button: TMouseButton; Shift:TShiftState; + X,Y:Integer); +var + idx: Integer; +begin + idx := PointInImage(Point(X, Y)); + if idx > -1 then begin + FMouseDownPt := Point(X, Y); + FMouseImgIndex := idx; + DoImageClick(Shift, X, Y); + Abort; + end else + inherited; +end; + +procedure TStringGridEx.MouseMove(Shift: TShiftState; X,Y: Integer); +begin + if (FMouseImgIndex > -1) then begin + DoImageMove(Shift, X - FMouseDownPt.X, Y - FMouseDownPt.Y); + FMouseDownPt := Point(X, Y); + end + else + inherited; +end; + +procedure TStringGridEx.MouseUp(Button: TMouseButton; Shift:TShiftState; + X,Y:Integer); +begin + FMouseImgIndex := -1; + inherited; +end; + +{ Moves the image by dx pixels horizontally and dy pixels vertically. + It is recommended to call UpdateImageAnchor afterwards. If this is not done + then it is not clear whether an image will move if column widths are changed. } +procedure TStringGridEx.MoveImageBy(AImageIndex, dx, dy: Integer); +var + imgData: TImageData; +begin + if (AImageIndex > -1) and (AImageIndex < FImageList.Count) then + begin + imgData := TImageData(FImageList[AImageIndex]); + inc(imgData.dx, dx); + inc(imgData.dy, dy); + Invalidate; + end; +end; + +{ Finds the index of the image which contains the specified point. Images + are checked in reverse order, this means that in case of overlapping images + the "top" one is selected. + NOTE: Transparent areas of images are ignored, it is always the enclosing + rectangle of the entire image which is checked. } +function TStringGridEx.PointInImage(APoint: TPoint): Integer; +var + imgRect: TRect; + topleftPx: TPoint; + i: Integer; +begin + topleftPx := GetPxTopLeft; + APoint.X := APoint.X + topleftPx.X; + APoint.Y := APoint.Y + topleftPx.Y; + for i:=FImageList.Count-1 downto 0 do begin + imgRect := GetImageRect(i); + if PtInRect(imgRect, APoint) then + exit(i); + end; + Result := -1; +end; + +{ Recalculates the anchor cell to which the image is attached. The anchor cell + is always the cell which contains the upper left corner of the image. It + may change when an image is dragged across the grid. + This method should be called after moving an image because otherwise it will + not be clear whether an image moves if column widths are changed. } +procedure TStringGridEx.UpdateImageAnchor(AImageIndex: Integer); +var + imgdata: TImageData; + cell: TPoint; + R: TRect; + P: TPoint; +begin + if (AImageIndex < 0) or (AImageIndex >= FImageList.Count) then + exit; + R := GetImageRect(AImageIndex); // Current pixel coordinates of image + cell := MouseToLogCell(R.TopLeft); // Col/row of cell with top left image corner + P := CellRect(cell.X, cell.Y).TopLeft; // Pixel coordinates of top left corner of anchor cell + imgdata := TImageData(FImageList[AImageIndex]); + imgData.Col := cell.X; + imgData.Row := cell.Y; + imgData.dx := R.Left - P.X; + imgData.dy := R.Top - P.Y; +end; + +procedure TStringGridEx.WMHScroll(var message: TLMHScroll); +begin + inherited; + Invalidate; +end; + +procedure TStringGridEx.WMVScroll(var message: TLMVScroll); +begin + inherited; + Invalidate; +end; + +end. +