WebSVN – spacemission – Blame – /VCL_DELPHIX_D6/DXGlueItEdit.pas

Rev	Author	Line No.	Line
4	daniel-mar	1	unit DXGlueItEdit;
		2	//(c)2007 Jaro Benes
		3	//All Rights Reserved
		4
		5	{
		6	Complex application for users of unDelphiX as component editor:
		7
		8	Supported:
		9	a) many small images glue into one image.
		10	b) generate font image as one image with subpictures.
		11	c) use image effect for DIB.
		12	d) animation the glued image and font preview.
		13	e) restructuralize of images to square size or unlimeted in one size direction up 2048 px.
		14	f) it works in 24bit deepth always.
		15	g) store into DXImageList directly.
		16	h) reset of transparent color.
		17	i) force size for all images with different size.
		18	j) use the loupe preview for glued image (in preview page).
		19	k) generate mask for alphachannel for characters of fonts.
		20
		21	}
		22
		23	interface
		24
		25	{$I DelphiXcfg.inc}
		26
		27	uses
		28	Windows, Messages, SysUtils, Classes, Graphics, ShellAPI, StdCtrls, Dialogs,
		29	DXClass, DIB, jpeg, Menus, DXDraws, ComCtrls, Buttons, Controls, ExtCtrls, Forms,
		30	{$IFDEF VER17UP}System.UITypes,{$ENDIF}
		31	ExtDlgs,{$IFDEF VER6UP} Types,{$ENDIF} ActnList, ImgList;
		32
		33	type
		34	TOperationGlueIt = (ogiNew, ogiEdit);
		35	{injected class}
		36	TEdit = class(StdCtrls.TEdit)
		37	private
		38	function GetAsInteger: Integer;
		39	procedure SetAsInteger(const Value: Integer);
		40	published
		41	public
		42	property AsInteger: Integer read GetAsInteger write SetAsInteger;
		43	end;
		44	TDXGlueItEditor = class(TForm)
		45	OpenDialog1: TOpenDialog;
		46	DXTimer1: TDXTimer;
		47	SaveDialog1: TSaveDialog;
		48	DXImageList1: TDXImageList;
		49	Panel5: TPanel;
		50	btnExit: TButton;
		51	Button1: TButton;
		52	PopupMenu1: TPopupMenu;
		53	LoadImagedirectly1: TMenuItem;
		54	mainPageControl: TPageControl;
		55	tsGlueIt: TTabSheet;
		56	tsFontGen: TTabSheet;
		57	Panel1: TPanel;
		58	grManagementOfTheFrames: TGroupBox;
		59	Panel4: TPanel;
		60	chbCrop: TCheckBox;
		61	chbCentered: TCheckBox;
		62	ListBox1: TListBox;
		63	Panel3: TPanel;
		64	btnAddImages: TSpeedButton;
		65	btnDeleteSelected: TSpeedButton;
		66	btnClearAll: TSpeedButton;
		67	btnSave: TSpeedButton;
		68	btnGlueIt: TSpeedButton;
		69	btnGlue2Iso: TSpeedButton;
		70	btnUpSelection: TSpeedButton;
		71	btnDownSelection: TSpeedButton;
		72	chbTransparent: TCheckBox;
		73	Panel2: TPanel;
		74	grPictureAnimationPreview: TGroupBox;
		75	DXDraw1: TDXDraw;
		76	Panel6: TPanel;
		77	btnStop: TSpeedButton;
		78	btnPlay: TSpeedButton;
		79	LAnimationSpeed: TLabel;
		80	pbAnimationSpeed: TProgressBar;
		81	tsPreview: TTabSheet;
		82	GroupBox1: TGroupBox;
		83	Panel7: TPanel;
		84	ScrollBox1: TScrollBox;
		85	Image1: TImage;
		86	GroupBox4: TGroupBox;
		87	Panel8: TPanel;
		88	gbFontSettings: TGroupBox;
		89	Label1: TLabel;
		90	Label4: TLabel;
		91	Label10: TLabel;
		92	cbFontName: TComboBox;
		93	FontSize: TEdit;
		94	gbFontEffects: TGroupBox;
		95	Label5: TLabel;
		96	Label7: TLabel;
		97	eOffset: TEdit;
		98	eOpacity: TEdit;
		99	gbColorSettings: TGroupBox;
		100	Label14: TLabel;
		101	Label15: TLabel;
		102	btnFontGenerate: TButton;
		103	FontPageControl: TPageControl;
		104	tsFont: TTabSheet;
		105	ScrollBox2: TScrollBox;
		106	imgFont: TImage;
		107	tsMask: TTabSheet;
		108	ScrollBox3: TScrollBox;
		109	imgMask: TImage;
		110	tsPreviewFont: TTabSheet;
		111	PreviewMemo: TMemo;
		112	PreviewDraw: TDXDraw;
		113	PreviewTimer: TDXTimer;
		114	FontDXImageList: TDXImageList;
		115	Label16: TLabel;
		116	btnAllChars: TButton;
		117	memAlphabet: TMemo;
		118	cbAntialias: TCheckBox;
		119	cbDrawGrid: TCheckBox;
		120	SavePictureDialog: TSavePictureDialog;
		121	ColorDialog: TColorDialog;
		122	pnlFG: TPanel;
		123	pnlBG: TPanel;
		124	Panel20: TPanel;
		125	btnABold: TSpeedButton;
		126	btnAItalic: TSpeedButton;
		127	btnAUnderline: TSpeedButton;
		128	DXDIB1: TDXDIB;
		129	Label11: TLabel;
		130	Sources: TMemo;
		131	Panel9: TPanel;
		132	btnFontAnimationStop: TSpeedButton;
		133	btnFontAnimationStart: TSpeedButton;
		134	Splitter1: TSplitter;
		135	Splitter2: TSplitter;
		136	Panel10: TPanel;
		137	LDuration: TLabel;
		138	Label6: TLabel;
		139	pbDuration: TProgressBar;
		140	cbEffectsList: TComboBox;
		141	btnApply: TButton;
		142	Panel11: TPanel;
		143	grSubimages: TGroupBox;
		144	LPatternWidth: TLabel;
		145	LPatternHeight: TLabel;
		146	ePatternWidth: TEdit;
		147	ePatternHeight: TEdit;
		148	btnResize: TButton;
		149	btnReplace: TButton;
		150	Panel12: TPanel;
		151	SpeedButton1: TSpeedButton;
		152	SpeedButton2: TSpeedButton;
		153	Label2: TLabel;
		154	panTColor: TPanel;
		155	EWidthOfImages: TEdit;
		156	EHeightOfImages: TEdit;
		157	LWidthOfImages: TLabel;
		158	LHeightOfImages: TLabel;
		159	chbForceSize: TCheckBox;
		160	ImageList1: TImageList;
		161	ActionList1: TActionList;
		162	acAddImages: TAction;
		163	acDeleteAll: TAction;
		164	acDeleteOne: TAction;
		165	acSaveToFile: TAction;
		166	acGlueIt: TAction;
		167	acGlueIzonometrics: TAction;
		168	acUpSelection: TAction;
		169	acDownSelection: TAction;
		170	acAnimateOn: TAction;
		171	acAnimateStop: TAction;
		172	acAnimeFontOff: TAction;
		173	acAnimeFontOn: TAction;
		174	Image2: TImage;
		175	GroupBox2: TGroupBox;
		176	Label13: TLabel;
		177	Label17: TLabel;
		178	Label18: TLabel;
		179	Label19: TLabel;
		180	Slider: TTrackBar;
		181	chbZoomOut: TCheckBox;
		182	CheckBox1: TCheckBox;
		183	btnGetTransparentcolor: TSpeedButton;
		184	btnCrop: TSpeedButton;
		185	btnFill: TSpeedButton;
		186	SpeedButton10: TSpeedButton;
		187	SpeedButton11: TSpeedButton;
		188	SpeedButton12: TSpeedButton;
		189	SpeedButton13: TSpeedButton;
		190	btnWand: TSpeedButton;
		191	btnMask: TSpeedButton;
		192	acLoadImage: TAction;
		193	acSaveImage: TAction;
		194	acGetTransparent: TAction;
		195	Label8: TLabel;
		196	panBColor: TPanel;
		197	Panel13: TPanel;
		198	EFromImage: TEdit;
		199	EToImage: TEdit;
		200	Label3: TLabel;
		201	LToImage: TLabel;
		202	chbAutoAply: TCheckBox;
		203	procedure chbAutoAplyClick(Sender: TObject);
		204	procedure pbDurationMouseUp(Sender: TObject; Button: TMouseButton;
		205	Shift: TShiftState; X, Y: Integer);
		206	procedure pbDurationMouseDown(Sender: TObject; Button: TMouseButton;
		207	Shift: TShiftState; X, Y: Integer);
		208	procedure cbEffectsListChange(Sender: TObject);
		209	procedure chbForceSizeClick(Sender: TObject);
		210	procedure acGetTransparentExecute(Sender: TObject);
		211	procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
		212	Shift: TShiftState; X, Y: Integer);
		213	procedure btnGetTransparentcolorClick(Sender: TObject);
		214	procedure btnResizeClick(Sender: TObject);
		215	procedure btnReplaceClick(Sender: TObject);
		216	procedure btnFontAnimationStartClick(Sender: TObject);
		217	procedure btnFontAnimationStopClick(Sender: TObject);
		218	procedure PreviewMemoChange(Sender: TObject);
		219	procedure PreviewTimerTimer(Sender: TObject; LagCount: Integer);
		220	procedure btnAUnderlineClick(Sender: TObject);
		221	procedure btnAItalicClick(Sender: TObject);
		222	procedure btnABoldClick(Sender: TObject);
		223	procedure btnFontGenerateClick(Sender: TObject);
		224	procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
		225	Shift: TShiftState; X, Y: Integer);
		226	procedure btnAllCharsClick(Sender: TObject);
		227	procedure pnlFGClick(Sender: TObject);
		228	procedure cbFontNameDrawItem(Control: TWinControl; Index: Integer;
		229	Rect: TRect; State: TOwnerDrawState);
		230	procedure pbAnimationSpeedMouseMove(Sender: TObject; Shift: TShiftState; X,
		231	Y: Integer);
		232	procedure DXDraw1MouseMove(Sender: TObject; Shift: TShiftState; X,
		233	Y: Integer);
		234	procedure LoadImagedirectly1Click(Sender: TObject);
		235	procedure btnApplyClick(Sender: TObject);
		236	procedure pbDurationMouseMove(Sender: TObject; Shift: TShiftState; X,
		237	Y: Integer);
		238	procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
		239	Rect: TRect; State: TOwnerDrawState);
		240	procedure ListBox1MeasureItem(Control: TWinControl; Index: Integer;
		241	var Height: Integer);
		242	procedure ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
		243	procedure ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
		244	State: TDragState; var Accept: Boolean);
		245	procedure ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
		246	Shift: TShiftState; X, Y: Integer);
		247	procedure DXTimer1Timer(Sender: TObject; LagCount: Integer);
		248	procedure btnStopClick(Sender: TObject);
		249	procedure btnAddImagesClick(Sender: TObject);
		250	procedure btnClearAllClick(Sender: TObject);
		251	procedure btnUpSelectionClick(Sender: TObject);
		252	procedure btnDownSelectionClick(Sender: TObject);
		253	procedure btnDeleteSelectedClick(Sender: TObject);
		254	procedure btnGlueItClick(Sender: TObject);
		255	procedure btnPlayClick(Sender: TObject);
		256	procedure btnSaveClick(Sender: TObject);
		257	procedure btnExitClick(Sender: TObject);
		258
		259	procedure FormDestroy(Sender: TObject);
		260	procedure FormCreate(Sender: TObject);
		261	procedure ActionList1Update(Action: TBasicAction;
		262	var Handled: Boolean);
		263	procedure chbZoomOutClick(Sender: TObject);
		264	procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
		265	Y: Integer);
		266	procedure mainPageControlChange(Sender: TObject);
		267	private
		268	{ Private declarations }
		269	tmpPicture: TPicture;
		270	StartingPoint: TPoint;
		271	FDuration: Integer;
		272	ListObjects: TStringList;
		273	dX, dY: Integer;
		274	FFontStyles: TFontStyles;
		275	charArr: string;
		276	sizesArr: array of Integer;
		277	Zdvih: Integer;
		278	WPattern: Integer;
		279	InitIntInMs: Integer;
		280	WCounter: Integer;
		281	FOperationGlueIt: TOperationGlueIt;
		282	SelectionOfTransparentColor: Boolean;
		283	procedure WMDropFiles(var Message: TWMDropFiles); message wm_DropFiles;
		284	procedure RestructuralizeWithResize(NewWidth, NewHeight: Integer; TranspColor: TColor = clMaroon);
		285	procedure SetOperationGlueIt(const Value: TOperationGlueIt);
		286	procedure DoBitmapEffect(Picture: TPicture);
		287	public
		288	{ Public declarations }
		289	property Operation: TOperationGlueIt read FOperationGlueIt write SetOperationGlueIt;
		290	procedure LoadImageFromList(const iName: string; Image: TPicture; PatternWidth,
		291	PatternHeight: Integer; Transparent: Boolean; TransparentColor: Integer);
		292	procedure SaveImageIntoList(oItem: TPictureCollectionItem);
		293	end;
		294
		295	var
		296	DXGlueItEditor: TDXGlueItEditor;
		297
		298	implementation
		299
		300	{$R *.DFM}
		301
		302
		303	uses {$IFDEF StandardDX}DirectDraw{$ELSE}DirectX{$ENDIF};
		304
		305	{ TEdit }
		306
		307	function TEdit.GetAsInteger: Integer;
		308	begin
		309	try
		310	Result := StrToInt(Self.Text);
		311	except
		312	Result := 0;
		313	end;
		314	end;
		315
		316	procedure TEdit.SetAsInteger(const Value: Integer);
		317	begin
		318	Self.Text := IntToStr(Value)
		319	end;
		320
		321	procedure TDXGlueItEditor.btnStopClick(Sender: TObject);
		322	begin
		323	DXTimer1.Enabled := False;
		324	end;
		325
		326	{ TDXGlueItEditor }
		327
		328	procedure TDXGlueItEditor.btnAddImagesClick(Sender: TObject);
		329	var
		330	i: Integer;
		331	TI: TPicture;
		332	begin
		333	if OpenDialog1.Execute then
		334	if OpenDialog1.Files.Count > 0 then begin
		335	ListObjects.Clear;
		336	with OpenDialog1.Files do
		337	for I := 0 to Count - 1 do
		338	if FileExists(Strings[I]) then
		339	begin
		340	TI := TPicture.Create;
		341	TI.LoadFromFile(Strings[I]);
		342	EWidthOfImages.AsInteger := Max(EWidthOfImages.AsInteger, TI.Width);
		343	EHeightOfImages.AsInteger := Max(EHeightOfImages.AsInteger, TI.Height);
		344	ListObjects.AddObject(Strings[I], TI);
		345	end;
		346	ListBox1.Items.Assign(ListObjects);
		347	end;
		348	end;
		349
		350	procedure TDXGlueItEditor.btnClearAllClick(Sender: TObject);
		351	var
		352	I: Integer;
		353	begin
		354	if MessageDlg('Do you really want delete all frames?', mtWarning, [mbYes, mbNo], 0) = mrNo then Exit;
		355	btnStop.Click;
		356	for I := 0 to ListBox1.Items.Count - 1 do (ListBox1.Items.Objects[I] as TPicture).Free;
		357	ListBox1.Clear;
		358	ListObjects.Clear;
		359	DXImageList1.Items.Clear;
		360	end;
		361
		362	procedure TDXGlueItEditor.btnUpSelectionClick(Sender: TObject);
		363	begin
		364	if ListBox1.ItemIndex > 0 then begin
		365	btnStop.Click;
		366	ListBox1.Items.Move(ListBox1.ItemIndex, ListBox1.ItemIndex - 1);
		367	end;
		368	end;
		369
		370	procedure TDXGlueItEditor.btnDownSelectionClick(Sender: TObject);
		371	begin
		372	if (ListBox1.ItemIndex <> -1) and (ListBox1.ItemIndex < (ListBox1.Items.Count - 1)) then begin
		373	btnStop.Click;
		374	ListBox1.Items.Move(ListBox1.ItemIndex, ListBox1.ItemIndex + 1);
		375	end;
		376	end;
		377
		378	procedure TDXGlueItEditor.btnDeleteSelectedClick(Sender: TObject);
		379	begin
		380	if ListBox1.ItemIndex <> -1 then begin
		381	if MessageDlg('Do you want delete selected item?', mtWarning, [mbYes, mbNo], 0) = mrYes then begin
		382	(ListBox1.Items.Objects[ListBox1.ItemIndex] as TPicture).Free;
		383	ListObjects.Delete(ListBox1.ItemIndex);
		384	ListBox1.Items.Delete(ListBox1.ItemIndex);
		385	end;
		386	end;
		387	end;
		388
		389	procedure TDXGlueItEditor.FormCreate(Sender: TObject);
		390	var
		391	cnt: Integer;
		392	begin
		393	DXImageList1.Items.MakeColorTable;
		394	DXDraw1.ColorTable := DXImageList1.Items.ColorTable;
		395	DXDraw1.DefColorTable := DXImageList1.Items.ColorTable;
		396	DXDraw1.UpdatePalette;
		397	tmpPicture := TPicture.Create;
		398	ListObjects := TStringList.Create;
		399	DragAcceptFiles(Handle, True);
		400	WPattern := 0; InitIntInMs := 200; //5 pict per sec
		401	WCounter := 0;
		402	for cnt := 0 to Screen.Fonts.Count - 1 do
		403	cbFontName.Items.Add(Screen.Fonts.Strings[cnt]);
		404	pbAnimationSpeed.Position := 200;
		405	pbDuration.Position := 5;
		406	mainPageControl.ActivePage := tsGlueIt;
		407	FontPageControl.ActivePage := tsPreviewFont;
		408	if chbZoomOut.Checked then Image1.OnMouseMove := Image1MouseMove
		409	else Image1.OnMouseMove := nil;
		410	Tag := 0;
		411	{$IFDEF VER4UP}
		412	pbAnimationSpeed.Smooth := True;
		413	pbDuration.Smooth := True;
		414	{$ENDIF}
		415	end;
		416
		417	procedure TDXGlueItEditor.SaveImageIntoList(oItem: TPictureCollectionItem);
		418	begin
		419	oItem.Picture.Assign(DXImageList1.Items[0].Picture);
		420	oItem.Transparent := DXImageList1.Items[0].Transparent;
		421	oItem.TransparentColor := DXImageList1.Items[0].TransparentColor;
		422	oItem.Name := DXImageList1.Items[0].Name;
		423	oItem.PatternWidth := DXImageList1.Items[0].Width;
		424	oItem.PatternHeight := DXImageList1.Items[0].Height;
		425	end;
		426
		427	procedure TDXGlueItEditor.LoadImageFromList(const iName: string; Image: TPicture;
		428	PatternWidth, PatternHeight: Integer; Transparent: Boolean; TransparentColor: Integer);
		429	{function for loading existing image from dximagelist do component editor}
		430	var
		431	D: TPictureCollectionItem;
		432	begin
		433	btnPlay.Click;
		434	DXImageList1.Items.Clear;
		435	D := TPictureCollectionItem(DXImageList1.Items.Add);
		436	D.Picture.Assign(Image);
		437	D.Name := Name;
		438	Image1.Picture.Assign(Image);
		439	D.PatternWidth := PatternWidth;
		440	D.PatternHeight := PatternHeight;
		441	D.Transparent := Transparent;
		442	D.TransparentColor := TransparentColor;
		443	DXImageList1.Items.Restore;
		444	ePatternWidth.AsInteger := PatternWidth;
		445	ePatternHeight.AsInteger := PatternHeight;
		446	end;
		447
		448	procedure TDXGlueItEditor.btnGlueItClick(Sender: TObject);
		449	// function GetScale(SourceWidth, SourceHeight, TargetWidth, TargetHeight: Integer): Single;
		450	// from DIB unit
		451	// var
		452	// XScale, YScale: Single;
		453	// begin
		454	// XScale := 1;
		455	// YScale := 1;
		456	// if TargetWidth < SourceWidth then
		457	// XScale := TargetWidth / SourceWidth;
		458	// if TargetHeight < SourceHeight then
		459	// YScale := TargetHeight / SourceHeight;
		460	// Result := XScale;
		461	// if YScale < Result then
		462	// Result := YScale;
		463	// end;
		464	var
		465	i: Integer;
		466	XL, YL, X, Y, QX, QY: Integer;
		467	P: TPicture;
		468	C: Double;
		469	Rz: Integer;
		470	B, BB: TBitmap; Icon: TIcon; DIB: TDIB;
		471	CI: TPictureCollectionItem;
		472	ImageIsBigger: Boolean;
		473	OldName: string;
		474	begin
		475	XL := 0; YL := 0;
		476	B := TBitmap.Create;
		477	B.PixelFormat := pf24bit;
		478	try
		479	if chbForceSize.Checked then begin
		480	XL := EWidthOfImages.AsInteger;
		481	YL := EHeightOfImages.AsInteger;
		482	end
		483	else begin
		484	//must be the same size
		485	for i := 0 to ListBox1.Items.Count - 1 do begin
		486	P := ListBox1.Items.Objects[i] as TPicture;
		487	if Assigned(P) then begin
		488	XL := Max(XL, P.Width);
		489	YL := Max(YL, P.Height);
		490	end;
		491	end;
		492	end;
		493	//square od image
		494	C := Sqrt(ListBox1.Items.Count);
		495	Rz := Trunc(C);
		496	if Frac(C) > 0 then Inc(Rz);
		497	//dimension of Image
		498	B.Width := Rz * XL;
		499	B.Height := Rz * YL;
		500	{set color by user settings}
		501	B.Canvas.Brush.Color := panBColor.Color;
		502	B.Canvas.FillRect(Bounds(0, 0, B.Width, B.Height));
		503	for i := 0 to ListBox1.Items.Count - 1 do begin
		504	P := ListBox1.Items.Objects[i] as TPicture;
		505	if Assigned(P) then begin
		506	if P.Graphic is TIcon then begin
		507	Icon := (P.Graphic as TIcon);
		508	BB := TBitmap.Create;
		509	try
		510	BB.Width := Icon.Width;
		511	BB.Height := Icon.Height;
		512	BB.Canvas.Draw(0, 0, Icon);
		513	BB.Transparent := True;
		514	P.Graphic := BB;
		515	finally
		516	BB.Free;
		517	end;
		518	end;
		519	X := (i mod Rz) * XL;
		520	Y := (i div Rz) * YL;
		521	if chbForceSize.Checked then begin
		522	ImageIsBigger := (P.Width > XL) or (P.Height > YL);
		523	if ImageIsBigger then begin
		524	{image will be crop}
		525	if chbCrop.Checked then begin
		526	B.Canvas.CopyRect(Bounds(X, Y, XL, YL), P.Bitmap.Canvas, Bounds(0, 0, XL, YL))
		527	end
		528	else begin {image will be shrink}
		529	C := GetScale(P.Width, P.Height, XL, YL);
		530	DIB := TDIB.Create;
		531	try
		532	DIB.SetSize(P.Width, P.Height, 24);
		533	DIB.Canvas.Draw(0, 0, P.Graphic);
		534	DIB.DoResample(Round(P.Width * C), Round(P.Height * C), ftrLanczos3);
		535	B.Canvas.StretchDraw(Bounds(X, Y, Round(P.Width * C), Round(P.Height * C)), {P.Graphic} DIB);
		536	finally
		537	DIB.Free;
		538	end;
		539	end;
		540	end
		541	else begin
		542	QX := 0;
		543	QY := 0;
		544	if chbCentered.Checked then begin
		545	QX := (XL - P.Width) div 2;
		546	QY := (YL - P.Height) div 2;
		547	end;
		548	if not chbTransparent.Checked then
		549	B.Canvas.Draw(X + QX, Y + QY, P.Graphic)
		550	else
		551	B.Canvas.BrushCopy(Bounds(X + QX, Y + QY, P.Width, P.Height), P.Bitmap, Bounds(0, 0, P.Width, P.Height), P.Bitmap.Canvas.Pixels[0, P.Height - 1]);
		552	end;
		553	end
		554	else
		555	if not chbTransparent.Checked then
		556	B.Canvas.Draw(X, Y, P.Graphic)
		557	else
		558	B.Canvas.BrushCopy(Bounds(X, Y, XL, YL), P.Bitmap, Bounds(0, 0, XL, YL), P.Bitmap.Canvas.Pixels[0, P.Height - 1]);
		559	end;
		560	end;
		561	Image1.Picture.Assign(B);
		562
		563	{reset after image assign}
		564	cbEffectsList.ItemIndex := -1; pbDuration.Position := 5; chbAutoAply.Checked := False;
		565
		566	OldName := 'Test';
		567	if DXImageList1.Items.Count > 0 then
		568	if Operation = ogiEdit then
		569	OldName := DXImageList1.Items[0].Name; {puvodni jmeno}
		570
		571	DXImageList1.Items.Clear;
		572	CI := TPictureCollectionItem(DXImageList1.Items.Add);
		573	CI.Name := OldName;
		574	CI.Picture.Assign(B);
		575	CI.Transparent := chbTransparent.Checked;
		576	CI.PatternWidth := XL;
		577	CI.PatternHeight := YL;
		578	ePatternWidth.AsInteger := XL;
		579	ePatternHeight.AsInteger := YL;
		580	DXImageList1.Items.Restore;
		581
		582	EFromImage.AsInteger := 1;
		583	EToImage.AsInteger := ListBox1.Items.Count;
		584	finally
		585	B.Free;
		586	end;
		587	mainPageControl.ActivePage := tsPreview;
		588	end;
		589
		590	procedure TDXGlueItEditor.btnPlayClick(Sender: TObject);
		591	begin
		592	DXTimer1.Enabled := True;
		593	if Image1.Picture.Bitmap.Empty then
		594	btnStop.Click;
		595	end;
		596
		597	procedure TDXGlueItEditor.btnSaveClick(Sender: TObject);
		598	begin
		599	if MessageDlg('Do you want save image to file?', mtWarning, [mbYes, mbNo], 0) = mrNo then Exit;
		600	if SaveDialog1.Execute then
		601	Image1.Picture.SaveToFile(SaveDialog1.FileName);
		602	end;
		603
		604	procedure TDXGlueItEditor.btnExitClick(Sender: TObject);
		605	begin
		606	btnStop.Click;
		607	btnFontAnimationStop.Click;
		608	Tag := 1;
		609	Close
		610	end;
		611
		612	function SpeedConst(InitValue, PerSec, LagCount: Integer): Integer; {$IFDEF VER9UP}inline; {$ENDIF}
		613	begin
		614	Result := InitValue + (PerSec * Round(LagCount / 1000))
		615	end;
		616
		617	procedure TDXGlueItEditor.DXTimer1Timer(Sender: TObject; LagCount: Integer);
		618	begin
		619	if DXImageList1.Items.Count <= 0 then Exit;
		620	if not DXDraw1.CanDraw then Exit;
		621	DXDraw1.Surface.Fill(DXDraw1.Surface.ColorMatch(clBlack));
		622	DXDraw1.BeginScene;
		623	try
		624	{clear surface with predefined windows color}
		625	DXDraw1.Surface.Fill(DXDraw1.Surface.ColorMatch(clBlack));
		626
		627	//----------------------------------------------------------------------------
		628	{All drawing here like}
		629	Inc(WCounter, LagCount);
		630	{timming}
		631	if WCounter > InitIntInMs then begin
		632	Inc(WPattern);
		633	if WPattern > DXImageList1.Items[0].PatternCount then WPattern := 0;
		634	{only for interval from EFromImage to EToImage}
		635	if WPattern > (EToImage.AsInteger - 1) then WPattern := EFromImage.AsInteger - 1;
		636	{reset counter}
		637	WCounter := 0;
		638	end;
		639	{drawing}
		640	with DXImageList1.Items[0] do
		641	Draw(DXDraw1.Surface, dX-(Width div 2), dY-(Height div 2), WPattern);
		642	//----------------------------------------------------------------------------
		643	finally
		644	DXDraw1.EndScene;
		645	end;
		646
		647	{ Draw FrameRate }
		648	with DXDraw1.Surface.Canvas do
		649	try
		650	Brush.Style := bsClear;
		651	Font.Color := clWhite;
		652	Font.Size := 10;
		653	Textout(3, 3, 'FPS: ' + IntToStr(DXTimer1.FrameRate));
		654	if doHardware in DXDraw1.NowOptions then begin
		655	Textout(3, 14, 'Device: Hardware');
		656	end
		657	else begin
		658	Textout(3, 14, 'Device: Software');
		659	end;
		660	finally
		661	Release; { Indispensability }
		662	end;
		663	DXDraw1.Flip;
		664	end;
		665
		666	procedure TDXGlueItEditor.FormDestroy(Sender: TObject);
		667	begin
		668	tmpPicture.Free;
		669	ListObjects.Free;
		670	DragAcceptFiles(Handle, False);
		671	end;
		672
		673	procedure TDXGlueItEditor.ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
		674	Shift: TShiftState; X, Y: Integer);
		675	begin
		676	StartingPoint.X := X;
		677	StartingPoint.Y := Y;
		678	end;
		679
		680	procedure TDXGlueItEditor.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
		681	State: TDragState; var Accept: Boolean);
		682	begin
		683	Accept := Source = ListBox1;
		684	end;
		685
		686	procedure TDXGlueItEditor.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
		687	var
		688	DropPosition, StartPosition: Integer;
		689	DropPoint: TPoint;
		690	begin
		691	DropPoint.X := X;
		692	DropPoint.Y := Y;
		693	with Source as TListBox do
		694	begin
		695	StartPosition := ItemAtPos(StartingPoint, True);
		696	DropPosition := ItemAtPos(DropPoint, True);
		697
		698	Items.Move(StartPosition, DropPosition);
		699	end;
		700	end;
		701
		702	procedure TDXGlueItEditor.WMDropFiles(var Message: TWMDropFiles);
		703	var
		704	FileCount, I: Integer;
		705	FileName: PChar;
		706	FileNameSize: Integer;
		707	S: string;
		708	TI: TPicture;
		709	begin
		710	try
		711	FileCount := DragQueryFile(Message.Drop, Cardinal(-1), nil, 0);
		712	for I := 0 to FileCount - 1 do
		713	begin
		714	FileNameSize := DragQueryFile(Message.Drop, I, nil, 0);
		715	FileName := AllocMem(FileNameSize + 1);
		716	try
		717	DragQueryFile(Message.Drop, I, FileName, FileNameSize + 1);
		718	S := ExtractFileExt(Filename);
		719	if (S = '.bmp') or (S = '.dib') or (S = '.jpg') then begin
		720	TI := TPicture.Create;
		721	TI.LoadFromFile(Filename);
		722	ListBox1.Items.AddObject(FileName, TObject(TI));
		723	end;
		724	finally
		725	FreeMem(FileName);
		726	end;
		727	end;
		728	finally
		729	DragFinish(Message.Drop);
		730	end;
		731	end;
		732
		733	procedure TDXGlueItEditor.ListBox1MeasureItem(Control: TWinControl; Index: Integer;
		734	var Height: Integer);
		735	var
		736	I: TPicture;
		737	begin
		738	I := TPicture(ListObjects.Objects[Index]);
		739	if Assigned(I) then
		740	Height := I.Height;
		741	end;
		742
		743	procedure TDXGlueItEditor.ListBox1DrawItem(Control: TWinControl; Index: Integer;
		744	Rect: TRect; State: TOwnerDrawState);
		745	var
		746	I: TPicture; Ri: TRect; S: string; A: array[0..255] of Char;
		747	Dest, Src: TRect; Icon: TIcon; B: TBitmap;
		748	begin
		749	ListBox1.Canvas.FillRect(Rect);
		750	I := ListBox1.Items.Objects[Index] as TPicture;
		751	if Assigned(I) then begin
		752	if I.Graphic is TIcon then begin
		753	Icon := (I.Graphic as TIcon);
		754	B := TBitmap.Create;
		755	try
		756	B.Width := Icon.Width;
		757	B.Height := Icon.Height;
		758	B.Canvas.Draw(0, 0, Icon);
		759	B.Transparent := True;
		760	I.Graphic := B;
		761	finally
		762	B.Free;
		763	end;
		764	end;
		765	Dest := Rect;
		766	Dest.Right := I.Width - 1;
		767	Src := Bounds(0, 0, I.Width, I.Height);
		768	if chbTransparent.Checked then
		769	ListBox1.Canvas.BrushCopy(Dest, I.Bitmap, Src, I.Bitmap.Canvas.Pixels[0, I.Height])
		770	else
		771	ListBox1.Canvas.Draw(Rect.Left, Rect.Top, I.Graphic);
		772	Ri := Rect;
		773	Ri.Left := Ri.Left + 4 + I.Width;
		774	S := ExtractFileName(ListBox1.Items[Index]);
		775	DrawText(ListBox1.Canvas.Handle, StrPCopy(A, S), -1, Ri, dt_SingleLine or dt_Left or dt_VCenter);
		776	end;
		777	end;
		778
		779	procedure TDXGlueItEditor.pbDurationMouseMove(Sender: TObject; Shift: TShiftState; X,
		780	Y: Integer);
		781	var
		782	newPosition: integer;
		783	begin
		784	with Sender as TProgressBar do begin
		785	if ssLeft in Shift then
		786	begin
		787	Cursor := crHSplit;
		788	newPosition := Round(x * Max / ClientWidth);
		789	Position := newPosition;
		790	end
		791	else
		792	begin
		793	Cursor := crDefault;
		794	end;
		795	FDuration := Position;
		796	LDuration.Caption := Format('Duration (%d)', [FDuration]);
		797	end;
		798	if ssLeft in Shift then
		799	if chbAutoAply.Checked and (cbEffectsList.ItemIndex <> -1) and not tmpPicture.Graphic.Empty then begin
		800	DoBitmapEffect(tmpPicture);
		801	Application.ProcessMessages;
		802	end;
		803	end;
		804
		805	procedure TDXGlueItEditor.DoBitmapEffect(Picture: TPicture);
		806	var
		807	I, dX, dY: Integer;
		808	TT: TDIB;
		809	tbp: Integer;
		810	begin
		811	TT := TDIB.Create;
		812	try
		813	if Assigned(Picture.Bitmap) then
		814	TT.Assign(Picture.Bitmap)
		815	else begin
		816	TT.Width := Picture.Width;
		817	TT.Height := Picture.Height;
		818	TT.Canvas.Draw(0, 0, Picture.Graphic);
		819	end;
		820
		821	dX := TT.Width;
		822	dY := TT.Height;
		823	if pbDuration.Position > 5 then
		824	begin
		825	dX := Trunc(pbDuration.Position / 100 * TT.Width);
		826	dY := Trunc(pbDuration.Position / 100 * TT.Height);
		827	end;
		828	tbp := pbDuration.Position;
		829	{ E F F E C T S }
		830	with TT do
		831	case cbEffectsList.ItemIndex of
		832	0: DoGaussianBlur(tbp);
		833	1: DoSplitBlur(tbp);
		834	2: DoAddColorNoise(tbp * 3);
		835	3: DoAddMonoNoise(tbp * 3);
		836	4: for i := 1 to tbp do DoAntiAlias;
		837	5: DoContrast(tbp * 3);
		838	6: DoFishEye(tbp div 10 + 1);
		839	7: DoLightness(tbp * 2);
		840	8: DoDarkness(tbp * 2);
		841	9: DoSaturation(255 - ((tbp * 255) div 100));
		842	10: DoMosaic(tbp div 2);
		843	11: DoTwist(200 - (tbp * 2) + 1);
		844	12: DoSplitlight(tbp div 20);
		845	13: DoTile(tbp div 10);
		846	14: DoSpotLight(tbp, Rect(tbp, tbp, tbp + tbp * 2, tbp + tbp * 2));
		847	15: DoTrace(tbp div 10);
		848	16: for i := 1 to tbp do DoEmboss;
		849	17: DoSolorize(255 - ((tbp * 255) div 100));
		850	18: DoPosterize(((tbp * 255) div 100) + 1);
		851	19: DoGrayscale;
		852	20: DoInvert;
		853	21: DoBrightness(tbp);
		854	22: DoColorize(clRed, clBlue);
		855	{resampling functions}
		856	23: DoResample(dX, dY, ftrBox);
		857	24: DoResample(dX, dY, ftrTriangle);
		858	25: DoResample(dX, dY, ftrHermite);
		859	26: DoResample(dX, dY, ftrBell);
		860	27: DoResample(dX, dY, ftrBSpline);
		861	28: DoResample(dX, dY, ftrLanczos3);
		862	29: DoResample(dX, dY, ftrMitchell);
		863	end; {Case}
		864	Image1.Picture.Bitmap := TT.CreateBitmapFromDIB;
		865	Image1.Invalidate;
		866	finally
		867	TT.Free;
		868	end;
		869	end;
		870
		871	procedure TDXGlueItEditor.btnApplyClick(Sender: TObject);
		872	begin
		873	if not Assigned(Image1.Picture.Graphic) then begin
		874	MessageDlg('Not graphics found in image, please glue it first.', mtWarning, [mbOK], 0);
		875	Exit;
		876	end;
		877	btnApply.Enabled := False;
		878	Screen.Cursor := crHourGlass;
		879	try
		880	DoBitmapEffect(Image1.Picture); Application.ProcessMessages;
		881	finally
		882	Screen.Cursor := crDefault;
		883	btnApply.Enabled := True;
		884	end;
		885	end;
		886
		887	procedure TDXGlueItEditor.LoadImagedirectly1Click(Sender: TObject);
		888	var
		889	Q: TPictureCollectionItem;
		890	begin
		891	OpenDialog1.Options := OpenDialog1.Options - [ofAllowMultiSelect];
		892	try
		893	if OpenDialog1.Execute then begin
		894	Image1.Picture.LoadFromFile(OpenDialog1.FileName);
		895	DXImageList1.Items.Clear;
		896	Q := TPictureCollectionItem(DXImageList1.Items.Add);
		897	Q.Name := ExtractFileName(OpenDialog1.FileName);
		898	Q.Picture.LoadFromFile(OpenDialog1.FileName);
		899	Q.Transparent := True;
		900	if Q.Picture.Graphic is TBitmap then begin
		901	Q.TransparentColor := Q.Picture.Bitmap.Canvas.Pixels[Q.Width - 1, Q.Height - 1];
		902	panTColor.Color := Q.TransparentColor;
		903	end;
		904	DXImageList1.Items.Restore;
		905	end;
		906	finally
		907	OpenDialog1.Options := OpenDialog1.Options + [ofAllowMultiSelect]
		908	end;
		909	end;
		910
		911	procedure TDXGlueItEditor.DXDraw1MouseMove(Sender: TObject; Shift: TShiftState; X,
		912	Y: Integer);
		913	begin
		914	dX := X;
		915	dY := Y;
		916	end;
		917
		918	procedure TDXGlueItEditor.pbAnimationSpeedMouseMove(Sender: TObject; Shift: TShiftState; X,
		919	Y: Integer);
		920	var
		921	newPosition: integer;
		922	begin
		923	with Sender as TProgressBar do begin
		924	if ssLeft in Shift then
		925	begin
		926	Cursor := crHSplit;
		927	newPosition := Round(x * Max / ClientWidth);
		928	Position := newPosition;
		929	end
		930	else
		931	begin
		932	Cursor := crDefault;
		933	end;
		934	InitIntInMs := Position;
		935	LAnimationSpeed.Caption := Format('Animation speed (%f/sec):', [InitIntInMs / 1000]);
		936	end;
		937	end;
		938
		939	procedure TDXGlueItEditor.cbFontNameDrawItem(Control: TWinControl; Index: Integer;
		940	Rect: TRect; State: TOwnerDrawState);
		941	begin
		942	with (Control as TComboBox).Canvas do
		943	begin
		944	Font.Name := Screen.Fonts.Strings[Index];
		945	//Font.Size := seSize.AsInteger;
		946	FillRect(Rect);
		947	TextOut(Rect.Left, Rect.Top, PChar(Screen.Fonts.Strings[Index]))
		948	end;
		949	end;
		950
		951	procedure TDXGlueItEditor.pnlFGClick(Sender: TObject);
		952	begin
		953	ColorDialog.Color := (Sender as TPanel).Color;
		954	if ColorDialog.Execute then
		955	(Sender as TPanel).Color := ColorDialog.Color;
		956	end;
		957
		958	procedure TDXGlueItEditor.btnAllCharsClick(Sender: TObject);
		959	var
		960	I: Integer;
		961	S: string;
		962	begin
		963	S := '';
		964	for I := 0 to 255 do
		965	if Char(I) < ' ' then S := S + ' ' else S := S + Char(I);
		966	memAlphabet.Lines.Add(S);
		967	end;
		968
		969	procedure TDXGlueItEditor.Image1MouseDown(Sender: TObject; Button: TMouseButton;
		970	Shift: TShiftState; X, Y: Integer);
		971	begin
		972	if ssShift in Shift then with Image1.Canvas do begin
		973	Brush.Color := panTColor.Color;
		974	Brush.Style := bsSolid;
		975	FloodFill(X, Y, Pixels[X, Y], fsSurface);
		976	end;
		977	end;
		978
		979	procedure TDXGlueItEditor.btnFontGenerateClick(Sender: TObject);
		980	var
		981	S, vizfntname: string;
		982	C: Double;
		983	Rz, vX, vY, I, absX, absY, V, X, Y, offC: Integer;
		984	B: TBitmap;
		985	LogFont: TLogFont;
		986	fnt: TFont;
		987	dib, alpha: TDIB;
		988	q, d: TPictureCollectionItem;
		989	begin
		990	{no preview}
		991	btnFontAnimationStop.Click;
		992	{private font def.}
		993	fnt := TFont.Create;
		994	try
		995	fnt.Assign(cbFontName.Font);
		996	V := eOpacity.AsInteger;
		997	fnt.Color := RGB(V, V, V); //0..255
		998	fnt.Name := cbFontName.Text;
		999	fnt.Size := FontSize.AsInteger;
		1000	fnt.Style := FFontStyles;
		1001	{antialiased/ttf}
		1002	if not cbAntialias.Checked then begin
		1003	GetObject(fnt.Handle, SizeOf(LogFont), Addr(LogFont));
		1004	with LogFont do begin
		1005	if cbAntialias.Checked then
		1006	lfQuality := ANTIALIASED_QUALITY
		1007	else
		1008	lfQuality := NONANTIALIASED_QUALITY;
		1009	lfOutPrecision := OUT_TT_ONLY_PRECIS;
		1010	end;
		1011	fnt.Handle := CreateFontIndirect(LogFont);
		1012	end;
		1013	{get set of chars}
		1014	S := TrimRight(memAlphabet.Lines.Text);
		1015	if S = '' then begin
		1016	btnAllChars.Click;
		1017	S := TrimRight(memAlphabet.Lines.Text);
		1018	end;
		1019	{target square}
		1020	C := Sqrt(Length(S));
		1021	Rz := Trunc(C);
		1022	if Frac(C) > 0 then Inc(Rz);
		1023	{generate mask font}
		1024	B := TBitmap.Create;
		1025	try
		1026	B.PixelFormat := pf8bit;
		1027	B.Canvas.Brush.Color := clBlack;
		1028	B.Canvas.Font.Assign(fnt);
		1029	{absolute sizes}
		1030	charArr := s;
		1031	SetLength(sizesArr, Length(charArr));
		1032	vY := B.Canvas.TextHeight(S); Zdvih := vY;
		1033	vX := 0;
		1034	for I := 0 to Length(S) - 1 do begin
		1035	sizesarr[I] := B.Canvas.TextWidth(S[I + 1]);
		1036	vX := Max(vX, sizesarr[I]);
		1037	end;
		1038
		1039	offC := eOffset.AsInteger;
		1040	vX := vX + offC;
		1041	vY := vY + offC;
		1042
		1043	absX := Rz * vX;
		1044	absY := Rz * vY;
		1045
		1046	B.Width := absX;
		1047	B.Height := absY;
		1048
		1049	B.Canvas.FillRect(Bounds(0, 0, B.Width, B.Height));
		1050	B.Canvas.Brush.Style := bsClear;
		1051	{shadow as offset}
		1052	if eOffset.AsInteger > 0 then
		1053	for I := 0 to Length(S) - 1 do begin
		1054	X := offC + (i mod Rz) * vX;
		1055	Y := offC + (i div Rz) * vY;
		1056	B.Canvas.TextOut(X, Y, S[I + 1]);
		1057	end;
		1058	{masked chars}
		1059	B.Canvas.Font.Color := clWhite;
		1060	for I := 0 to Length(S) - 1 do begin
		1061	X := (i mod Rz) * vX;
		1062	Y := (i div Rz) * vY;
		1063	B.Canvas.TextOut(X, Y, S[I + 1]);
		1064	end;
		1065	imgMask.Picture.Assign(B);
		1066	finally
		1067	B.Free;
		1068	end;
		1069	{generate font}
		1070	B := TBitmap.Create;
		1071	try
		1072	B.PixelFormat := pf24bit;
		1073	B.Width := absX;
		1074	B.Height := absY;
		1075	B.Canvas.Brush.Color := pnlBG.Color;
		1076	B.Canvas.Font.Assign(fnt);
		1077	B.Canvas.Font.Color := pnlFG.Color;
		1078	B.Width := absX;
		1079	B.Height := absY;
		1080	B.Canvas.FillRect(Bounds(0, 0, B.Width, B.Height));
		1081	B.Canvas.Brush.Style := bsClear;
		1082	for I := 0 to Length(S) - 1 do begin
		1083	X := (i mod Rz) * vX;
		1084	Y := (i div Rz) * vY;
		1085	B.Canvas.TextOut(X, Y, S[I + 1]);
		1086	end;
		1087	imgFont.Picture.Assign(B);
		1088	finally
		1089	B.Free;
		1090	end;
		1091	finally
		1092	vizfntname := fnt.name;
		1093	fnt.Free;
		1094	end;
		1095
		1096	Sources.Lines.Clear;
		1097	Sources.Lines.Add('{Generated constants for simple use of the font}');
		1098	Sources.Lines.Add('const');
		1099	Sources.Lines.Add(Format(' offsY = %d;', [Zdvih]));
		1100	Sources.Lines.Add(Format(' offYbyOrder: array [0..%d] of Integer = (', [Length(charArr) - 1]));
		1101	s := '';
		1102	for i := Low(sizesArr) to High(sizesArr) do
		1103	s := s + IntToStr(sizesArr[i]) + ', ';
		1104	Delete(s, Length(s) - 2, 2);
		1105	Sources.Lines.Add(s);
		1106	Sources.Lines.Add(');');
		1107
		1108	dib := TDIB.Create;
		1109	alpha := TDIB.Create;
		1110	try
		1111	alpha.Assign(imgMask.Picture.Bitmap);
		1112	dib.Assign(imgFont.Picture.Bitmap);
		1113	dib.AssignAlphaChannel(alpha);
		1114	{for preview}
		1115	FontDXImageList.Items.Clear;
		1116	q := TPictureCollectionItem(FontDXImageList.Items.Add);
		1117	q.Picture.Assign(dib);
		1118	q.Name := vizfntname;
		1119	q.PatternWidth := vX;
		1120	q.PatternHeight := vY;
		1121	q.Transparent := True;
		1122	q.TransparentColor := pnlBG.Color;
		1123	FontDXImageList.Items.Restore;
		1124	{showing}
		1125	Image1.Picture := nil;
		1126	Image1.Picture.Bitmap := dib.CreateBitmapFromDIB;
		1127	{for exchange with master thread}
		1128	DXImageList1.Items.Clear;
		1129	d := TPictureCollectionItem(DXImageList1.Items.Add);
		1130	d.Picture.Assign(dib);
		1131	d.Name := vizfntname;
		1132	d.PatternWidth := vX;
		1133	d.PatternHeight := vY;
		1134	d.Transparent := True;
		1135	d.TransparentColor := pnlBG.Color;
		1136	DXImageList1.Items.Restore;
		1137
		1138	finally
		1139	alpha.Free;
		1140	dib.Free;
		1141	end;
		1142	if PreviewMemo.Lines.Count > 0 then
		1143	btnFontAnimationStart.Click;
		1144	end;
		1145
		1146	procedure TDXGlueItEditor.btnABoldClick(Sender: TObject);
		1147	begin
		1148	if btnABold.Down then FFontStyles := FFontStyles + [fsBold]
		1149	else FFontStyles := FFontStyles - [fsBold]
		1150	end;
		1151
		1152	procedure TDXGlueItEditor.btnAItalicClick(Sender: TObject);
		1153	begin
		1154	if btnAItalic.Down then FFontStyles := FFontStyles + [fsItalic]
		1155	else FFontStyles := FFontStyles - [fsItalic]
		1156	end;
		1157
		1158	procedure TDXGlueItEditor.btnAUnderlineClick(Sender: TObject);
		1159	begin
		1160	if btnAUnderline.Down then FFontStyles := FFontStyles + [fsUnderline]
		1161	else FFontStyles := FFontStyles - [fsUnderline]
		1162	end;
		1163
		1164	procedure TDXGlueItEditor.PreviewTimerTimer(Sender: TObject; LagCount: Integer);
		1165	var i, x, y, j: Integer;
		1166	s: string;
		1167	begin
		1168	if not PreviewDraw.CanDraw then Exit;
		1169
		1170	PreviewDraw.Surface.Fill(PreviewDraw.Surface.ColorMatch(pnlBG.Color));
		1171	PreviewDraw.BeginScene;
		1172	PreviewDraw.Surface.FillRect(Bounds(0, 0, PreviewDraw.Width, PreviewDraw.Height), pnlBG.Color);
		1173	y := 5;
		1174	for i := 0 to PreviewMemo.Lines.Count - 1 do begin
		1175	s := PreviewMemo.Lines[i];
		1176	x := 5;
		1177	for j := 1 to Length(s) do begin
		1178	FontDXImageList.Items[0].Draw(PreviewDraw.Surface, x, y, Ord(s[j]));
		1179	x := x + sizesarr[Ord(s[j])];
		1180	end;
		1181	y := y + Zdvih;
		1182	end;
		1183	PreviewDraw.EndScene;
		1184	PreviewDraw.Flip;
		1185	end;
		1186
		1187	procedure TDXGlueItEditor.PreviewMemoChange(Sender: TObject);
		1188	begin
		1189	PreviewTimer.Enabled := PreviewMemo.Lines.Text <> '';
		1190	end;
		1191
		1192	procedure TDXGlueItEditor.btnFontAnimationStopClick(Sender: TObject);
		1193	begin
		1194	PreviewTimer.Enabled := False;
		1195	PreviewDraw.Surface.FillRect(Bounds(0, 0, PreviewDraw.Width, PreviewDraw.Height), pnlBG.Color);
		1196	PreviewDraw.Flip;
		1197	end;
		1198
		1199	procedure TDXGlueItEditor.btnFontAnimationStartClick(Sender: TObject);
		1200	begin
		1201	PreviewTimer.Enabled := True;
		1202	end;
		1203
		1204	procedure TDXGlueItEditor.RestructuralizeWithResize(NewWidth, NewHeight: Integer; TranspColor: TColor = clMaroon);
		1205	var
		1206	C: Double;
		1207	Rz: Integer;
		1208	Q: TPictureCollectionItem;
		1209	IMG: TBitmap;
		1210	DIB: TDIB;
		1211	I, X, Y, dX, dY: Integer;
		1212	DDS: TDirectDrawSurface;
		1213	begin
		1214	dX := DXImageList1.Items[0].PatternWidth;
		1215	dY := DXImageList1.Items[0].PatternHeight;
		1216	if NewWidth <> dX then dX := NewWidth;
		1217	if NewHeight <> dY then dY := NewHeight;
		1218	{target square}
		1219	C := Sqrt(DXImageList1.Items[0].PatternCount);
		1220	Rz := Trunc(C);
		1221	if Frac(C) > 0 then Inc(Rz);
		1222	{new picture};
		1223	IMG := TBitmap.Create; {glued picture}
		1224	DIB := TDIB.Create; {converted sub-image}
		1225	DDS := TDirectDrawSurface.Create(DXDraw1.DDraw); {dds}
		1226	DDS.SetSize(dX, dY);
		1227	{note: there occur error, when surface is not self, but nothing created}
		1228	{for this correct run has to set size as power two and must be remaps to mesh}
		1229	{or better simple turn off D3D acceleration}
		1230	{$IFDEF D3D_deprecated}
		1231	DXDraw1.Options := DXDraw1.Options - [do3d]; // dds may be any size
		1232	{$ENDIF}
		1233	try
		1234	IMG.Width := Rz * dX; {new size}
		1235	IMG.Height := Rz * dY;
		1236	IMG.PixelFormat := pf24bit; {implicit}
		1237	IMG.Canvas.Brush.Color := clMaroon; {fill it wit}
		1238	IMG.Canvas.FillRect(Bounds(0, 0, IMG.Width, IMG.Height)); {fill now}
		1239	{for all non restructuralized image}
		1240	for i := 0 to DXImageList1.Items[0].PatternCount - 1 do begin
		1241	{refill by transparent color as background}
		1242	DDS.Fill(DDS.ColorMatch(TranspColor));
		1243	{draw sub-image to dds}
		1244	DXImageList1.Items[0].Draw(DDS, 0, 0, i);
		1245	{convert to dib}
		1246	DIB.Assign(DDS);
		1247	{draw to new position}
		1248	X := (i mod Rz) * dX;
		1249	Y := (i div Rz) * dY;
		1250	IMG.Canvas.Draw(X, Y, DIB)
		1251	end;
		1252	{for preview}
		1253	Image1.Picture.Assign(IMG);
		1254	{to collection item}
		1255	Q := TPictureCollectionItem(DXImageList1.Items.Add);
		1256	Q.Picture.Assign(IMG);
		1257	Q.PatternWidth := dX;
		1258	Q.PatternHeight := dY;
		1259	Q.Name := DXImageList1.Items[0].Name; //it has to have name
		1260	Q.Transparent := DXImageList1.Items[0].Transparent;
		1261	Q.TransparentColor := DXImageList1.Items[0].TransparentColor;
		1262	{original image get out}
		1263	{$IFNDEF VER5UP}
		1264	DXImageList1.Items[0].Free;
		1265	{$ELSE}
		1266	DXImageList1.Items.Delete(0);
		1267	{$ENDIF}
		1268	{Indispensability restore}
		1269	DXImageList1.Items.Restore;
		1270	finally
		1271	{freeing resources}
		1272	IMG.Free;
		1273	DIB.Free;
		1274	DDS.Free;
		1275	{$IFDEF D3D_deprecated}
		1276	DXDraw1.Options := DXDraw1.Options + [do3d];
		1277	{$ENDIF}
		1278	end;
		1279	end;
		1280
		1281	procedure TDXGlueItEditor.btnReplaceClick(Sender: TObject);
		1282	begin
		1283	if DXImageList1.Items.Count > 0 then
		1284	if (ePatternWidth.AsInteger > 0) and (ePatternHeight.AsInteger > 0) then begin
		1285	{must be set subimage first}
		1286	if DXImageList1.Items[0].PatternWidth <> ePatternWidth.AsInteger then
		1287	DXImageList1.Items[0].PatternWidth := ePatternWidth.AsInteger;
		1288	if DXImageList1.Items[0].PatternHeight <> ePatternHeight.AsInteger then
		1289	DXImageList1.Items[0].PatternHeight := ePatternHeight.AsInteger;
		1290
		1291	DXImageList1.Items.Restore;
		1292	RestructuralizeWithResize(DXImageList1.Items[0].PatternWidth,
		1293	DXImageList1.Items[0].PatternHeight, panTColor.Color);
		1294	end
		1295	else
		1296	MessageDlg('Please set subimage size first!', mtConfirmation, [mbOK], 0);
		1297	end;
		1298
		1299	procedure TDXGlueItEditor.btnResizeClick(Sender: TObject);
		1300	begin
		1301	if DXImageList1.Items.Count > 0 then {contain image}
		1302	if (ePatternWidth.AsInteger > 0) and (ePatternHeight.AsInteger > 0) then begin
		1303	{must be set subimage first}
		1304	if DXImageList1.Items[0].PatternWidth <> ePatternWidth.AsInteger then
		1305	DXImageList1.Items[0].PatternWidth := ePatternWidth.AsInteger;
		1306	if DXImageList1.Items[0].PatternHeight <> ePatternHeight.AsInteger then
		1307	DXImageList1.Items[0].PatternHeight := ePatternHeight.AsInteger;
		1308
		1309	DXImageList1.Items.Restore;
		1310	RestructuralizeWithResize(ePatternWidth.AsInteger, ePatternHeight.AsInteger, panTColor.Color);
		1311	end
		1312	else
		1313	MessageDlg('Please set subimage size first!', mtConfirmation, [mbOK], 0);
		1314	end;
		1315
		1316	procedure TDXGlueItEditor.ActionList1Update(Action: TBasicAction;
		1317	var Handled: Boolean);
		1318	begin
		1319	btnAllChars.Enabled := Trim(memAlphabet.Lines.Text) = '';
		1320	acDeleteAll.Enabled := ListBox1.Items.Count > 0;
		1321	acDeleteOne.Enabled := ListBox1.ItemIndex <> -1;
		1322	acSaveToFile.Enabled := not Image1.Picture.Bitmap.Empty;
		1323	acGlueIt.Enabled := ListBox1.Items.Count > 0;
		1324	btnGetTransparentcolor.Enabled := not Image1.Picture.Bitmap.Empty;
		1325	end;
		1326
		1327	procedure TDXGlueItEditor.chbZoomOutClick(Sender: TObject);
		1328	begin
		1329	if (Sender as TCheckBox).Checked then Image1.OnMouseMove := Image1MouseMove
		1330	else Image1.OnMouseMove := nil;
		1331	end;
		1332
		1333	procedure TDXGlueItEditor.Image1MouseMove(Sender: TObject;
		1334	Shift: TShiftState; X, Y: Integer);
		1335	var
		1336	Srect, Drect: TRect;
		1337	iWidth, iHeight, DmX, DmY: Integer;
		1338	iTmpX, iTmpY: Real;
		1339	C: TCanvas;
		1340	hDesktop: Hwnd;
		1341	dx, dy: Integer;
		1342	PP: TPoint;
		1343	begin
		1344	PP := Image1.ClientToScreen(Point(X, Y));
		1345	dx := PP.x;
		1346	dy := PP.y;
		1347	hDesktop := GetDesktopWindow;
		1348
		1349	iWidth := Image2.Width;
		1350	iHeight := Image2.Height;
		1351	Drect := Rect(0, 0, iWidth, iHeight);
		1352	iTmpX := iWidth / (Slider.Position * 4);
		1353	iTmpY := iHeight / (Slider.Position * 4);
		1354	Srect := Rect(dx, dy, dx, dy);
		1355	InflateRect(Srect, Round(iTmpX), Round(iTmpY));
		1356
		1357	if Srect.Left < 0 then OffsetRect(Srect, -Srect.Left, 0);
		1358	if Srect.Top < 0 then OffsetRect(Srect, 0, -Srect.Top);
		1359	if Srect.Right > Screen.Width then OffsetRect(Srect, -(Srect.Right - Screen.Width), 0);
		1360	if Srect.Bottom > Screen.Height then OffsetRect(Srect, 0, -(Srect.Bottom - Screen.Height));
		1361
		1362	C := TCanvas.Create;
		1363	try
		1364	C.Handle := GetDC(GetDesktopWindow);
		1365	Image2.Canvas.CopyRect(Drect, C, Srect);
		1366	finally
		1367	ReleaseDC(hDesktop, C.Handle);
		1368	C.Free;
		1369	end;
		1370	with Image2.Canvas do begin
		1371	DmX := Slider.Position * 2 * (dX - Srect.Left);
		1372	DmY := Slider.Position * 2 * (dY - Srect.Top);
		1373	MoveTo(DmX - (iWidth div 4), DmY); // -
		1374	LineTo(DmX + (iWidth div 4), DmY); // -
		1375	MoveTo(DmX, DmY - (iHeight div 4)); // \|
		1376	LineTo(DmX, DmY + (iHeight div 4)); // \|
		1377	end;
		1378	end;
		1379
		1380	procedure TDXGlueItEditor.mainPageControlChange(Sender: TObject);
		1381	begin
		1382	Image2.Visible := mainPageControl.ActivePage = tsPreview;
		1383	end;
		1384
		1385	procedure TDXGlueItEditor.SetOperationGlueIt(const Value: TOperationGlueIt);
		1386	begin
		1387	FOperationGlueIt := Value;
		1388	if FOperationGlueIt = ogiNew then
		1389	mainPageControl.ActivePage := tsGlueIt
		1390	else
		1391	mainPageControl.ActivePage := tsPreview;
		1392	end;
		1393
		1394	procedure TDXGlueItEditor.btnGetTransparentcolorClick(Sender: TObject);
		1395	begin
		1396	SelectionOfTransparentColor := (Sender as TSpeedButton).Down;
		1397	end;
		1398
		1399	procedure TDXGlueItEditor.Image1MouseUp(Sender: TObject; Button: TMouseButton;
		1400	Shift: TShiftState; X, Y: Integer);
		1401	begin
		1402	if SelectionOfTransparentColor then begin
		1403	panTColor.Color := Image1.Picture.Bitmap.Canvas.Pixels[X, Y];
		1404	btnGetTransparentcolor.Down := False;
		1405	SelectionOfTransparentColor := False;
		1406	end;
		1407	end;
		1408
		1409	procedure TDXGlueItEditor.acGetTransparentExecute(Sender: TObject);
		1410	begin
		1411	SelectionOfTransparentColor := (Sender as TSpeedButton).Down;
		1412	end;
		1413
		1414	procedure TDXGlueItEditor.chbForceSizeClick(Sender: TObject);
		1415	begin
		1416	EWidthOfImages.Enabled := chbForceSize.Checked;
		1417	LWidthOfImages.Enabled := chbForceSize.Checked;
		1418	EHeightOfImages.Enabled := chbForceSize.Checked;
		1419	LHeightOfImages.Enabled := chbForceSize.Checked;
		1420	chbCentered.Enabled := chbForceSize.Checked;
		1421	chbCrop.Enabled := chbForceSize.Checked;
		1422	end;
		1423
		1424	procedure TDXGlueItEditor.cbEffectsListChange(Sender: TObject);
		1425	begin
		1426	if cbEffectsList.ItemIndex <> -1 then
		1427	if Image1.Picture.Bitmap.Empty then begin
		1428	ShowMessage('Image has not to be empty for effects!');
		1429	cbEffectsList.ItemIndex := -1;
		1430	//tmpBitmap.Assign(Image1.Picture.Bitmap);
		1431	end;
		1432	end;
		1433
		1434	procedure TDXGlueItEditor.pbDurationMouseDown(Sender: TObject;
		1435	Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
		1436	begin
		1437	if chbAutoAply.Checked then
		1438	if not Image1.Picture.Bitmap.Empty then begin
		1439	tmpPicture.Assign(Image1.Picture.Bitmap); //save default image
		1440	if not tmpPicture.Graphic.Empty then begin
		1441	DoBitmapEffect(tmpPicture);
		1442	Application.ProcessMessages;
		1443	end;
		1444	end;
		1445	end;
		1446
		1447	procedure TDXGlueItEditor.pbDurationMouseUp(Sender: TObject;
		1448	Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
		1449	begin
		1450	if chbAutoAply.Checked then
		1451	if not Image1.Picture.Bitmap.Empty then
		1452	if (MessageDlg('Do you want make changes permanent?', mtConfirmation, [mbYes, mbNo], 0) = mrNo) then
		1453	Image1.Picture.Bitmap.Assign(tmpPicture); //restore default image
		1454	end;
		1455
		1456	procedure TDXGlueItEditor.chbAutoAplyClick(Sender: TObject);
		1457	begin
		1458	btnApply.Enabled := not chbAutoAply.Checked;
		1459	end;
		1460
		1461	end.

Subversion Repositories spacemission

spacemission/VCL_DELPHIX_D6/DXGlueItEdit.pas – Rev 4