//------------------------------------------------------------------------------ // ImageEn Convert To & Lossless Transform Demo: 1.0 //------------------------------------------------------------------------------ unit FrmMain; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, ToolWin, ExtCtrls, Dialogs, Buttons, ImgList, StdActns, ActnList, Menus, ComCtrls, Printers, IEView, IEOpenSaveDlg, ImageEnView, ImageEnIO, ImageEnProc, HYIEutils, HYIEdefs, iexBitmaps, iesettings, iexLayers, iexRulers; type TFormMain = class ( TForm ) ActionList1: TActionList; FileNew1: TAction; FileOpen1: TAction; FileClose1: TWindowClose; FileSave1: TAction; FileSaveAs1: TAction; FileExit1: TAction; EditCopy1: TEditCopy; EditPaste1: TEditPaste; HelpAbout1: TAction; EditCrop1: TAction; EditUndo1: TAction; ProgressBar1: TProgressBar; EditCut1: TAction; OpenImageEnDialog1: TOpenImageEnDialog; SaveImageEnDialog1: TSaveImageEnDialog; SelectZoom1: TAction; SelectRect1: TAction; SelectMove1: TAction; SelectCircle1: TAction; SelectPolygon1: TAction; SelectNone1: TAction; ImageGrayScale1: TAction; Image16Color1: TAction; Image256Color1: TAction; ImageTrueColor1: TAction; ImageBW1: TAction; ImageEffects1: TAction; ImageBrightness1: TAction; ImageCalcColors1: TAction; ImageResize1: TAction; ImageResample1: TAction; ViewFullScreen1: TAction; ImageVertFlip1: TAction; ImageHorzFlip1: TAction; ImageRotateRight1: TAction; ImageRotateLeft1: TAction; PrinterSetupDialog1: TPrinterSetupDialog; PrintSetup1: TAction; Print1: TAction; EditPasteSelection1: TAction; EditPasteNew1: TAction; FileProperties1: TAction; ImageProperties1: TAction; PrintPreview1: TAction; SelectMagicWand1: TAction; SelectLasso1: TAction; ImageList1: TImageList; PrinterSetupDialog2: TPrinterSetupDialog; ViewReset1: TAction; ViewFit1: TAction; EditResetUndo1: TAction; FontDialog1: TFontDialog; ColorDialog1: TColorDialog; TrackBarZoom: TTrackBar; EditPaste2: TAction; CoolBar1: TCoolBar; ToolBar1: TToolBar; ToolButton1: TToolButton; ToolBar2: TToolBar; ToolButton2: TToolButton; ToolButton4: TToolButton; ToolButton6: TToolButton; ToolButton7: TToolButton; ToolButton8: TToolButton; ToolButton9: TToolButton; ToolButton11: TToolButton; ToolButton13: TToolButton; ToolButton14: TToolButton; ToolButton15: TToolButton; ToolButton16: TToolButton; ToolButton17: TToolButton; ToolButton18: TToolButton; ToolButton19: TToolButton; ToolButton20: TToolButton; ToolButton21: TToolButton; MainMenu1: TMainMenu; File1: TMenuItem; Edit1: TMenuItem; Select1: TMenuItem; View1: TMenuItem; Colors1: TMenuItem; Image1: TMenuItem; Help1: TMenuItem; New2: TMenuItem; Open2: TMenuItem; N1: TMenuItem; Close2: TMenuItem; N2: TMenuItem; Save2: TMenuItem; SaveAs2: TMenuItem; N3: TMenuItem; Properties2: TMenuItem; N4: TMenuItem; Print2: TMenuItem; PrintSetup2: TMenuItem; N5: TMenuItem; Exit2: TMenuItem; Copy2: TMenuItem; Paste1: TMenuItem; Pastetoselection2: TMenuItem; Pasteclipboardintonewimage2: TMenuItem; Pasteclipboardtoactiveimage2: TMenuItem; Crop1: TMenuItem; Undo1: TMenuItem; N6: TMenuItem; N7: TMenuItem; SelectAll1: TMenuItem; UnSelectAll1: TMenuItem; SelectNone11: TMenuItem; SelectRect12: TMenuItem; SelectCircle11: TMenuItem; Polygon1: TMenuItem; MagicWand1: TMenuItem; Lasso1: TMenuItem; Move1: TMenuItem; Zoom1: TMenuItem; N8: TMenuItem; WandTolerance1: TMenuItem; Fit1: TMenuItem; Reset1: TMenuItem; FullScreen1: TMenuItem; N9: TMenuItem; Properties3: TMenuItem; BlackWhite1: TMenuItem; GrayScale2: TMenuItem; N16Color2: TMenuItem; N256Color1: TMenuItem; rueColor1: TMenuItem; N10: TMenuItem; CalculateNumberofImageColors1: TMenuItem; About1: TMenuItem; ToolButton47: TToolButton; SelectPopupMenu: TPopupMenu; FlipPopupMenu1: TPopupMenu; RotatePopupMenu1: TPopupMenu; PopupMenu1: TPopupMenu; Rectangle1: TMenuItem; Circle1: TMenuItem; Polygon3: TMenuItem; MagicWand2: TMenuItem; Lasso2: TMenuItem; N13: TMenuItem; Move2: TMenuItem; Zoom2: TMenuItem; N14: TMenuItem; SelectNone2: TMenuItem; Vertical2: TMenuItem; Horzontal2: TMenuItem; Left3: TMenuItem; Right2: TMenuItem; Close3: TMenuItem; N15: TMenuItem; Cut1: TMenuItem; Copy3: TMenuItem; Pasteclipboardtoactiveimage3: TMenuItem; Pasteclipboardintonewimage3: TMenuItem; Pastetoselection3: TMenuItem; Undo3: TMenuItem; N16: TMenuItem; Open3: TMenuItem; Save3: TMenuItem; SaveAs3: TMenuItem; N17: TMenuItem; Properties4: TMenuItem; Effects2: TMenuItem; Color1: TMenuItem; Brightness1: TMenuItem; N18: TMenuItem; Exit3: TMenuItem; StatusBar1: TStatusBar; EditRedo1: TAction; EditResetRedo1: TAction; Crop2: TMenuItem; ToolButton37: TToolButton; PopupMenu2: TPopupMenu; Pastetoselection1: TMenuItem; Pasteclipboardintonewimage1: TMenuItem; Pasteclipboardtoactiveimage1: TMenuItem; Image256IEOrdered1: TAction; ransparentColor1: TMenuItem; SelectWandTolerance1: TAction; N11: TMenuItem; Select2: TMenuItem; Rectangle2: TMenuItem; Circle2: TMenuItem; Polygon4: TMenuItem; MagicWand3: TMenuItem; Lasso3: TMenuItem; Zoom3: TMenuItem; N12: TMenuItem; None1: TMenuItem; ImageColorAdjust1: TAction; ImageColorAdjust2: TMenuItem; Effects1: TMenuItem; PopupMenuUndo: TPopupMenu; Undo2: TMenuItem; PopupMenuRedo: TPopupMenu; EditRedo12: TMenuItem; Redo1: TMenuItem; N20: TMenuItem; ImageEnView1: TImageEnView; ImageImageConvertTo24Bit1: TAction; ImageConvertTo8Bit1: TAction; Convertto8bitImage1: TMenuItem; ImageConvertto24bitImage1: TMenuItem; N21: TMenuItem; ImageDoPreviews1: TAction; ImageDoPreviews2: TMenuItem; SelectionProperties1: TAction; SelectionProperties11: TMenuItem; N22: TMenuItem; ImageRotate1: TAction; N19: TMenuItem; Rotate1: TMenuItem; Rotate2: TMenuItem; Left1: TMenuItem; Right1: TMenuItem; ResizeImage1: TMenuItem; ResizeImage2: TMenuItem; ToolButton3: TToolButton; ToolButton5: TToolButton; ImageLosslessTransform1: TAction; LosslessTransform1: TMenuItem; procedure ActionList1Update(Action: TBasicAction; var Handled: Boolean); procedure FileNew1Execute ( Sender: TObject ); procedure FileOpen1Execute ( Sender: TObject ); procedure FileSave1Execute ( Sender: TObject ); procedure FileSaveAs1Execute ( Sender: TObject ); procedure EditCopy1Execute ( Sender: TObject ); procedure EditCrop1Execute ( Sender: TObject ); procedure EditUndo1Execute ( Sender: TObject ); procedure FileExit1Execute ( Sender: TObject ); procedure FormCreate ( Sender: TObject ); procedure HelpAbout1Execute ( Sender: TObject ); procedure ImageEnViewProgress ( Sender: TObject;per: Integer ); procedure EditCut1Execute ( Sender: TObject ); procedure SelectPolygon1Execute ( Sender: TObject ); procedure SelectNone1Execute ( Sender: TObject ); procedure ImageTrueColor1Execute ( Sender: TObject ); procedure Image256Color1Execute ( Sender: TObject ); procedure Image16Color1Execute ( Sender: TObject ); procedure ImageBW1Execute ( Sender: TObject ); procedure ColorAdjust1Click ( Sender: TObject ); procedure ImageEffects1Execute ( Sender: TObject ); procedure ImageBrightness1Execute ( Sender: TObject ); procedure ImageCalcColors1Execute ( Sender: TObject ); procedure ImageResize1Execute ( Sender: TObject ); procedure ImageResample1Execute ( Sender: TObject ); procedure ViewFullScreen1Execute ( Sender: TObject ); procedure ImageVertFlip1Execute ( Sender: TObject ); procedure ImageHorzFlip1Execute ( Sender: TObject ); procedure ImageRotateRight1Execute ( Sender: TObject ); procedure ImageRotateLeft1Execute ( Sender: TObject ); procedure PrintSetup1Execute ( Sender: TObject ); procedure Print1Execute ( Sender: TObject ); procedure EditPasteSelection1Execute ( Sender: TObject ); procedure EditPasteNew1Execute ( Sender: TObject ); procedure FileProperties1Execute ( Sender: TObject ); procedure FormKeyDown ( Sender: TObject;var Key: Word; Shift: TShiftState ); procedure SelectMagicWand1Execute ( Sender: TObject ); procedure FormDestroy ( Sender: TObject ); procedure BlackandWhite1Click ( Sender: TObject ); procedure Properties12Click ( Sender: TObject ); procedure Setup1Click ( Sender: TObject ); procedure TrackBarZoomChange ( Sender: TObject ); procedure ViewReset1Execute ( Sender: TObject ); procedure EditResetUndo1Execute ( Sender: TObject ); procedure EditPaste2Execute ( Sender: TObject ); procedure OptionsSelection1Execute ( Sender: TObject ); procedure Rectangle1Click ( Sender: TObject ); procedure Circle1Click ( Sender: TObject ); procedure Polygon3Click ( Sender: TObject ); procedure MagicWand2Click ( Sender: TObject ); procedure Lasso2Click ( Sender: TObject ); procedure Move2Click ( Sender: TObject ); procedure Zoom2Click ( Sender: TObject ); procedure SelectRect1Execute ( Sender: TObject ); procedure SelectCircle1Execute ( Sender: TObject ); procedure SelectLasso1Execute ( Sender: TObject ); procedure SelectMove1Execute ( Sender: TObject ); procedure SelectZoom1Execute ( Sender: TObject ); procedure Button7Click ( Sender: TObject ); procedure ImageGrayScale1Execute ( Sender: TObject ); procedure SelectWandTolerance1Execute ( Sender: TObject ); procedure ImageColorAdjust1Execute ( Sender: TObject ); procedure ToolButton19Click ( Sender: TObject ); procedure EditRedo1Execute ( Sender: TObject ); procedure ImageEnView1DblClick ( Sender: TObject ); procedure ImageEnView1ViewChange ( Sender: TObject;Change: Integer ); procedure ImageEnView1MouseDown ( Sender: TObject;Button: TMouseButton; Shift: TShiftState;X, Y: Integer ); procedure ImageEnView1ImageChange ( Sender: TObject ); procedure Image256IEOrdered1Execute ( Sender: TObject ); procedure ImageConvertTo8Bit1Execute ( Sender: TObject ); procedure ImageImageConvertTo24Bit1Execute ( Sender: TObject ); procedure ImageDoPreviews1Execute ( Sender: TObject ); procedure SelectionProperties1Execute ( Sender: TObject ); procedure FormShow ( Sender: TObject ); procedure ImageRotate1Execute(Sender: TObject); procedure ImageLosslessTransform1Execute(Sender: TObject); procedure ViewFit1Execute(Sender: TObject); private { Private declarations } fDefaultExtension: string; fFilename: string; fSaveAs: boolean; fInternalChange : Boolean; procedure ShowHint ( Sender: TObject ); procedure ShowIOParams ( Params: TIOParams ); // get image info from file procedure ShowPropertyIOParams ( params: TIOParams ); procedure UpdateUndoMenu; public { Public declarations } fPathFilename: string; fDefaultFolder: string; end; var FormMain: TFormMain; implementation uses INIFiles, GifLZW, TIFLZW, ImageEn, frmFullscrn, Clipbrd, ShellApi, Math, frmConvBW, frmresres, frmPropDlg, frmSelection, frmRotate, frmLosslessTransform; {$R *.DFM} {$R WindowsTheme.res} function PixelFormatToColors ( PixelFormat: TIEPixelFormat ): string; begin case PixelFormat of ie1g : Result := '2 color'; ie8p : Result := '256 color'; ie8g : Result := '8 Bit (Gray scale)'; ie16g : Result := '16 Bit (Gray scale)'; ie24RGB : Result := '24 Bit (True color)'; ie32RGB : Result := '32 Bit (True color)'; else Result := 'Unknown'; end; end; procedure TFormMain.FormCreate ( Sender: TObject ); var MyIniFile: TIniFile; begin OpenImageEnDialog1.Filename := ''; OpenImageEnDialog1.FilterIndex := 1; Application.OnHint := ShowHint; // Get form state from ini file MyIniFile := TIniFile.Create ( ChangeFileExt ( Application.ExeName, '.ini' ) ); fDefaultFolder := ExtractFilePath ( Application.EXEName ); try Left := MyIniFile.ReadInteger ( 'Main Form', 'Left', 0 ); Top := MyIniFile.ReadInteger ( 'Main Form', 'Top', 0 ); Width := MyIniFile.ReadInteger ( 'Main Form', 'Width', 700 ); Height := MyIniFile.ReadInteger ( 'Main Form', 'Height', 500 ); WindowState := TWindowState ( MyIniFile.ReadInteger ( 'Main Form', 'Window State', 0 ) ); finally MyIniFile.Free; end; // Set Chessboard style ImageEnView1.SetChessboardStyle ( 6, bsSolid ); // mouse wheel will scroll image of 15 % of component height ImageEnView1.MouseWheelParams.Action := iemwVScroll; ImageEnView1.MouseWheelParams.Variation := iemwPercentage; ImageEnView1.MouseWheelParams.Value := 15; // set scrollbar params to match wheel ImageEnView1.HScrollBarParams.LineStep := 15; ImageEnView1.VScrollBarParams.LineStep := 15; ImageEnView1.IO.OnProgress := ImageEnViewProgress; ImageEnView1.Blank; end; // Save form state to ini file procedure TFormMain.FormDestroy ( Sender: TObject ); var MyIniFile: TIniFile; begin MyIniFile := TIniFile.Create ( ChangeFileExt ( Application.ExeName, '.ini' ) ); try MyIniFile.WriteInteger ( 'Main Form', 'Left', Left ); MyIniFile.WriteInteger ( 'Main Form', 'Top', Top ); MyIniFile.WriteInteger ( 'Main Form', 'Width', Width ); MyIniFile.WriteInteger ( 'Main Form', 'Height', Height ); MyIniFile.WriteInteger ( 'Main Form', 'Window State', Integer ( TWindowState ( WindowState ) ) ); finally MyIniFile.Free; end; end; // setup selection styles procedure TFormMain.FormShow ( Sender: TObject ); begin ImageEnView1.SetSelectionGripStyle ( SelectionDialog.ColorBoxColor1.Selected, SelectionDialog.ColorBoxColor2.Selected, bsSolid, SelectionDialog.UpDownSize.Position, SelectionDialog.CheckBoxExtendedSelectionDrawing.Checked ); ImageEnView1.SelColor1 := SelectionDialog.ColorBoxColor1.Selected; ImageEnView1.SelColor2 := SelectionDialog.ColorBoxColor2.Selected; end; // undo procedure TFormMain.EditUndo1Execute ( Sender: TObject ); begin // Undo with ImageEnView1.Proc do begin SaveRedoCaptioned ( UndoCaptions[0] ); // saves in Redo list Undo; ClearUndo; end; UpdateUndoMenu; ImageEnView1.Refresh; end; // new file procedure TFormMain.FileNew1Execute ( Sender: TObject ); begin try ImageEnView1.Proc.ClearUndo; ImageEnView1.Blank; // Show image dimensions StatusBar1.Panels[1].Text := ' Height: ' + IntToStr ( ImageEnView1.IEBitmap.Height ) + ' pixels' + ' Width: ' + IntToStr ( ImageEnView1.IEBitmap.Width ) + ' pixels '; finally StatusBar1.Panels[1].Text := ' '; end; end; function GetcColorString ( iBitsPerPixel: integer ): string; begin case iBitsPerPixel of 1: result := '2'; 2: result := '4'; 3: result := '16'; 4: result := '8'; 5: result := '32'; 6: result := '64'; 7: result := '128'; 8: result := '256'; 16: result := '65,536'; 24: result := '16 Million'; 32: result := '32 Million'; else result := 'Unknown'; end; end; procedure TFormMain.ShowHint ( Sender: TObject ); begin if Application.Hint <> '' then StatusBar1.Panels[0].Text := Application.Hint else StatusBar1.Panels[0].Text := ''; end; // get file params procedure TFormMain.ShowIOParams ( Params: TIOParams ); var ss: string; BitsPerPixel: integer; begin // Initalize string variable and filesize ss := ''; with Params do begin StatusBar1.Panels[1].Text := ' Height: ' + IntToStr ( ImageEnView1.IEBitmap.Height ) + ' pixels' + ' Width: ' + IntToStr ( ImageEnView1.IEBitmap.Width ) + ' pixels '; ss := 'ColorMapCount: ' + IntToStr ( ColorMapCount ) + ' '; StatusBar1.Panels[2].Text := ss; ss := 'BitsPerSample: ' + IntToStr ( BitsPerSample ) + ' '; StatusBar1.Panels[3].Text := ss; BitsPerPixel := BitsPerSample * SamplesPerPixel; ss := GetcColorString ( BitsPerPixel ) + ' colors'; StatusBar1.Panels[4].Text := ss; ss := 'FileType: ' + FileTypeStr + ' '; StatusBar1.Panels[5].Text := ss; end; end; // open file procedure TFormMain.FileOpen1Execute ( Sender: TObject ); begin OpenImageEnDialog1.FileName := ''; OpenImageEnDialog1.InitialDir := fDefaultFolder; OpenImageEnDialog1.DefaultExt := 'bmp'; // Open an image file if OpenImageEnDialog1.Execute then begin ImageEnView1.Proc.ClearAllUndo; ImageEnView1.Proc.ClearAllRedo; ImageEnView1.Cursor := crIECrossSight; // Set MouseInteract ImageEnView1.MouseInteract := ImageEnView1.MouseInteract + [miSelect]; // Set filename and path fFilename := ExtractFilename ( OpenImageEnDialog1.Filename ); fPathFilename := OpenImageEnDialog1.FileName; fDefaultFolder := ExtractFileDir ( fPathFilename ); // If file exists then load it if FileExists ( fPathFilename ) then begin // Show progress bar ProgressBar1.Visible := True; // Load the file ImageEnView1.IO.LoadFromFile ( fPathFilename ); // Set progress bar position to 0 and hide it ProgressBar1.Position := 0; ProgressBar1.Visible := False; ImageEnView1.IO.ParamsFromFile ( fPathFilename ); if ImageEnView1.IO.Params.FileType <> ioUnknown then ShowIOParams ( ImageEnView1.IO.Params ); end; end; end; // save file procedure TFormMain.FileSave1Execute ( Sender: TObject ); var ex: string; save: boolean; begin ProgressBar1.Visible := True; if fSaveAs then begin // Set filename fFilename := SaveImageEnDialog1.FileName; fPathFilename := SaveImageEnDialog1.FileName; end; // Get file type from image file ex := Lowercase ( ExtractFileExt ( fPathFilename ) ); if ( ex = '.gif' ) then begin if ImageEnView1.IO.DoPreviews ( [ppGIF] ) then begin ImageEnView1.IO.SaveToFileGif ( fPathFilename ); end; end else // do io previews to set compression and color depth with ImageEnView1.IO do begin Save := False; if ( ex = '.jp2' ) or ( ex = '.jp2000' ) then save := DoPreviews ( [ppJ2000] ); if ( ex = '.jpg' ) or ( ex = '.jpeg' ) then save := DoPreviews ( [ppJPEG] ); if ( ex = '.tif' ) then save := DoPreviews ( [ppTIFF] ); if ( ex = '.bmp' ) then save := DoPreviews ( [ppBMP] ); if ( ex = '.gif' ) then save := DoPreviews ( [ppGIF] ); if ( ex = '.pcx' ) then save := DoPreviews ( [ppPCX] ); if ( ex = '.png' ) then save := DoPreviews ( [ppPNG] ); if ( ex = '.wmf' ) then begin MessageDlg ( 'Can not save to WMF file format.', mtInformation, [mbOK], 0 ); save := false; end; if ( ex = '.emf' ) then begin MessageDlg ( 'Can not save to EMF file format.', mtInformation, [mbOK], 0 ); save := false; end; if ( ex = '.ico' ) then begin MessageDlg ( 'Can not save to Icon file format.', mtInformation, [mbOK], 0 ); save := false; end; if ( ex = '.cur' ) then begin MessageDlg ( 'Can not save to Cursor file format.', mtInformation, [mbOK], 0 ); save := False; end; if save then begin // Save image to file SaveToFile ( fPathFilename ); // Set statusbar Statusbar1.Panels[0].Text := ' ' + ExtractFilename ( fPathFilename ) + ' '; end; ProgressBar1.Position := 0; ProgressBar1.Visible := False; end; end; // save as a new file procedure TFormMain.FileSaveAs1Execute ( Sender: TObject ); begin SaveImageEnDialog1.FileName := ''; SaveImageEnDialog1.DefaultExt := fDefaultExtension; SaveImageEnDialog1.InitialDir := fDefaultFolder; // Launch save image dialog if SaveImageEnDialog1.Execute then begin fSaveAs := True; // Set filename fFilename := SaveImageEnDialog1.FileName; fPathFilename := SaveImageEnDialog1.FileName; fDefaultFolder := ExtractFileDir ( SaveImageEnDialog1.FileName ); // Execute filesave FileSave1Execute ( Self ); end; end; // close the app procedure TFormMain.FileExit1Execute ( Sender: TObject ); begin Close; end; // copy procedure TFormMain.EditCopy1Execute ( Sender: TObject ); begin if ImageEnView1.VisibleSelection then // Copy selection to clipboard ImageEnView1.Proc.SelCopyToClip else ImageEnView1.Proc.CopyToClipboard; end; // crop procedure TFormMain.EditCrop1Execute ( Sender: TObject ); var ABitmap: TBitmap; begin if ImageEnView1.Selected then begin // Save undo file ImageEnView1.Proc.SaveUndoCaptioned ( 'Crop ' + IntToStr ( ImageEnView1.Proc.UndoCount ) ); ImageEnView1.Proc.ClearAllRedo; // Create a temp bitmap ABitmap := TBitmap.Create; try // Assign selection (crop) to Abitmap ImageEnView1.AssignSelTo ( ABitmap ); // Copy the bitmap back to the Image component ImageEnView1.Assign ( ABitmap ); ImageEnView1.Refresh; finally ABitmap.Free; end; UpdateUndoMenu; // Show image dimensions StatusBar1.Panels[1].Text := ' Height: ' + IntToStr ( ImageEnView1.IEBitmap.Height ) + ' pixels' + ' Width: ' + IntToStr ( ImageEnView1.IEBitmap.Width ) + ' pixels '; if ImageEnView1.Proc.UndoCount > 0 then StatusBar1.Panels[5].Text := 'Undo: ' + IntToStr ( ImageEnView1.Proc.UndoCount ) else StatusBar1.Panels[5].Text := ''; ImageEnView1.Invalidate; end else MessageDlg ( 'Please select an area of the image to crop.', mtInformation, [mbOK], 0 ); end; // show help about procedure TFormMain.HelpAbout1Execute ( Sender: TObject ); begin ShellAbout ( Application.Handle, 'ImageEn Convert To Demo', 'More info at: http://www.imageen.com', Application.Icon.Handle ); end; // show progress bar position procedure TFormMain.ImageEnViewProgress ( Sender: TObject;per: Integer ); begin // Show progressbar position ProgressBar1.Position := per; end; // cut procedure TFormMain.EditCut1Execute ( Sender: TObject ); begin // Save undo file ImageEnView1.Proc.SaveUndoCaptioned ( 'Cut ' + IntToStr ( ImageEnView1.Proc.UndoCount ) ); ImageEnView1.Proc.ClearAllRedo; // Cut selection to clipboard ImageEnView1.Proc.SelCutToClip; if ImageEnView1.Proc.UndoCount > 0 then StatusBar1.Panels[5].Text := 'Undo: ' + IntToStr ( ImageEnView1.Proc.UndoCount ) else StatusBar1.Panels[5].Text := ''; if ImageEnView1.IEBitmap.Modified then StatusBar1.Panels[6].Text := 'Modified' else StatusBar1.Panels[6].Text := ''; end; // show file properties procedure TFormMain.ShowPropertyIOParams ( params: TIOParamsVals ); var ss: string; mdim, bitcount: integer; fFileSize: integer; fFrames: integer; begin if assigned ( Params ) then begin with Params, PropertiesDlg do begin txtFilename.Caption := ''; txtSize.Caption := ''; txtColors.Caption := ''; txtMem.Caption := ''; txtFileType.Caption := ''; txtDPI.Caption := ''; txtDPIY.Caption := ''; txtColorMapCount.Caption := ''; ss := ExtractFilename ( fPathFilename ); txtFilename.Caption := ss; // Width X height pixel (frames) ss := IntToStr ( Params.Width ) + ' x ' + IntToStr ( Params.Height ) + ' pixel'; txtSize.Caption := ss; // Dpi ss := inttostr ( DpiX ) + ' x ' + inttostr ( DpiY ) + ' dpi'; txtDPI.Caption := ss; // Xxx colors if ( SamplesPerPixel = 4 ) and ( BitsPerSample = 8 ) then ss := ' 16 million colors ' else ss := IntToStr ( 1 shl ( SamplesPerPixel * BitsPerSample ) ); ss := ss + ' ' + iemsg ( IEMSG_COLORS ) + ' ('; ss := ss + IntToStr ( SamplesPerPixel * BitsPerSample ) + ' bit)'; txtColors.caption := ss; // File size fFileSize := IEGetFileSize ( fPathFilename ); if fFilesize <> -1 then if fFileSize < 1024 then ss := 'File: ' + inttostr ( fFileSize ) + ' bytes' else ss := 'File: ' + inttostr ( fFileSize div 1024 ) + ' Kb'; // Memory size if ( SamplesPerPixel = 1 ) and ( BitsPerSample = 1 ) then bitcount := 1 else bitcount := 24; fFrames := 1; mdim := ( ( ( Width * BitCount ) + 31 ) div 32 ) * 4 * height * fFrames; if mdim < 1024 then ss := ss + ' Mem: ' + inttostr ( mdim ) + ' bytes' else ss := ss + ' Mem: ' + inttostr ( mdim div 1024 ) + ' Kb'; // txtMem.Caption := ss; // Compression ss := FileTypeStr; txtFileType.Caption := ss; end; end else begin with PropertiesDlg do begin txtFilename.Caption := ''; txtSize.Caption := ''; txtColors.Caption := ''; txtMem.Caption := ''; txtFileType.Caption := ''; txtDPI.Caption := ''; txtDPIY.Caption := ''; txtColorMapCount.Caption := ''; end; end; end; // Select Polygon procedure TFormMain.SelectPolygon1Execute ( Sender: TObject ); begin // Select polygon ImageEnView1.MouseInteract := [miSelectPolygon]; ImageEnView1.Cursor := crIECrossSight; end; // Select MagicWand procedure TFormMain.SelectMagicWand1Execute ( Sender: TObject ); begin // Select magic wand ImageEnView1.MouseInteract := [miSelectMagicWand]; ImageEnView1.Cursor := crIECrossSight; end; // Select None procedure TFormMain.SelectNone1Execute ( Sender: TObject ); begin // Select none with ImageEnView1 do begin DeSelect; Cursor := crHandPoint; // Set mouseinteract MouseInteract := MouseInteract + [miScroll]; end; end; // ConvertTo24Bit procedure TFormMain.ImageTrueColor1Execute ( Sender: TObject ); begin // Save undo file ImageEnView1.Proc.SaveUndoCaptioned ( 'True Color ' + IntToStr ( ImageEnView1.Proc.UndoCount ) ); ImageEnView1.Proc.ClearAllRedo; // Show progressbar ProgressBar1.Visible := True; // convert image ImageEnView1.Proc.ConvertTo24Bit; ProgressBar1.Position := 0; ProgressBar1.Visible := False; ImageEnView1.Refresh; StatusBar1.Panels[4].Text := 'True Color ' + PixelFormatToColors ( ImageEnView1.IEBitmap.PixelFormat ); UpdateUndoMenu; end; // ConvertTo 256 procedure TFormMain.Image256Color1Execute ( Sender: TObject ); begin // Save undo file ImageEnView1.Proc.SaveUndoCaptioned ( '256 Color ' + IntToStr ( ImageEnView1.Proc.UndoCount ) ); ImageEnView1.Proc.ClearAllRedo; // Show progressbar ProgressBar1.Visible := True; // Convert to 256 colors ImageEnView1.Proc.ConvertTo ( 256, ieThreshold ); ProgressBar1.Position := 0; ProgressBar1.Visible := False; ImageEnView1.Refresh; StatusBar1.Panels[4].Text := '256 Color '; UpdateUndoMenu; end; // ConvertTo 16 procedure TFormMain.Image16Color1Execute ( Sender: TObject ); begin // Save undo file ImageEnView1.Proc.SaveUndoCaptioned ( '16 Color ' + IntToStr ( ImageEnView1.Proc.UndoCount ) ); ImageEnView1.Proc.ClearAllRedo; // Show progressbar ProgressBar1.Visible := True; // Convert to 16 colors ImageEnView1.Proc.ConvertTo ( 16 ); ProgressBar1.Position := 0; ProgressBar1.Visible := False; ImageEnView1.Refresh; StatusBar1.Panels[4].Text := '16 color '; UpdateUndoMenu; end; // ConvertToBW procedure TFormMain.ImageBW1Execute ( Sender: TObject ); begin // Save undo file ImageEnView1.Proc.SaveUndoCaptioned ( 'Black & White ' + IntToStr ( ImageEnView1.Proc.UndoCount ) ); ImageEnView1.Proc.ClearAllRedo; // Show progressbar ProgressBar1.Visible := True; // Show BW Dialog and process image with fConvBW do if ShowModal = mrOK then begin Application.ProcessMessages; case RadioGroup1.ItemIndex of 0: begin // Threshold if SpeedButton1.Down then ImageEnView1.Proc.ConvertToBWThreshold ( -1 ) else ImageEnView1.Proc.ConvertToBWThreshold ( strtointdef ( Edit1.Text, 0 ) ); end; 1: begin // Ordered ImageEnView1.Proc.ConvertToBWOrdered; end; end; end; ProgressBar1.Position := 0; ProgressBar1.Visible := False; ImageEnView1.Refresh; StatusBar1.Panels[4].Text := 'Black & White ' + PixelFormatToColors ( ImageEnView1.IEBitmap.PixelFormat ); UpdateUndoMenu; end; // ColorAdjust procedure TFormMain.ColorAdjust1Click ( Sender: TObject ); begin // Save undo file ImageEnView1.Proc.SaveUndoCaptioned ( 'Color Adjust ' + IntToStr ( ImageEnView1.Proc.UndoCount ) ); ImageEnView1.Proc.ClearAllRedo; // Show progress bar ProgressBar1.Visible := True; // Show color adjust dialog ImageEnView1.Proc.DoPreviews ( ppeColorAdjustments ); ProgressBar1.Position := 0; ProgressBar1.Visible := False; end; // ImageEffects procedure TFormMain.ImageEffects1Execute ( Sender: TObject ); begin // Save undo file ImageEnView1.Proc.SaveUndoCaptioned ( 'Effects ' + IntToStr ( ImageEnView1.Proc.UndoCount ) ); ImageEnView1.Proc.ClearAllRedo; if ImageEnView1.Proc.UndoCount > 0 then StatusBar1.Panels[5].Text := 'Undo: ' + IntToStr ( ImageEnView1.Proc.UndoCount ) else StatusBar1.Panels[5].Text := ''; if ImageEnView1.IEBitmap.Modified then StatusBar1.Panels[6].Text := 'Modified' else StatusBar1.Panels[6].Text := ''; // Show effects dialog if ImageEnView1.Proc.DoPreviews ( ppeSpecialEffects ) = True then UpdateUndoMenu; end; // ImageBrightness procedure TFormMain.ImageBrightness1Execute ( Sender: TObject ); begin // Save undo file ImageEnView1.Proc.SaveUndoCaptioned ( 'Brightness ' + IntToStr ( ImageEnView1.Proc.UndoCount ) ); ImageEnView1.Proc.ClearAllRedo; // Show progress bar ProgressBar1.Visible := True; // Show color adjust dialog ImageEnView1.Proc.DoPreviews ( ppeColorAdjustments ); // Set progress bar ProgressBar1.Position := 0; ProgressBar1.Visible := False; end; // CalcImageColors procedure TFormMain.ImageCalcColors1Execute ( Sender: TObject ); var nc: integer; begin // Calc # colors and show it nc := ImageEnView1.Proc.CalcImageNumColors; MessageDlg ( 'The active image has ' + IntToStr ( nc ) + ' colors.', mtInformation, [mbOK], 0 ); end; // ImageResize procedure TFormMain.ImageResize1Execute ( Sender: TObject ); begin // Save undo file ImageEnView1.Proc.SaveUndoCaptioned ( 'Resize Canvas ' + IntToStr ( ImageEnView1.Proc.UndoCount ) ); ImageEnView1.Proc.ClearAllRedo; // Setup resize dialog fResize.OrgWidth := ImageEnView1.IEBitmap.Width; fResize.OrgHeight := ImageEnView1.IEBitmap.Height; fResize.Caption := 'Canvas'; fResize.Caption := ' Canvas Size'; fResize.Resize := True; fResize.SpeedButtonLockPreview.Down := True; // Copy images to resize dialog fResize.ImageEnView1.Assign ( ImageEnView1.IEBitmap ); // Show resize dialog if fResize.ShowModal = mrOK then begin // Copy resized image back to main form ImageEnView1.IEBitmap.Assign ( fResize.ImageEnView2.IEBitmap ); ImageEnView1.Update; StatusBar1.Panels[1].Text := ' Height: ' + IntToStr ( ImageEnView1.IEBitmap.Height ) + ' pixels' + ' Width: ' + IntToStr ( ImageEnView1.IEBitmap.Width ) + ' pixels '; if ImageEnView1.IO.Params.FileType <> ioUnknown then ShowIOParams ( ImageEnView1.IO.Params ); if ImageEnView1.Proc.UndoCount > 0 then StatusBar1.Panels[5].Text := 'Undo: ' + IntToStr ( ImageEnView1.Proc.UndoCount ) else StatusBar1.Panels[5].Text := ''; if ImageEnView1.IEBitmap.Modified then StatusBar1.Panels[6].Text := 'Modified' else StatusBar1.Panels[6].Text := ''; end; end; // ImageResample procedure TFormMain.ImageResample1Execute ( Sender: TObject ); begin // Save undo file ImageEnView1.Proc.SaveUndoCaptioned ( 'Resample ' + IntToStr ( ImageEnView1.Proc.UndoCount ) ); ImageEnView1.Proc.ClearAllRedo; // Setup resize dialog fResize.OrgWidth := ImageEnView1.IEBitmap.Width; fResize.OrgHeight := ImageEnView1.IEBitmap.Height; fResize.Caption := 'Resize'; fResize.Caption := ' Resize (Resample) image'; fResize.Resize := False; fResize.Resample := True; fResize.Updown1.Position := ImageEnView1.IEBitmap.Width; fResize.Updown2.Position := ImageEnView1.IEBitmap.Height; fResize.SpeedButtonLockPreview.Down := True; // Copy images to resize dialog fResize.ImageEnView1.Assign ( ImageEnView1.IEBitmap ); // Show resize dialog if fResize.ShowModal = mrOK then begin // Copy resized image back to main form ImageEnView1.IEBitmap.Assign ( fResize.ImageEnView2.IEBitmap ); ImageEnView1.Update; end else begin // Reset progress bar, menu and status bar ProgressBar1.Position := 0; ProgressBar1.Visible := False; end; StatusBar1.Panels[1].Text := ' Height: ' + IntToStr ( ImageEnView1.IEBitmap.Height ) + ' pixels' + ' Width: ' + IntToStr ( ImageEnView1.IEBitmap.Width ) + ' pixels '; if ImageEnView1.IO.Params.FileType <> ioUnknown then ShowIOParams ( ImageEnView1.IO.Params ); if ImageEnView1.Proc.UndoCount > 0 then StatusBar1.Panels[5].Text := 'Undo: ' + IntToStr ( ImageEnView1.Proc.UndoCount ) else StatusBar1.Panels[5].Text := ''; if ImageEnView1.IEBitmap.Modified then StatusBar1.Panels[6].Text := 'Modified' else StatusBar1.Panels[6].Text := ''; end; // View FullScreen procedure TFormMain.ViewFullScreen1Execute ( Sender: TObject ); begin FullScreen := TFullScreen.Create ( Self ); try Screen.Cursor := crDefault; // Copy image to fullscreen image FullScreen.ImageEnView1.IEBitmap.Assign ( ImageEnView1.IEBitmap ); // Show the image fullscreen FullScreen.ShowModal; Screen.Cursor := crDefault; finally FullScreen.Free; end; Screen.Cursor := crDefault; end; // ImageVert Flip procedure TFormMain.ImageVertFlip1Execute ( Sender: TObject ); begin // Save undo file ImageEnView1.Proc.SaveUndoCaptioned ( 'Vertical Flip ' + IntToStr ( ImageEnView1.Proc.UndoCount ) ); ImageEnView1.Proc.ClearAllRedo; // set Image to active page ImageEnView1.IO.AttachedImageEn := ImageEnView1; // Flip it ImageEnView1.Proc.Flip ( fdVertical ); if ImageEnView1.Proc.UndoCount > 0 then StatusBar1.Panels[5].Text := 'Undo: ' + IntToStr ( ImageEnView1.Proc.UndoCount ) else StatusBar1.Panels[5].Text := ''; if ImageEnView1.IEBitmap.Modified then StatusBar1.Panels[6].Text := 'Modified' else StatusBar1.Panels[6].Text := ''; end; // ImageHorz Flip procedure TFormMain.ImageHorzFlip1Execute ( Sender: TObject ); begin // Save undo file ImageEnView1.Proc.SaveUndoCaptioned ( 'Horzontal Flip ' + IntToStr ( ImageEnView1.Proc.UndoCount ) ); ImageEnView1.Proc.ClearAllRedo; // Set image to active page ImageEnView1.IO.AttachedImageEn := ImageEnView1; // Flip it ImageEnView1.Proc.Flip ( fdHorizontal ); if ImageEnView1.Proc.UndoCount > 0 then StatusBar1.Panels[5].Text := 'Undo: ' + IntToStr ( ImageEnView1.Proc.UndoCount ) else StatusBar1.Panels[5].Text := ''; if ImageEnView1.IEBitmap.Modified then StatusBar1.Panels[6].Text := 'Modified' else StatusBar1.Panels[6].Text := ''; end; // ImageRotate Right procedure TFormMain.ImageRotateRight1Execute ( Sender: TObject ); begin // Save undo file ImageEnView1.Proc.SaveUndoCaptioned ( 'Rotate Right ' + IntToStr ( ImageEnView1.Proc.UndoCount ) ); ImageEnView1.Proc.ClearAllRedo; ProgressBar1.Visible := True; // Rotate the image, with antialiasing ImageEnView1.Proc.Rotate ( -90, ierFast ); ProgressBar1.Position := 0; ProgressBar1.Visible := False; if ImageEnView1.Proc.UndoCount > 0 then StatusBar1.Panels[5].Text := 'Undo: ' + IntToStr ( ImageEnView1.Proc.UndoCount ) else StatusBar1.Panels[5].Text := ''; if ImageEnView1.IEBitmap.Modified then StatusBar1.Panels[6].Text := 'Modified' else StatusBar1.Panels[6].Text := ''; UpdateUndoMenu; end; // ImageRotate Left procedure TFormMain.ImageRotateLeft1Execute ( Sender: TObject ); begin // Save undo file ImageEnView1.Proc.SaveUndoCaptioned ( 'Rotate Left ' + IntToStr ( ImageEnView1.Proc.UndoCount ) ); ImageEnView1.Proc.ClearAllRedo; ProgressBar1.Visible := True; // Rotate the image, with antialiasing ImageEnView1.Proc.Rotate ( 90, ierFast ); ProgressBar1.Position := 0; ProgressBar1.Visible := False; if ImageEnView1.Proc.UndoCount > 0 then StatusBar1.Panels[5].Text := 'Undo: ' + IntToStr ( ImageEnView1.Proc.UndoCount ) else StatusBar1.Panels[5].Text := ''; if ImageEnView1.IEBitmap.Modified then StatusBar1.Panels[6].Text := 'Modified' else StatusBar1.Panels[6].Text := ''; UpdateUndoMenu; end; procedure TFormMain.ActionList1Update(Action: TBasicAction; var Handled: Boolean); begin ViewFit1.Checked := ImageEnView1.AutoShrink; end; // PrintSetup procedure TFormMain.PrintSetup1Execute ( Sender: TObject ); begin PrinterSetupDialog1.Execute; end; // Print procedure TFormMain.Print1Execute ( Sender: TObject ); begin ImageEnView1.IO.DoPrintPreviewDialog(iedtDialog); end; // Paste Selection procedure TFormMain.EditPasteSelection1Execute ( Sender: TObject ); begin if Clipboard.HasFormat ( CF_PICTURE ) then begin // Save Undo file ImageEnView1.Proc.SaveUndoCaptioned ( 'Paste Selection ' + IntToStr ( ImageEnView1.Proc.UndoCount ) ); ImageEnView1.Proc.ClearAllRedo; // Paste from clipboard ImageEnView1.Proc.SelPasteFromClip( True, False, True ); if ImageEnView1.Proc.UndoCount > 0 then StatusBar1.Panels[5].Text := 'Undo: ' + IntToStr ( ImageEnView1.Proc.UndoCount ) else StatusBar1.Panels[5].Text := ''; if ImageEnView1.IEBitmap.Modified then StatusBar1.Panels[6].Text := 'Modified' else StatusBar1.Panels[6].Text := ''; UpdateUndoMenu; end else MessageDlg ( 'There is no image in the Clipboard.', mtInformation, [mbOK], 0 ); end; // PasteNew procedure TFormMain.EditPasteNew1Execute ( Sender: TObject ); var Bitmap: TBitmap; BMH, BMW: integer; begin if Clipboard.HasFormat ( CF_PICTURE ) then begin // Save Undo file ImageEnView1.Proc.SaveUndoCaptioned ( 'Paste New ' + IntToStr ( ImageEnView1.Proc.UndoCount ) ); ImageEnView1.Proc.ClearAllRedo; ImageEnView1.Blank; // Paste Bitmap := TBitmap.Create; { create bitmap to hold the contents on the Clipboard } try Bitmap.Assign ( Clipboard ); { get the bitmap off the Clipboard } BMH := Bitmap.Height; BMW := Bitmap.Width; ImageEnView1.Proc.ImageResize ( BMW, BMH ); ImageEnView1.Proc.PasteFromClipboard; ImageEnView1.Refresh; finally Bitmap.Free; end; UpdateUndoMenu; if ImageEnView1.Proc.UndoCount > 0 then StatusBar1.Panels[5].Text := 'Undo: ' + IntToStr ( ImageEnView1.Proc.UndoCount ) else StatusBar1.Panels[5].Text := ''; if ImageEnView1.IEBitmap.Modified then StatusBar1.Panels[6].Text := 'Modified' else StatusBar1.Panels[6].Text := ''; end else MessageDlg ( 'There is no image in the Clipboard.', mtInformation, [mbOK], 0 ); end; // FileProperties procedure TFormMain.FileProperties1Execute ( Sender: TObject ); begin with PropertiesDlg do begin ImageEn1.Assign ( ImageEnView1.IEBitmap ); ShowPropertyIOParams ( ImageEnView1.IO.Params ); ShowModal; end; end; procedure TFormMain.FormKeyDown ( Sender: TObject;var Key: Word; Shift: TShiftState ); begin if Key = vk_ESCAPE then begin TrackBarZoom.Position := 100; ImageEnView1.Zoom := 100; end; end; // BlackandWhite procedure TFormMain.BlackandWhite1Click ( Sender: TObject ); begin // Save undo file ImageEnView1.Proc.SaveUndoCaptioned ( 'Black && White ' + IntToStr ( ImageEnView1.Proc.UndoCount ) ); ImageEnView1.Proc.ClearAllRedo; // Show progressbar ProgressBar1.Visible := True; fConvBW := TfConvBW.Create ( Self ); try // Show BW Dialog and process image with fConvBW do if ShowModal = mrOK then begin Application.ProcessMessages; case RadioGroup1.ItemIndex of 0: begin // Threshold if SpeedButton1.Down then ImageEnView1.Proc.ConvertToBWThreshold ( -1 ) else ImageEnView1.Proc.ConvertToBWThreshold ( strtointdef ( Edit1.Text, 0 ) ); end; 1: begin // Ordered ImageEnView1.Proc.ConvertToBWOrdered; end; end; end; finally fConvBW.Free; end; ProgressBar1.Position := 0; ProgressBar1.Visible := False; end; // Properties procedure TFormMain.Properties12Click ( Sender: TObject ); begin with PropertiesDlg do begin if FileExists ( fPathFilename ) then begin ImageEn1.Assign ( ImageEnView1.IEBitmap ); ShowPropertyIOParams ( ImageEnView1.IO.Params ); ShowModal; end else MessageDlg ( 'Image must be opened from disk to enable properties dialog.', mtInformation, [mbOK], 0 ); end; end; // SetupPrinter procedure TFormMain.Setup1Click ( Sender: TObject ); begin PrinterSetupDialog1.Execute; end; // setup TrackBarZoom procedure TFormMain.TrackBarZoomChange ( Sender: TObject ); begin if fInternalChange then exit; // Show zoom change ImageEnView1.AutoShrink := False; ImageEnView1.Zoom := TrackBarZoom.Position; // Show hint TrackBarZoom.Hint := 'Zoom - ' + IntToStr ( TrackBarZoom.Position ) + '%'; Application.ActivateHint ( Mouse.CursorPos ); ImageEnView1.SetFocus; end; // Reset Zoom procedure TFormMain.ViewReset1Execute ( Sender: TObject ); begin TrackBarZoom.Position := 100; ImageEnView1.Zoom := 100; ViewFit1.Checked := false; end; // ResetUndo procedure TFormMain.EditResetUndo1Execute ( Sender: TObject ); begin ImageEnView1.Proc.ClearAllUndo; end; // UpdateUndoMenu procedure TFormMain.UpdateUndoMenu; begin with ImageEnView1.Proc do begin // Undo menu EditUndo1.Caption := '&Undo '; EditUndo1.Enabled := UndoCount > 0; if UndoCount > 0 then EditUndo1.Caption := '&Undo ' + UndoCaptions[0]; // Redo menu EditRedo1.Caption := '&Redo '; EditRedo1.Enabled := RedoCount > 0; if RedoCount > 0 then EditRedo1.Caption := '&Redo ' + RedoCaptions[0]; end; end; // Paste procedure TFormMain.EditPaste2Execute ( Sender: TObject ); begin if Clipboard.HasFormat ( CF_PICTURE ) then begin // save Undo file ImageEnView1.Proc.SaveUndoCaptioned ( 'Paste ' + IntToStr ( ImageEnView1.Proc.UndoCount ) ); ImageEnView1.Proc.ClearAllRedo; // paste ImageEnView1.Proc.PasteFromClipboard; if ImageEnView1.Proc.UndoCount > 0 then StatusBar1.Panels[5].Text := 'Undo: ' + IntToStr ( ImageEnView1.Proc.UndoCount ) else StatusBar1.Panels[5].Text := ''; if ImageEnView1.IEBitmap.Modified then StatusBar1.Panels[6].Text := 'Modified' else StatusBar1.Panels[6].Text := ''; end else MessageDlg ( 'There is no image in the Clipboard.', mtInformation, [mbOK], 0 ); end; // SelectionOptions procedure TFormMain.OptionsSelection1Execute ( Sender: TObject ); begin SelectionDialog.ShowModal; end; // Select Rectangle procedure TFormMain.Rectangle1Click ( Sender: TObject ); begin // Select rect ImageEnView1.MouseInteract := [miSelect]; ImageEnView1.Cursor := crIECrossSight; end; // Select procedure TFormMain.Circle1Click ( Sender: TObject ); begin // Select circle ImageEnView1.MouseInteract := [miSelectCircle]; ImageEnView1.Cursor := crIECrossSight; end; // Select procedure TFormMain.Polygon3Click ( Sender: TObject ); begin // Select polygon ImageEnView1.MouseInteract := [miSelectPolygon]; ImageEnView1.Cursor := crIECrossSight; end; // Select procedure TFormMain.MagicWand2Click ( Sender: TObject ); begin ImageEnView1.MouseInteract := [miSelectMagicWand]; ImageEnView1.Cursor := crIECrossSight; PopupMenu1.AutoPopup := true; end; // Select procedure TFormMain.Lasso2Click ( Sender: TObject ); begin ImageEnView1.MouseInteract := [miSelectLasso]; ImageEnView1.Cursor := crIECrossSight; PopupMenu1.AutoPopup := true; end; // Select procedure TFormMain.Move2Click ( Sender: TObject ); begin // Hand ImageEnView1.MouseInteract := [miScroll]; ImageEnView1.Cursor := crIEHandDrag; end; // Select procedure TFormMain.Zoom2Click ( Sender: TObject ); begin // Zoom ImageEnView1.MouseInteract := [miZoom, miScroll]; ImageEnView1.Cursor := crIEZoomIn; end; // Select procedure TFormMain.SelectRect1Execute ( Sender: TObject ); begin // Select rect ImageEnView1.MouseInteract := [miSelect]; ImageEnView1.Cursor := crIECrossSight; end; // Select procedure TFormMain.SelectCircle1Execute ( Sender: TObject ); begin // Select circle; ImageEnView1.MouseInteract := [miSelectCircle]; ImageEnView1.Cursor := crIECrossSight; end; // Select procedure TFormMain.SelectLasso1Execute ( Sender: TObject ); begin ImageEnView1.MouseInteract := [miSelectLasso]; ImageEnView1.Cursor := crIECrossSight; end; // Select procedure TFormMain.SelectMove1Execute ( Sender: TObject ); begin // Hand ImageEnView1.MouseInteract := [miScroll]; ImageEnView1.Cursor := crIEHandDrag; end; // Select procedure TFormMain.SelectZoom1Execute ( Sender: TObject ); begin // Zoom ImageEnView1.MouseInteract := [miZoom, miScroll]; ImageEnView1.Cursor := crIEZoomIn; end; procedure TFormMain.Button7Click ( Sender: TObject ); begin OpenImageEnDialog1.FileName := ''; OpenImageEnDialog1.InitialDir := ''; OpenImageEnDialog1.DefaultExt := 'bmp'; // Open an image file if OpenImageEnDialog1.Execute then begin ImageEnView1.Cursor := crHandPoint; // Set MouseInteract ImageEnView1.MouseInteract := ImageEnView1.MouseInteract + [miSelect]; // Set filename and path fFilename := ExtractFilename ( OpenImageEnDialog1.Filename ); fPathFilename := OpenImageEnDialog1.FileName; // If file exists then load it if FileExists ( fPathFilename ) then begin // Show progress bar ProgressBar1.Visible := True; // Load the file ImageEnView1.IO.LoadFromFile ( fPathFilename ); // Set progress bar position to 0 and hide it ProgressBar1.Position := 0; ProgressBar1.Visible := False; ImageEnView1.IO.ParamsFromFile ( fPathFilename ); if ImageEnView1.IO.Params.FileType <> ioUnknown then ShowIOParams ( ImageEnView1.IO.Params ); // Show image dimensions StatusBar1.Panels[1].Text := ' Height: ' + IntToStr ( ImageEnView1.IEBitmap.Height ) + ' pixels' + ' Width: ' + IntToStr ( ImageEnView1.IEBitmap.Width ) + ' pixels '; ImageEnView1.Visible := True; end; end; end; // GrayScale Image procedure TFormMain.ImageGrayScale1Execute ( Sender: TObject ); begin // Save undo file ImageEnView1.Proc.SaveUndoCaptioned ( 'Convert to Grayscale ' + IntToStr ( ImageEnView1.Proc.UndoCount ) ); ImageEnView1.Proc.ClearAllRedo; ProgressBar1.Visible := True; // Process image ImageEnView1.Proc.ConvertToGray; ProgressBar1.Position := 0; ProgressBar1.Visible := False; ImageEnView1.Refresh; StatusBar1.Panels[4].Text := 'Grayscale ' + PixelFormatToColors ( ImageEnView1.IEBitmap.PixelFormat ); UpdateUndoMenu; end; // Set magic wand tolerance procedure TFormMain.SelectWandTolerance1Execute ( Sender: TObject ); var MagicWandTolerance: integer; MagicWandToleranceStr: string; begin MagicWandToleranceStr := IntToStr ( ImageEnView1.MagicWandTolerance ); MagicWandToleranceStr := InputBox ( 'Selection Tolerance', 'Tolerance', MagicWandToleranceStr ); MagicWandTolerance := StrToInt ( MagicWandToleranceStr ); ImageEnView1.MagicWandTolerance := MagicWandTolerance; end; // ImageColorAdjust procedure TFormMain.ImageColorAdjust1Execute ( Sender: TObject ); begin ImageEnView1.Proc.SaveUndoCaptioned ( 'Color Adjust ' + IntToStr ( ImageEnView1.Proc.UndoCount ) ); ImageEnView1.Proc.ClearAllRedo; ImageEnView1.Proc.PreviewsParams := [prppDefaultLockPreview]; ImageEnView1.Proc.DoPreviews ( ppeColorAdjust ); UpdateUndoMenu; end; // ToolButton19Click procedure TFormMain.ToolButton19Click ( Sender: TObject ); begin with ImageEnView1.Proc do begin SaveUndoCaptioned ( RedoCaptions[0] ); // saves in Undo List Redo; ClearRedo; end; UpdateUndoMenu; end; // EditRedo1Execute procedure TFormMain.EditRedo1Execute ( Sender: TObject ); begin with ImageEnView1.Proc do begin SaveUndoCaptioned ( RedoCaptions[0] ); // saves in Undo List Redo; end; UpdateUndoMenu; end; // FullScreen procedure TFormMain.ImageEnView1DblClick ( Sender: TObject ); begin FullScreen := TFullScreen.Create ( Self ); try Screen.Cursor := crDefault; // Copy image to fullscreen image FullScreen.ImageEnView1.IEBitmap.Assign ( ImageEnView1.IEBitmap ); // Show the image fullscreen FullScreen.Showmodal; Screen.Cursor := crDefault; except FullScreen.Free; end; end; // ImageEnView1ViewChange procedure TFormMain.ImageEnView1ViewChange ( Sender: TObject; Change: Integer ); begin fInternalChange := True; TrackBarZoom.Position := Round ( ImageEnView1.Zoom ); fInternalChange := False; end; // ImageEnView1MouseDown procedure TFormMain.ImageEnView1MouseDown ( Sender: TObject; Button: TMouseButton;Shift: TShiftState;X, Y: Integer ); var P1: TPoint; begin ImageEnView1.SetFocus; // if not in zoom mode then popupmenu if ImageEnView1.MouseInteract <> [miZoom, miScroll] then if Button = mbRight then begin // get cursor position GetCursorPos ( P1 ); PopupMenu1.Popup ( P1.x, P1.y ); end; end; // ImageEnView1ImageChange procedure TFormMain.ImageEnView1ImageChange ( Sender: TObject ); begin fInternalChange := True; TrackBarZoom.Position := Round ( ImageEnView1.Zoom ); fInternalChange := False; end; // Image256IEOrdered procedure TFormMain.Image256IEOrdered1Execute ( Sender: TObject ); begin // Save undo file ImageEnView1.Proc.SaveUndoCaptioned ( '256 Color ieordered' + IntToStr ( ImageEnView1.Proc.UndoCount ) ); ImageEnView1.Proc.ClearAllRedo; // Show progressbar ProgressBar1.Visible := True; // Convert to 256 colors ImageEnView1.Proc.ConvertTo ( 256, ieordered ); ProgressBar1.Position := 0; ProgressBar1.Visible := False; ImageEnView1.Refresh; StatusBar1.Panels[4].Text := '256 Color IEOrdered'; UpdateUndoMenu; end; // ImageConvertTo8Bit procedure TFormMain.ImageConvertTo8Bit1Execute ( Sender: TObject ); begin // Save undo file ImageEnView1.Proc.SaveUndoCaptioned ( '8 Bit, 256 Color' + IntToStr ( ImageEnView1.Proc.UndoCount ) ); ImageEnView1.Proc.ClearAllRedo; // Convert to 256 colors ImageEnView1.Proc.ConvertTo ( 256, ieordered ); // prepair to save 256 colormapped bitmap ImageEnView1.IO.Params.BitsPerSample := 8; ImageEnView1.IO.Params.SamplesPerPixel := 1; ProgressBar1.Position := 0; ProgressBar1.Visible := False; ImageEnView1.Refresh; StatusBar1.Panels[4].Text := '8 Bit, 256 Color '; UpdateUndoMenu; SaveImageEnDialog1.FileName := ''; SaveImageEnDialog1.DefaultExt := fDefaultExtension; SaveImageEnDialog1.InitialDir := fDefaultFolder; // Launch save image dialog if SaveImageEnDialog1.Execute then begin fSaveAs := True; // Show progressbar ProgressBar1.Visible := True; // Set filename fFilename := SaveImageEnDialog1.FileName; fPathFilename := SaveImageEnDialog1.FileName; fDefaultFolder := ExtractFileDir ( SaveImageEnDialog1.FileName ); // Execute filesave ImageEnView1.IO.SaveToFile ( fPathFilename ); // Hide progressbar ProgressBar1.Visible := False; end; end; // ImageImageConvertTo24Bit procedure TFormMain.ImageImageConvertTo24Bit1Execute ( Sender: TObject ); begin // Save undo file ImageEnView1.Proc.SaveUndoCaptioned ( 'True Color, 24 Bit' + IntToStr ( ImageEnView1.Proc.UndoCount ) ); ImageEnView1.Proc.ClearAllRedo; ImageEnView1.Proc.ConvertTo24Bit; // prepairs to save 24 bit bitmap ImageEnView1.IO.Params.BitsPerSample := 8; ImageEnView1.IO.Params.SamplesPerPixel := 3; ProgressBar1.Position := 0; ProgressBar1.Visible := False; ImageEnView1.Refresh; StatusBar1.Panels[4].Text := 'True Color, 24 Bit '; UpdateUndoMenu; SaveImageEnDialog1.FileName := ''; SaveImageEnDialog1.DefaultExt := fDefaultExtension; SaveImageEnDialog1.InitialDir := fDefaultFolder; // Launch save image dialog if SaveImageEnDialog1.Execute then begin fSaveAs := True; // Show progressbar ProgressBar1.Visible := True; // Set filename fFilename := SaveImageEnDialog1.FileName; fPathFilename := SaveImageEnDialog1.FileName; fDefaultFolder := ExtractFileDir ( SaveImageEnDialog1.FileName ); // Execute filesave ImageEnView1.IO.SaveToFile ( fPathFilename ); // Hide progressbar ProgressBar1.Visible := False; end; end; // ImageDoPreviews procedure TFormMain.ImageDoPreviews1Execute ( Sender: TObject ); begin // Save undo file ImageEnView1.Proc.SaveUndoCaptioned ( 'Do Previews' + IntToStr ( ImageEnView1.Proc.UndoCount ) ); ImageEnView1.Proc.ClearAllRedo; // Show progressbar ProgressBar1.Visible := True; StatusBar1.Panels[4].Text := 'Do Previews '; UpdateUndoMenu; SaveImageEnDialog1.FileName := ''; SaveImageEnDialog1.DefaultExt := fDefaultExtension; SaveImageEnDialog1.InitialDir := fDefaultFolder; // Launch save image dialog if SaveImageEnDialog1.Execute then begin // Set filename fFilename := SaveImageEnDialog1.FileName; fPathFilename := SaveImageEnDialog1.FileName; fDefaultFolder := ExtractFileDir ( SaveImageEnDialog1.FileName ); ImageEnView1.IO.PreviewsParams := [ioppDefaultLockPreview, ioppApplyButton]; if ImageEnView1.IO.DoPreviews ( [ppAll] ) then // Execute filesave ImageEnView1.IO.SaveToFile ( fPathFilename ); end; end; // SelectionProperties procedure TFormMain.SelectionProperties1Execute ( Sender: TObject ); begin SelectionDialog.ShowModal; end; // ImageRotate procedure TFormMain.ImageRotate1Execute(Sender: TObject); begin fRotate.ImageEnView1.Assign(ImageEnView1); ProgressBar1.Visible := True; // Show rotate dialog if fRotate.ShowModal = mrOK then ImageEnView1.Proc.Rotate(fRotate.Updown1.Position, fRotate.Checkbox1.Checked); ProgressBar1.Position := 0; ProgressBar1.Visible := False; end; procedure TFormMain.ImageLosslessTransform1Execute(Sender: TObject); begin LosslessTransform.ImageEnView1.Assign(ImageEnView1); if LosslessTransform.ShowModal = mrOK then begin // Save undo file ImageEnView1.Proc.SaveUndoCaptioned ( 'Lossless Transform' + IntToStr ( ImageEnView1.Proc.UndoCount ) ); ImageEnView1.Proc.ClearAllRedo; ImageEnView1.Assign(LosslessTransform.ImageEnView2); ImageEnView1.Update; end; end; procedure TFormMain.ViewFit1Execute(Sender: TObject); begin ImageEnView1.AutoShrink := not ImageEnView1.AutoShrink; if ImageEnView1.AutoShrink = False then ImageEnView1.Zoom := 100 else ImageEnView1.Fit; end; end.