Subversion Repositories spacemission

Rev

Blame | Last modification | View Log | RSS feed

  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.
  1462.