jvcllaz: Add demo for TJvPicClip.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6863 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2019-04-23 22:16:22 +00:00
parent 9e837bf91a
commit 5187f068ad
4 changed files with 333 additions and 0 deletions

View File

@ -0,0 +1,81 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<Title Value="JvPicClipDemo"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<DpiAware Value="True"/>
</XPManifest>
<Icon Value="0"/>
</General>
<BuildModes>
<Item Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="0"/>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="JvMMLazR"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units>
<Unit>
<Filename Value="JvPicClipDemo.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="main.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="..\..\bin\JvPicClipDemo"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<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>

View File

@ -0,0 +1,22 @@
program JvPicClipDemo;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, main
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Scaled:=True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

View File

@ -0,0 +1,70 @@
object Form1: TForm1
Left = 326
Height = 213
Top = 127
Width = 320
AutoSize = True
Caption = 'JvPicClip demo'
ClientHeight = 213
ClientWidth = 320
OnCreate = FormCreate
LCLVersion = '2.1.0.0'
object CombinedImage: TImage
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner
Left = 32
Height = 90
Top = 32
Width = 267
BorderSpacing.Left = 32
BorderSpacing.Top = 32
BorderSpacing.Right = 32
BorderSpacing.Bottom = 16
OnMouseDown = CombinedImageMouseDown
end
object SplitImage: TImage
AnchorSideLeft.Control = CombinedImage
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = Trackbar
AnchorSideTop.Side = asrBottom
Left = 153
Height = 24
Top = 179
Width = 24
BorderSpacing.Top = 8
BorderSpacing.Bottom = 32
end
object Trackbar: TTrackBar
AnchorSideLeft.Control = CombinedImage
AnchorSideTop.Control = CombinedImage
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = CombinedImage
AnchorSideRight.Side = asrBottom
Left = 32
Height = 33
Top = 138
Width = 267
OnChange = TrackbarChange
PageSize = 0
Position = 0
Anchors = [akTop, akLeft, akRight]
TabOrder = 0
end
object Label1: TLabel
AnchorSideTop.Control = SplitImage
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = SplitImage
Left = 103
Height = 15
Top = 184
Width = 34
Anchors = [akTop, akRight]
BorderSpacing.Right = 16
Caption = 'Label1'
ParentColor = False
end
object JvPicClip1: TJvPicClip
left = 96
top = 32
end
end

View File

@ -0,0 +1,160 @@
unit main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
ComCtrls, JvPicClip;
type
{ TForm1 }
TForm1 = class(TForm)
CombinedImage: TImage;
Label1: TLabel;
SplitImage: TImage;
JvPicClip1: TJvPicClip;
Trackbar: TTrackBar;
procedure CombinedImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure TrackbarChange(Sender: TObject);
private
procedure CreateCombinedImage(ABitmap: TBitmap;
out ANumCols, ANumRows: Integer);
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
procedure TForm1.FormCreate(Sender: TObject);
var
bmp: TBitmap;
nCols, nRows: Integer;
begin
bmp := TBitmap.Create;
try
CreateCombinedImage(bmp, nCols, nRows);
// Image for combined bitmap
CombinedImage.Width := bmp.Width;
CombinedImage.Height := bmp.Height;
CombinedImage.Picture.Assign(bmp);
// Image for separated bitmaps
SplitImage.Width := bmp.Width div nCols;
SplitImage.Height := bmp.Height div nRows;
JvPicClip1.Picture := CombinedImage.Picture;
JvPicClip1.Cols := nCols;
JvPicClip1.Rows := nRows;
Trackbar.Min := 0;
Trackbar.Max := nCols * nRows - 1;
Trackbar.Position := 0;
TrackbarChange(nil);
finally
bmp.Free;
end;
end;
procedure TForm1.CombinedImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
r, c: Integer;
begin
c := X div SplitImage.Width;
r := Y div SplitImage.Height;
Trackbar.Position := JvPicClip1.GetIndex(c, r);
end;
procedure TForm1.TrackbarChange(Sender: TObject);
begin
SplitImage.Picture.Assign(JvPicClip1.GraphicCell[Trackbar.Position]);
Label1.Caption := 'Index ' + IntToStr(Trackbar.Position);
end;
procedure TForm1.CreateCombinedImage(ABitmap: TBitmap;
out ANumCols, ANumRows: Integer);
const
W = 24;
H = 24;
var
pic: TPicture;
c, r, i: Integer;
L: TStrings;
begin
L := TStringList.Create;
try
L.Add('../design/JvMM/images/tjvbmpanimator.bmp'); //0
L.Add('../design/JvMM/images/tjvfullcoloraxiscombo.bmp');
L.Add('../design/JvMM/images/tjvfullcolorcircle.bmp');
L.Add('../design/JvMM/images/tjvfullcolorcircledialog.bmp');
L.Add('../design/JvMM/images/tjvfullcolorgroup.bmp');
L.Add('../design/JvMM/images/tjvfullcolorlabel.bmp');
L.Add('../design/JvMM/images/tjvfullcolorpanel.bmp');
L.Add('../design/JvMM/images/tjvfullcolorspacecombo.bmp');
L.Add('../design/JvMM/images/tjvfullcolortrackbar.bmp');
L.Add('../design/JvMM/images/tjvgradient.bmp');
L.Add('../design/JvMM/images/tjvgradientheaderpanel.bmp'); // 10
L.Add('../design/JvMM/images/tjvid3v2.bmp');
L.Add('../design/JvMM/images/tjvpicclip.bmp');
L.Add('../design/JvMM/images/tjvspecialprogress.bmp');
L.Add('../design/JvHMI/images/tjvdialbutton.bmp');
L.Add('../design/JvHMI/images/tjvled.bmp');
L.Add('../design/JvDB/images/tjvdbcalcedit.bmp');
L.Add('../design/JvDB/images/tjvdbhtlabel.bmp');
L.Add('../design/JvDB/images/tjvdbsearchcombobox.bmp');
L.Add('../design/JvDB/images/tjvdbsearchedit.bmp');
L.Add('../design/JvDB/images/tjvdbtreeview.bmp'); // 20
L.Add('../design/JvCustomControls/images/tjvimagelistviewer.png');
L.Add('../design/JvCustomControls/images/tjvimagesviewer.png');
L.Add('../design/JvCustomControls/images/tjvmoderntabbarpainter.bmp');
L.Add('../design/JvCustomControls/images/tjvoutlookbar.png');
L.Add('../design/JvCustomControls/images/tjvownerdrawviewer.png');
L.Add('../design/JvCustomControls/images/tjvtabbar.bmp');
L.Add('../design/JvCustomControls/images/tjvthumbimage.png');
L.Add('../design/JvCustomControls/images/tjvthumbnail.png');
L.Add('../design/JvCustomControls/images/tjvthumbview.png');
L.Add('../design/JvCustomControls/images/tjvtimeline.png'); // 30
L.Add('../design/JvCustomControls/images/tjvtmtimeline.png');
L.Add('../design/JvCustomControls/images/tjvvalidateedit.png'); // 32
ANumCols := 8;
ANumRows := 4;
ABitmap.SetSize(ANumCols * W, ANumRows * H);
ABitmap.Canvas.Brush.Color := clWhite;
Abitmap.Canvas.FillRect(0, 0, ABitmap.Width, ABitmap.Height);
c := 0;
r := 0;
pic := TPicture.Create;
try
for i:=0 to L.Count-1 do begin
pic.LoadFromFile(L[i]);
ABitmap.Canvas.Draw(c * W, r * H, pic.Bitmap);
inc(c);
if c = ANumCols then begin
c := 0;
inc(r);
end;
end;
finally
pic.Free;
end;
finally
L.Free;
end;
end;
end.