From 0767d5387a4a623d5320115a26fb5756ca4e2bb6 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Thu, 3 Jun 2010 23:19:27 +0000 Subject: [PATCH] Replace "Image view" action code which opened BLOBs in external app by a home brown preview area for images in BLOBs, using GraphicEx library for detecting image types. Also, add a "Save to file" action for any grid cell content. Fixes issue #1960. Fixes issue #492. Fixes issue #955. --- source/const.inc | 2 + source/main.dfm | 174 ++++++++++++++++++++------- source/main.pas | 299 +++++++++++++++++++++++++++++++++++------------ 3 files changed, 358 insertions(+), 117 deletions(-) diff --git a/source/const.inc b/source/const.inc index 19b7d039..c895d224 100644 --- a/source/const.inc +++ b/source/const.inc @@ -93,6 +93,8 @@ const REGNAME_TOOLBARQUERYTOP = 'ToolBarQueryTop'; REGNAME_QUERYMEMOHEIGHT = 'querymemoheight'; REGNAME_DBTREEWIDTH = 'dbtreewidth'; + REGNAME_PREVIEW_HEIGHT = 'DataPreviewHeight'; + REGNAME_PREVIEW_ENABLED = 'DataPreviewEnabled'; REGNAME_SQLOUTHEIGHT = 'sqloutheight'; REGNAME_QUERYHELPERSWIDTH = 'queryhelperswidth'; REGNAME_STOPONERRORSINBATCH = 'StopOnErrorsInBatchMode'; diff --git a/source/main.dfm b/source/main.dfm index f3e077a4..0733fcb1 100644 --- a/source/main.dfm +++ b/source/main.dfm @@ -339,13 +339,14 @@ object MainForm: TMainForm BevelOuter = bvNone TabOrder = 0 OnDblClick = panelTopDblClick - object Splitter1: TSplitter + object spltDBtree: TSplitter Left = 169 Top = 0 Width = 4 Height = 357 Cursor = crSizeWE ResizeStyle = rsUpdate + OnMoved = spltPreviewMoved end object pnlLeft: TPanel Left = 0 @@ -355,11 +356,22 @@ object MainForm: TMainForm Align = alLeft BevelOuter = bvNone TabOrder = 0 + object spltPreview: TSplitter + Left = 0 + Top = 253 + Width = 169 + Height = 4 + Cursor = crSizeNS + Align = alBottom + ResizeStyle = rsUpdate + Visible = False + OnMoved = spltPreviewMoved + end object DBtree: TVirtualStringTree Left = 0 Top = 0 Width = 169 - Height = 336 + Height = 253 Align = alClient Constraints.MinWidth = 40 DragMode = dmAutomatic @@ -411,6 +423,78 @@ object MainForm: TMainForm WideText = 'Size' end> end + object pnlPreview: TPanel + Left = 0 + Top = 257 + Width = 169 + Height = 100 + Align = alBottom + BevelOuter = bvNone + TabOrder = 1 + Visible = False + DesignSize = ( + 169 + 100) + object imgPreview: TImage + AlignWithMargins = True + Left = 0 + Top = 25 + Width = 169 + Height = 75 + Margins.Left = 0 + Margins.Top = 25 + Margins.Right = 0 + Margins.Bottom = 0 + Align = alClient + Center = True + Proportional = True + Stretch = True + end + object lblPreviewTitle: TLabel + Left = 3 + Top = 0 + Width = 85 + Height = 25 + Anchors = [akLeft, akTop, akRight] + AutoSize = False + Caption = 'Preview ...' + EllipsisPosition = epEndEllipsis + ParentShowHint = False + ShowAccelChar = False + ShowHint = True + Layout = tlCenter + end + object ToolBarPreview: TToolBar + Left = 100 + Top = 1 + Width = 70 + Height = 23 + Align = alNone + Anchors = [akTop, akRight] + Caption = 'ToolBarPreview' + Images = ImageListMain + TabOrder = 0 + Wrapable = False + object btnPreviewCopy: TToolButton + Left = 0 + Top = 0 + Action = actCopy + end + object btnPreviewSaveToFile: TToolButton + Left = 23 + Top = 0 + Action = actDataSaveBlobToFile + end + object btnPreviewClose: TToolButton + Left = 46 + Top = 0 + Hint = 'Close preview' + Caption = 'btnPreviewClose' + ImageIndex = 26 + OnClick = actDataPreviewExecute + end + end + end end object pnlRight: TPanel Left = 173 @@ -1581,7 +1665,7 @@ object MainForm: TMainForm AutoHotkeys = maManual Images = ImageListMain Left = 40 - Top = 64 + Top = 32 object File1: TMenuItem Tag = 17 Caption = '&File' @@ -1812,7 +1896,7 @@ object MainForm: TMainForm object ActionList1: TActionList Images = ImageListMain Left = 8 - Top = 64 + Top = 32 object actSessionManager: TAction Category = 'File' Caption = 'Session manager' @@ -1983,13 +2067,13 @@ object MainForm: TMainForm ShortCut = 24696 OnExecute = actExecuteQueryExecute end - object actImageView: TAction - Category = 'Export/Import' - Caption = 'Image view' - Hint = 'View image contents' + object actDataPreview: TAction + Category = 'Data' + Caption = 'Image preview' + Hint = 'Preview image contents from BLOB cells' ImageIndex = 152 - OnExecute = actImageViewExecute - OnUpdate = actImageViewUpdate + OnExecute = actDataPreviewExecute + OnUpdate = actDataPreviewUpdate end object actInsertFiles: TAction Category = 'Export/Import' @@ -2519,6 +2603,13 @@ object MainForm: TMainForm ShortCut = 24654 OnExecute = actDataSetNullExecute end + object actDataSaveBlobToFile: TAction + Category = 'Data' + Caption = 'Save BLOB to file ...' + Hint = 'Save contents to local file ...' + ImageIndex = 10 + OnExecute = actDataSaveBlobToFileExecute + end end object SaveDialog2: TSaveDialog DefaultExt = 'reg' @@ -2526,27 +2617,27 @@ object MainForm: TMainForm Options = [ofOverwritePrompt, ofHideReadOnly, ofEnableSizing] Title = 'Export settings from registry...' Left = 8 - Top = 200 + Top = 128 end object OpenDialog2: TOpenDialog DefaultExt = 'reg' Filter = 'Registry-files (*.reg)|*.reg|All files (*.*)|*.*' Title = 'Import settings to registry...' Left = 72 - Top = 232 + Top = 160 end object menuConnections: TPopupMenu AutoHotkeys = maManual Images = ImageListMain OnPopup = menuConnectionsPopup Left = 72 - Top = 64 + Top = 32 end object ImageListMain: TImageList ColorDepth = cd32Bit DrawingStyle = dsTransparent Left = 104 - Top = 232 + Top = 160 Bitmap = { 494C010199009C00040010001000FFFFFFFF2110FFFFFFFFFFFFFFFF424D3600 0000000000003600000028000000400000007002000001002000000000000070 @@ -7706,13 +7797,13 @@ object MainForm: TMainForm object PopupQueryLoad: TPopupMenu Images = ImageListMain Left = 104 - Top = 64 + Top = 32 end object popupDB: TPopupMenu Images = ImageListMain OnPopup = popupDBPopup Left = 136 - Top = 64 + Top = 32 object menuEditObject: TMenuItem Action = actEditObject ShortCut = 32781 @@ -7797,7 +7888,7 @@ object MainForm: TMainForm Images = ImageListMain OnPopup = popupHostPopup Left = 9 - Top = 96 + Top = 64 object Copy2: TMenuItem Action = actCopy end @@ -7856,25 +7947,25 @@ object MainForm: TMainForm VariableAttri.Foreground = clPurple SQLDialect = sqlMySQL Left = 7 - Top = 304 + Top = 232 end object OpenDialog1: TOpenDialog DefaultExt = 'sql' Filter = 'SQL-Scripts (*.sql)|*.sql|All files (*.*)|*.*' Left = 7 - Top = 232 + Top = 160 end object TimerHostUptime: TTimer OnTimer = TimerHostUptimeTimer Left = 7 - Top = 269 + Top = 197 end object popupDataGrid: TPopupMenu AutoHotkeys = maManual Images = ImageListMain OnPopup = popupDataGridPopup Left = 104 - Top = 96 + Top = 64 object Copy3: TMenuItem Action = actCopy end @@ -8098,7 +8189,10 @@ object MainForm: TMainForm end end object ViewasHTML1: TMenuItem - Action = actImageView + Action = actDataPreview + end + object SaveBLOBtofile1: TMenuItem + Action = actDataSaveBlobToFile end object InsertfilesintoBLOBfields3: TMenuItem Action = actInsertFiles @@ -8117,12 +8211,12 @@ object MainForm: TMainForm object TimerConnected: TTimer OnTimer = TimerConnectedTimer Left = 103 - Top = 269 + Top = 197 end object popupSqlLog: TPopupMenu Images = ImageListMain Left = 8 - Top = 128 + Top = 96 object Copy1: TMenuItem Action = actCopy end @@ -8155,7 +8249,7 @@ object MainForm: TMainForm Interval = 5000 OnTimer = actRefreshExecute Left = 72 - Top = 269 + Top = 197 end object SaveDialogExportData: TSaveDialog DefaultExt = 'csv' @@ -8165,12 +8259,12 @@ object MainForm: TMainForm Options = [ofOverwritePrompt, ofEnableSizing] OnTypeChange = SaveDialogExportDataTypeChange Left = 40 - Top = 200 + Top = 128 end object popupListHeader: TVTHeaderPopupMenu Images = ImageListMain Left = 40 - Top = 128 + Top = 96 end object SynCompletionProposal: TSynCompletionProposal Options = [scoLimitToMatchedText, scoUseInsertList, scoUsePrettyText, scoUseBuiltInTimer, scoEndCharCompletion, scoCompleteWithTab, scoCompleteWithEnter] @@ -8205,31 +8299,31 @@ object MainForm: TMainForm OnAfterCodeCompletion = SynCompletionProposalAfterCodeCompletion OnCodeCompletion = SynCompletionProposalCodeCompletion Left = 40 - Top = 304 + Top = 232 end object OpenDialogSQLFile: TOpenDialog DefaultExt = 'sql' Filter = 'SQL-Scripts (*.sql)|*.sql|All files (*.*)|*.*' Options = [ofHideReadOnly, ofAllowMultiSelect, ofEnableSizing] Left = 40 - Top = 232 + Top = 160 end object SaveDialogSQLFile: TSaveDialog DefaultExt = 'sql' Filter = 'SQL-Scripts (*.sql)|*.sql|All Files (*.*)|*.*' Options = [ofOverwritePrompt, ofHideReadOnly, ofEnableSizing] Left = 72 - Top = 200 + Top = 128 end object SynEditSearch1: TSynEditSearch Left = 72 - Top = 304 + Top = 232 end object popupQuery: TPopupMenu Images = ImageListMain OnPopup = popupQueryPopup Left = 104 - Top = 128 + Top = 96 object MenuRun: TMenuItem Action = actExecuteQuery end @@ -8306,7 +8400,7 @@ object MainForm: TMainForm object popupQueryHelpers: TPopupMenu Images = ImageListMain Left = 136 - Top = 128 + Top = 96 object menuInsertSnippetAtCursor: TMenuItem Caption = 'Insert at cursor' Default = True @@ -8358,7 +8452,7 @@ object MainForm: TMainForm object popupFilter: TPopupMenu Images = ImageListMain Left = 72 - Top = 128 + Top = 96 object menuFilterCopy: TMenuItem Action = actCopy end @@ -8387,7 +8481,7 @@ object MainForm: TMainForm object popupRefresh: TPopupMenu Images = ImageListMain Left = 40 - Top = 96 + Top = 64 object menuAutoRefresh: TMenuItem Caption = 'Auto refresh' ShortCut = 16500 @@ -8403,7 +8497,7 @@ object MainForm: TMainForm Images = ImageListMain OnPopup = popupMainTabsPopup Left = 72 - Top = 96 + Top = 64 object menuNewQueryTab: TMenuItem Action = actNewQueryTab end @@ -8418,11 +8512,11 @@ object MainForm: TMainForm Interval = 500 OnTimer = TimerFilterVTTimer Left = 40 - Top = 269 + Top = 197 end object SynEditRegexSearch1: TSynEditRegexSearch Left = 104 - Top = 304 + Top = 232 end object SynExporterHTML1: TSynExporterHTML Color = clWindow @@ -8436,11 +8530,11 @@ object MainForm: TMainForm Title = 'Untitled' UseBackground = False Left = 136 - Top = 304 + Top = 232 end object BalloonHint1: TBalloonHint Delay = 100 Left = 104 - Top = 200 + Top = 128 end end diff --git a/source/main.pas b/source/main.pas index bb6c22c2..c8dae723 100644 --- a/source/main.pas +++ b/source/main.pas @@ -10,7 +10,7 @@ unit Main; interface uses - Windows, SysUtils, Classes, Graphics, GraphUtil, Forms, Controls, Menus, StdCtrls, Dialogs, Buttons, + Windows, SysUtils, Classes, GraphicEx, Graphics, GraphUtil, Forms, Controls, Menus, StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, ComCtrls, StdActns, ActnList, ImgList, ToolWin, Clipbrd, SynMemo, SynEdit, SynEditTypes, SynEditKeyCmds, VirtualTrees, DateUtils, ShlObj, SynEditMiscClasses, SynEditSearch, SynEditRegexSearch, SynCompletionProposal, SynEditHighlighter, @@ -126,7 +126,7 @@ type Exportdata1: TMenuItem; CopyasXMLdata1: TMenuItem; actExecuteCurrentQuery: TAction; - actImageView: TAction; + actDataPreview: TAction; actInsertFiles: TAction; InsertfilesintoBLOBfields1: TMenuItem; actExportTables: TAction; @@ -212,7 +212,7 @@ type panelTop: TPanel; pnlLeft: TPanel; DBtree: TVirtualStringTree; - Splitter1: TSplitter; + spltDBtree: TSplitter; PageControlMain: TPageControl; tabData: TTabSheet; tabDatabase: TTabSheet; @@ -476,6 +476,16 @@ type tabsetQuery: TTabSet; BalloonHint1: TBalloonHint; actDataSetNull: TAction; + pnlPreview: TPanel; + spltPreview: TSplitter; + imgPreview: TImage; + lblPreviewTitle: TLabel; + ToolBarPreview: TToolBar; + btnPreviewCopy: TToolButton; + btnPreviewSaveToFile: TToolButton; + btnPreviewClose: TToolButton; + actDataSaveBlobToFile: TAction; + SaveBLOBtofile1: TMenuItem; procedure actCreateDBObjectExecute(Sender: TObject); procedure menuConnectionsPopup(Sender: TObject); procedure actExitApplicationExecute(Sender: TObject); @@ -502,7 +512,8 @@ type procedure actCreateDatabaseExecute(Sender: TObject); procedure actDataCancelChangesExecute(Sender: TObject); procedure actExportDataExecute(Sender: TObject); - procedure actImageViewExecute(Sender: TObject); + procedure actDataPreviewExecute(Sender: TObject); + procedure UpdatePreviewPanel; procedure actInsertFilesExecute(Sender: TObject); procedure actDataDeleteExecute(Sender: TObject); procedure actDataFirstExecute(Sender: TObject); @@ -765,7 +776,9 @@ type procedure StatusBarMouseLeave(Sender: TObject); procedure AnyGridStartOperation(Sender: TBaseVirtualTree; OperationKind: TVTOperationKind); procedure AnyGridEndOperation(Sender: TBaseVirtualTree; OperationKind: TVTOperationKind); - procedure actImageViewUpdate(Sender: TObject); + procedure actDataPreviewUpdate(Sender: TObject); + procedure spltPreviewMoved(Sender: TObject); + procedure actDataSaveBlobToFileExecute(Sender: TObject); private LastHintMousepos: TPoint; LastHintControlIndex: Integer; @@ -958,7 +971,8 @@ implementation uses About, printlist, mysql_structures, UpdateCheck, uVistaFuncs, runsqlfile, - column_selection, data_sorting, grideditlinks; + column_selection, data_sorting, grideditlinks, jpeg, GIFImg; + {$R *.DFM} @@ -1124,6 +1138,8 @@ begin MainReg.WriteInteger( REGNAME_QUERYMEMOHEIGHT, pnlQueryMemo.Height ); MainReg.WriteInteger( REGNAME_QUERYHELPERSWIDTH, pnlQueryHelpers.Width ); MainReg.WriteInteger( REGNAME_DBTREEWIDTH, pnlLeft.width ); + MainReg.WriteInteger(REGNAME_PREVIEW_HEIGHT, pnlPreview.Height); + MainReg.WriteBool(REGNAME_PREVIEW_ENABLED, actDataPreview.Checked); MainReg.WriteInteger( REGNAME_SQLOUTHEIGHT, SynMemoSQLLog.Height ); MainReg.WriteBool(REGNAME_FILTERACTIVE, pnlFilterVT.Tag=Integer(True)); // Convert set to string. @@ -1288,6 +1304,9 @@ begin pnlQueryMemo.Height := GetRegValue(REGNAME_QUERYMEMOHEIGHT, pnlQueryMemo.Height); pnlQueryHelpers.Width := GetRegValue(REGNAME_QUERYHELPERSWIDTH, pnlQueryHelpers.Width); pnlLeft.Width := GetRegValue(REGNAME_DBTREEWIDTH, pnlLeft.Width); + pnlPreview.Height := GetRegValue(REGNAME_PREVIEW_HEIGHT, pnlPreview.Height); + if GetRegValue(REGNAME_PREVIEW_ENABLED, actDataPreview.Checked) and (not actDataPreview.Checked) then + actDataPreviewExecute(actDataPreview); SynMemoSQLLog.Height := GetRegValue(REGNAME_SQLOUTHEIGHT, SynMemoSQLLog.Height); // Force status bar position to below log memo StatusBar.Top := SynMemoSQLLog.Top + SynMemoSQLLog.Height; @@ -2345,7 +2364,7 @@ begin end; -procedure TMainForm.actImageViewUpdate(Sender: TObject); +procedure TMainForm.actDataPreviewUpdate(Sender: TObject); var Grid: TVirtualStringTree; begin @@ -2357,50 +2376,160 @@ begin end; -procedure TMainForm.actImageViewExecute(Sender: TObject); +procedure TMainForm.actDataPreviewExecute(Sender: TObject); +var + MakeVisible: Boolean; +begin + // Show or hide preview area + actDataPreview.Checked := not actDataPreview.Checked; + MakeVisible := actDataPreview.Checked; + pnlPreview.Visible := MakeVisible; + spltPreview.Visible := MakeVisible; + if MakeVisible then + UpdatePreviewPanel; +end; + + +procedure TMainForm.UpdatePreviewPanel; var Grid: TVirtualStringTree; Results: TMySQLQuery; RowNum: PCardinal; - Filename, Suffix: String; + ImgType: String; Content, Header: AnsiString; - f: Textfile; + ContentStream: TMemoryStream; + StrLen: Integer; + GraphicClass: TGraphicExGraphicClass; + Graphic: TGraphic; + AllExtensions: TStringList; + i: Integer; begin - // Open BLOB as image in associated application + // Load BLOB contents into preview area Grid := ActiveGrid; + if not Assigned(Grid) then + Exit; Results := GridResult(Grid); Screen.Cursor := crHourGlass; - ShowStatusMsg('Saving contents to file...'); - AnyGridEnsureFullRow(Grid, Grid.FocusedNode); - RowNum := Grid.GetNodeData(Grid.FocusedNode); - Results.RecNo := RowNum^; - Content := AnsiString(Results.Col(Grid.FocusedColumn)); - Header := Copy(Content, 1, 50); - Suffix := ''; - if Copy(Header, 7, 4) = 'JFIF' then - Suffix := 'jpeg' - else if Copy(Header, 2, 3) = 'PNG' then - Suffix := 'png' - else if Copy(Header, 1, 3) = 'GIF' then - Suffix := 'gif' - else if Copy(Header, 1, 2) = 'BM' then - Suffix := 'bmp' - else if Copy(Header, 3, 2) = #42#0 then - Suffix := 'tif'; + try + ShowStatusMsg('Loading contents into image viewer ...'); + lblPreviewTitle.Caption := 'Loading ...'; + lblPreviewTitle.Repaint; + imgPreview.Picture := nil; + AnyGridEnsureFullRow(Grid, Grid.FocusedNode); + RowNum := Grid.GetNodeData(Grid.FocusedNode); + Results.RecNo := RowNum^; - if Suffix = '' then - MessageDlg('Unrecognized image format. Only JPEG, PNG, GIF and BMP are supported.', mtError, [mbOk], 0) - else begin - Filename := GetTempDir+'\'+APPNAME+'-preview.' + Suffix; - AssignFile(f, Filename); - Rewrite(f); - Write(f, Content); - CloseFile(f); - ShellExec(Filename); + Content := AnsiString(Results.Col(Grid.FocusedColumn)); + StrLen := Length(Content); + ContentStream := TMemoryStream.Create; + ContentStream.Write(Content[1], StrLen); + ContentStream.Position := 0; + GraphicClass := FileFormatList.GraphicFromContent(ContentStream); + Graphic := nil; + ContentStream.Position := 0; + ImgType := 'UnknownType'; + if GraphicClass <> nil then begin + AllExtensions := TStringList.Create; + FileFormatList.GetExtensionList(AllExtensions); + for i:=0 to AllExtensions.Count-1 do begin + if FileFormatList.GraphicFromExtension(AllExtensions[i]) = GraphicClass then begin + ImgType := UpperCase(AllExtensions[i]); + break; + end; + end; + Graphic := GraphicClass.Create; + end else begin + Header := Copy(Content, 1, 50); + if Copy(Header, 7, 4) = 'JFIF' then begin + ImgType := 'JPEG'; + Graphic := TJPEGImage.Create; + end else if Copy(Header, 1, 3) = 'GIF' then begin + ImgType := 'GIF'; + Graphic := TGIFImage.Create; + end else if Copy(Header, 1, 2) = 'BM' then begin + ImgType := 'BMP'; + Graphic := TBitmap.Create; + end; + end; + if Assigned(Graphic) then begin + try + Graphic.LoadFromStream(ContentStream); + imgPreview.Picture.Graphic := Graphic; + lblPreviewTitle.Caption := ImgType+': '+ + IntToStr(Graphic.Width)+' x '+IntToStr(Graphic.Height)+' pixels, 100%, '+ + FormatByteNumber(StrLen); + spltPreview.OnMoved(spltPreview); + except on E:EInvalidGraphic do + lblPreviewTitle.Caption := ImgType+': ' + E.Message; + end; + FreeAndNil(ContentStream); + end else + lblPreviewTitle.Caption := 'No image detected.'; + finally + lblPreviewTitle.Hint := lblPreviewTitle.Caption; + ShowStatusMsg; + Screen.Cursor := crDefault; end; +end; - ShowStatusMsg; - Screen.Cursor := crDefault; + +procedure TMainForm.spltPreviewMoved(Sender: TObject); +var + rx: TRegExpr; + ZoomFactorW, ZoomFactorH: Integer; +begin + // Do not overscale image so it's never zoomed to more than 100% + if (imgPreview.Picture.Graphic = nil) or (imgPreview.Picture.Graphic.Empty) then + Exit; + imgPreview.Stretch := (imgPreview.Picture.Width > imgPreview.Width) or (imgPreview.Picture.Height > imgPreview.Height); + ZoomFactorW := Trunc(Min(imgPreview.Picture.Width, imgPreview.Width) / imgPreview.Picture.Width * 100); + ZoomFactorH := Trunc(Min(imgPreview.Picture.Height, imgPreview.Height) / imgPreview.Picture.Height * 100); + rx := TRegExpr.Create; + rx.Expression := '(\D)(\d+%)'; + lblPreviewTitle.Caption := rx.Replace(lblPreviewTitle.Caption, '${1}'+IntToStr(Min(ZoomFactorH, ZoomFactorW))+'%', true); + lblPreviewTitle.Hint := lblPreviewTitle.Caption; + rx.Free; +end; + + +procedure TMainForm.actDataSaveBlobToFileExecute(Sender: TObject); +var + Grid: TVirtualStringTree; + Results: TMySQLQuery; + RowNum: PCardinal; + Content: AnsiString; + FileStream: TFileStream; + StrLen: Integer; + Dialog: TSaveDialog; +begin + // Save BLOB to local file + Grid := ActiveGrid; + Results := GridResult(Grid); + Dialog := TSaveDialog.Create(Self); + Dialog.Filter := 'All files (*.*)|*.*'; + Dialog.FileName := Results.ColumnOrgNames[Grid.FocusedColumn]; + if not (Results.DataType(Grid.FocusedColumn).Category in [dtcBinary, dtcSpatial]) then + Dialog.FileName := Dialog.FileName + '.txt'; + if Dialog.Execute then begin + Screen.Cursor := crHourGlass; + AnyGridEnsureFullRow(Grid, Grid.FocusedNode); + RowNum := Grid.GetNodeData(Grid.FocusedNode); + Results.RecNo := RowNum^; + if Results.DataType(Grid.FocusedColumn).Category in [dtcBinary, dtcSpatial] then + Content := AnsiString(Results.Col(Grid.FocusedColumn)) + else + Content := Utf8Encode(Results.Col(Grid.FocusedColumn)); + StrLen := Length(Content); + try + FileStream := TFileStream.Create(Dialog.FileName, fmCreate or fmOpenWrite); + FileStream.Write(Content[1], StrLen); + except on E:Exception do + MessageDlg(E.Message, mtError, [mbOK], 0); + end; + FreeAndNil(FileStream); + Screen.Cursor := crDefault; + end; + Dialog.Free; end; @@ -4059,6 +4188,8 @@ begin actDataLast.Enabled := inDataOrQueryTabNotEmpty and inGrid; actDataPostChanges.Enabled := GridHasChanges; actDataCancelChanges.Enabled := GridHasChanges; + actDataSaveBlobToFile.Enabled := inDataOrQueryTabNotEmpty and Assigned(Grid.FocusedNode); + actDataPreview.Enabled := inDataOrQueryTabNotEmpty and Assigned(Grid.FocusedNode); // Activate export-options if we're on Data- or Query-tab actCopyAsCSV.Enabled := inDataOrQueryTabNotEmpty; @@ -4066,7 +4197,6 @@ begin actCopyAsXML.Enabled := inDataOrQueryTabNotEmpty; actCopyAsSQL.Enabled := inDataOrQueryTabNotEmpty; actExportData.Enabled := inDataOrQueryTabNotEmpty; - actImageView.Enabled := inDataOrQueryTabNotEmpty and Assigned(Grid.FocusedNode); actDataSetNull.Enabled := inDataOrQueryTab and Assigned(Results) and Assigned(Grid.FocusedNode); // Manually invoke OnChange event of tabset to fill helper list with data @@ -6979,6 +7109,8 @@ procedure TMainForm.AnyGridFocusChanged(Sender: TBaseVirtualTree; Node: PVirtual begin ValidateControls(Sender); UpdateLineCharPanel; + if pnlPreview.Visible then + UpdatePreviewPanel; end; @@ -7824,6 +7956,7 @@ end; procedure TMainForm.actCopyOrCutExecute(Sender: TObject); var Control: TWinControl; + SendingControl: TComponent; Edit: TCustomEdit; Combo: TCustomComboBox; Grid: TVirtualStringTree; @@ -7831,50 +7964,63 @@ var Success, DoCut: Boolean; SQLStream: TMemoryStream; IsResultGrid: Boolean; + ClpFormat: Word; + ClpData: THandle; + APalette: HPalette; begin // Copy text from a focused control to clipboard Success := False; Control := Screen.ActiveControl; DoCut := Sender = actCut; - if Control is TCustomEdit then begin - Edit := TCustomEdit(Control); - if Edit.SelLength > 0 then begin - if DoCut then Edit.CutToClipboard - else Edit.CopyToClipboard; - Success := True; - end; - end else if Control is TCustomComboBox then begin - Combo := TCustomComboBox(Control); - if Combo.SelLength > 0 then begin - Clipboard.AsText := Combo.SelText; - if DoCut then Combo.SelText := ''; - Success := True; - end; - end else if Control is TVirtualStringTree then begin - Grid := Control as TVirtualStringTree; - if Assigned(Grid.FocusedNode) then begin - IsResultGrid := Grid = ActiveGrid; - AnyGridEnsureFullRow(Grid, Grid.FocusedNode); - Clipboard.AsText := Grid.Text[Grid.FocusedNode, Grid.FocusedColumn]; - if IsResultGrid and DoCut then - Grid.Text[Grid.FocusedNode, Grid.FocusedColumn] := ''; - Success := True; - end; - end else if Control is TSynMemo then begin - SynMemo := Control as TSynMemo; - if SynMemo.SelAvail then begin - // Create both text and HTML clipboard format, so rich text applications can paste highlighted SQL - SynExporterHTML1.ExportAll(Explode(CRLF, SynMemo.SelText)); - if DoCut then SynMemo.CutToClipboard - else SynMemo.CopyToClipboard; - SQLStream := TMemoryStream.Create; - SynExporterHTML1.SaveToStream(SQLStream); - StreamToClipboard(nil, SQLStream, False); + SendingControl := (Sender as TAction).ActionComponent; + Screen.Cursor := crHourglass; + try + if SendingControl = btnPreviewCopy then begin + imgPreview.Picture.SaveToClipBoardFormat(ClpFormat, ClpData, APalette); + ClipBoard.SetAsHandle(ClpFormat, ClpData); Success := True; + end else if Control is TCustomEdit then begin + Edit := TCustomEdit(Control); + if Edit.SelLength > 0 then begin + if DoCut then Edit.CutToClipboard + else Edit.CopyToClipboard; + Success := True; + end; + end else if Control is TCustomComboBox then begin + Combo := TCustomComboBox(Control); + if Combo.SelLength > 0 then begin + Clipboard.AsText := Combo.SelText; + if DoCut then Combo.SelText := ''; + Success := True; + end; + end else if Control is TVirtualStringTree then begin + Grid := Control as TVirtualStringTree; + if Assigned(Grid.FocusedNode) then begin + IsResultGrid := Grid = ActiveGrid; + AnyGridEnsureFullRow(Grid, Grid.FocusedNode); + Clipboard.AsText := Grid.Text[Grid.FocusedNode, Grid.FocusedColumn]; + if IsResultGrid and DoCut then + Grid.Text[Grid.FocusedNode, Grid.FocusedColumn] := ''; + Success := True; + end; + end else if Control is TSynMemo then begin + SynMemo := Control as TSynMemo; + if SynMemo.SelAvail then begin + // Create both text and HTML clipboard format, so rich text applications can paste highlighted SQL + SynExporterHTML1.ExportAll(Explode(CRLF, SynMemo.SelText)); + if DoCut then SynMemo.CutToClipboard + else SynMemo.CopyToClipboard; + SQLStream := TMemoryStream.Create; + SynExporterHTML1.SaveToStream(SQLStream); + StreamToClipboard(nil, SQLStream, False); + Success := True; + end; end; + finally + if not Success then + MessageBeep(MB_ICONASTERISK); + Screen.Cursor := crDefault; end; - if not Success then - MessageBeep(MB_ICONASTERISK); end; @@ -8990,7 +9136,6 @@ begin ShowStatusMsg('', 1); end; - procedure TMainForm.AnyGridStartOperation(Sender: TBaseVirtualTree; OperationKind: TVTOperationKind); begin // Display status message on long running sort operations