diff --git a/components/edbimage/Readme.txt b/components/edbimage/Readme.txt deleted file mode 100644 index d652b801..00000000 --- a/components/edbimage/Readme.txt +++ /dev/null @@ -1,49 +0,0 @@ - TEDBImage 1.4 and TQREDBImage 1.0 (Enhaced TDBImage and TQRDBImage): - by Sebastián Mayorá - Argentina - DelphiHelper@yahoo.com.ar - -TQREDBimage was designed for printing image files. It has the same features that TEDBImage has. - -»It works like TDBImage except : - - It can manage .ico .bmp .wmf .emf .jpg .jpeg. Without a line of code !!! - - Can copy to clipboard .bmp .wmf .jpg .jpeg - - Event OnLoadCustomImage is fired when the image type is unknown, so you can load "any" type of images (gif, tiff, png,....) - -»What you can do is: - - Copy, Cut and paste from clipboard. No code needed. - - LoadFromFile and SaveToFile (New in v1.3) - - Load "any" type of TGraphic using OnLoadCustomImage event: - If you need OTHER kind of graphics (such GIF, TIFF, etc) - then you should write something like this in OnLoadCustomImage Event: - - procedure TForm1.EDBImage1LoadCustomImage(var B: TGraphic; Stream: TStream); - begin - B := TXXX.create; {XXX is your class of Graphic (TGifImage, TTiffImage, etc).} - B.LoadFromStream( Stream ); - end; //That is ALL.!!! - - - -»Please mail me for: - Bugs - - Suggestinons - - say Hello. - - Comments - - etc... - -»New in this version. 1.4 -- Optimized LoadPicture; -- Some bugs fixed -- Added LoadFromFile and SavetoFile methods - -»Known Issues -- If TEDBIMage is within TDBCtrlGrid report errors. I don't know why yet. -- Tested with D6, D5 and D4. -- OnLoadCustomImage tested with TGIFImage (from RXLib) - - -Next release: -- Full test in all supported versions of delphi (D4, D5, D6). -- Option to autoconvert images to JPG (or other) and store compressed (to save space) - -Thanks to: Mohsen Rahmani, Mr. Hong, René Simon and Dayne for their help. - -THIS IS FREEWARE - USE AT YOUR OWN RISK, ETC, ETC diff --git a/components/edbimage/packages/delphi11/DCLSer.dpk b/components/edbimage/packages/delphi11/DCLSer.dpk deleted file mode 100644 index ee013249..00000000 --- a/components/edbimage/packages/delphi11/DCLSer.dpk +++ /dev/null @@ -1,36 +0,0 @@ -package DCLSer; - -{$ALIGN 8} -{$ASSERTIONS ON} -{$BOOLEVAL OFF} -{$DEBUGINFO OFF} -{$EXTENDEDSYNTAX ON} -{$IMPORTEDDATA ON} -{$IOCHECKS ON} -{$LOCALSYMBOLS OFF} -{$LONGSTRINGS ON} -{$OPENSTRINGS ON} -{$OPTIMIZATION ON} -{$OVERFLOWCHECKS OFF} -{$RANGECHECKS OFF} -{$REFERENCEINFO OFF} -{$SAFEDIVIDE OFF} -{$STACKFRAMES OFF} -{$TYPEDADDRESS OFF} -{$VARSTRINGCHECKS ON} -{$WRITEABLECONST ON} -{$MINENUMSIZE 1} -{$IMAGEBASE $400000} -{$DESCRIPTION 'EDBImage 1.4 by SER'} -{$LIBSUFFIX '110'} -{$DESIGNONLY} -{$IMPLICITBUILD OFF} - -requires - VCLSer, - designide; - -contains - UserReg in '..\..\source\uSerREG.pas'; - -end. diff --git a/components/edbimage/packages/delphi11/DCLSer.dproj b/components/edbimage/packages/delphi11/DCLSer.dproj deleted file mode 100644 index 5107775a..00000000 --- a/components/edbimage/packages/delphi11/DCLSer.dproj +++ /dev/null @@ -1,57 +0,0 @@ - - - {9a6865b1-e809-47ff-bee6-8a495fadf975} - DCLSer.dpk - Debug - AnyCPU - DCC32 - - - 7.0 - False - True - False - 0 - RELEASE - ..\..\build - ..\..\build - ..\..\build - ..\..\build - ..\..\build - ..\..\..\compilerdetection\include;..\..\resources;..\..\build - ..\..\..\compilerdetection\include;..\..\resources;..\..\build - ..\..\..\compilerdetection\include;..\..\resources;..\..\build - ..\..\..\compilerdetection\include;..\..\resources;..\..\build - - - 7.0 - False - True - False - 0 - ..\..\build - ..\..\build - ..\..\build - ..\..\build - ..\..\build - ..\..\..\compilerdetection\include;..\..\resources;..\..\build - ..\..\..\compilerdetection\include;..\..\resources;..\..\build - ..\..\..\compilerdetection\include;..\..\resources;..\..\build - ..\..\..\compilerdetection\include;..\..\resources;..\..\build - - - Delphi.Personality - Package - -FalseTrueFalseEDBImage 1.4 by SERFalseTrueFalse110TrueFalse1000FalseFalseFalseFalseFalse104612521.0.0.01.0.0.0DCLSer.dpk - - - - - MainSource - - - - - - diff --git a/components/edbimage/packages/delphi11/EDBImage.groupproj b/components/edbimage/packages/delphi11/EDBImage.groupproj deleted file mode 100644 index b0eaa765..00000000 --- a/components/edbimage/packages/delphi11/EDBImage.groupproj +++ /dev/null @@ -1,40 +0,0 @@ - - - {2e7db4ae-1c78-4ce6-a3d4-c1a9b0900a5b} - - - - - Default.Personality - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - \ No newline at end of file diff --git a/components/edbimage/packages/delphi11/VCLSer.dpk b/components/edbimage/packages/delphi11/VCLSer.dpk deleted file mode 100644 index 64c80175..00000000 --- a/components/edbimage/packages/delphi11/VCLSer.dpk +++ /dev/null @@ -1,38 +0,0 @@ -package VCLSer; - -{$ALIGN 8} -{$ASSERTIONS ON} -{$BOOLEVAL OFF} -{$DEBUGINFO OFF} -{$EXTENDEDSYNTAX ON} -{$IMPORTEDDATA ON} -{$IOCHECKS ON} -{$LOCALSYMBOLS OFF} -{$LONGSTRINGS ON} -{$OPENSTRINGS ON} -{$OPTIMIZATION ON} -{$OVERFLOWCHECKS OFF} -{$RANGECHECKS OFF} -{$REFERENCEINFO OFF} -{$SAFEDIVIDE OFF} -{$STACKFRAMES OFF} -{$TYPEDADDRESS OFF} -{$VARSTRINGCHECKS ON} -{$WRITEABLECONST ON} -{$MINENUMSIZE 1} -{$IMAGEBASE $400000} -{$DESCRIPTION 'EDBImage 1.4 Runtime by SER'} -{$LIBSUFFIX '110'} -{$RUNONLY} -{$IMPLICITBUILD OFF} - -requires - vcljpg, - dbrtl, - vcldb, - bdertl; - -contains - EDBImage in '..\..\source\EDBImage.pas'; - -end. diff --git a/components/edbimage/packages/delphi11/VCLSer.dproj b/components/edbimage/packages/delphi11/VCLSer.dproj deleted file mode 100644 index 9184c855..00000000 --- a/components/edbimage/packages/delphi11/VCLSer.dproj +++ /dev/null @@ -1,59 +0,0 @@ - - - {94ee90f0-216e-4647-98ac-a66563820ad8} - VCLSer.dpk - Debug - AnyCPU - DCC32 - - - 7.0 - False - True - False - 0 - RELEASE - ..\..\build - ..\..\build - ..\..\build - ..\..\build - ..\..\build - ..\..\..\compilerdetection\include - ..\..\..\compilerdetection\include - ..\..\..\compilerdetection\include - ..\..\..\compilerdetection\include - - - 7.0 - False - True - False - 0 - ..\..\build - ..\..\build - ..\..\build - ..\..\build - ..\..\build - ..\..\..\compilerdetection\include;..\..\resources - ..\..\..\compilerdetection\include;..\..\resources - ..\..\..\compilerdetection\include;..\..\resources - ..\..\..\compilerdetection\include;..\..\resources - - - Delphi.Personality - Package - -FalseTrueFalseEDBImage 1.4 Runtime by SERFalseFalseTrue110TrueFalse1000FalseFalseFalseFalseFalse104612521.0.0.01.0.0.0VCLSer.dpk - - - - - MainSource - - - - - - - - \ No newline at end of file diff --git a/components/edbimage/resources/CompsSer.dcr b/components/edbimage/resources/CompsSer.dcr deleted file mode 100644 index 8442156b..00000000 Binary files a/components/edbimage/resources/CompsSer.dcr and /dev/null differ diff --git a/components/edbimage/source/EDBImage.pas b/components/edbimage/source/EDBImage.pas deleted file mode 100644 index d1aa9f30..00000000 --- a/components/edbimage/source/EDBImage.pas +++ /dev/null @@ -1,597 +0,0 @@ -unit EDBImage; -{$I compilers.inc} -{ - TEDBImage 1.4 (Enhaced TDBImage): - by Sebastián Mayorá - Argentina - DelphiHelper@yahoo.com.ar - Please read EDBImage.txt or readme.txt for more information -} - -interface - -uses - DBCtrls {TDataLink}, Windows {HPalette}, db {TField}, graphics, classes {TStream}, - Controls {TCustomControl}, Forms {TBorderStyle}, - Messages {TMessage}; - -type - //Evento para cargar imágenes personalizadas desde el stream guardado - TLoadCustomImageEvent = procedure (var B: TGraphic; Stream: TStream)of object; - - TEDBImage = class(TCustomControl) - private - FDataLink: TFieldDataLink; - FPicture: TPicture; - FBorderStyle: TBorderStyle; - FAutoDisplay: Boolean; - FStretch: Boolean; - FCenter: Boolean; - FPictureLoaded: Boolean; - FQuickDraw: Boolean; - fOnLoadCustomImage: TLoadCustomImageEvent; - procedure DataChange(Sender: TObject); - function GetDataField: string; - function GetDataSource: TDataSource; - function GetField: TField; - function GetReadOnly: Boolean; - procedure PictureChanged(Sender: TObject); - procedure SetAutoDisplay(Value: Boolean); - procedure SetBorderStyle(Value: TBorderStyle); - procedure SetCenter(Value: Boolean); - procedure SetDataField(const Value: string); - procedure SetDataSource(Value: TDataSource); - procedure SetPicture(Value: TPicture); - procedure SetReadOnly(Value: Boolean); - procedure SetStretch(Value: Boolean); - procedure UpdateData(Sender: TObject); - procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK; - procedure CMEnter(var Message: TCMEnter); message CM_ENTER; - procedure CMExit(var Message: TCMExit); message CM_EXIT; - procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED; - procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN; - procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK; - procedure WMCut(var Message: TMessage); message WM_CUT; - procedure WMCopy(var Message: TMessage); message WM_COPY; - procedure WMPaste(var Message: TMessage); message WM_PASTE; - procedure WMSize(var Message: TMessage); message WM_SIZE; - protected - Memoria: TmemoryStream; - procedure CreateParams(var Params: TCreateParams); override; - function GetPalette: HPALETTE; override; - procedure KeyDown(var Key: Word; Shift: TShiftState); override; - procedure KeyPress(var Key: Char); override; - procedure Notification(AComponent: TComponent; Operation: TOperation); override; - procedure Paint; override; - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - procedure CopyToClipboard; - procedure CutToClipboard; - function ExecuteAction(Action: TBasicAction): Boolean; override; - procedure LoadPicture; - procedure PasteFromClipboard; - function UpdateAction(Action: TBasicAction): Boolean; override; - property Field: TField read GetField; - property Picture: TPicture read FPicture write SetPicture; - procedure LoadFromFile(const FileName: string);{v1.3} - procedure SaveToFile(const FileName: string); {v1.3} - published - property Align; - property Anchors; - property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True; - property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle; - property Center: Boolean read FCenter write SetCenter default True; - property Color; - property Constraints; - property Ctl3D; - property DataField: string read GetDataField write SetDataField; - property DataSource: TDataSource read GetDataSource write SetDataSource; - property DragCursor; - property DragKind; - property DragMode; - property Enabled; - property Font; - property ParentColor default False; - property ParentCtl3D; - property ParentFont; - property ParentShowHint; - property PopupMenu; - property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False; - property QuickDraw: Boolean read FQuickDraw write FQuickDraw default True; - property ShowHint; - property Stretch: Boolean read FStretch write SetStretch default False; - property TabOrder; - property TabStop default True; - property Visible; - property OnClick; - {$IFDEF DELPHI_5_UP} - property OnContextPopup; - {$ENDIF} - property OnDblClick; - property OnDragDrop; - property OnDragOver; - property OnEndDock; - property OnEndDrag; - property OnEnter; - property OnExit; - property OnKeyDown; - property OnKeyPress; - property OnKeyUp; - property OnMouseDown; - property OnMouseMove; - property OnMouseUp; - property OnStartDock; - property OnStartDrag; - property OnLoadCustomImage :TLoadCustomImageEvent read fOnLoadCustomImage write fOnLoadCustomImage; - end; - - -implementation -uses clipbrd, JPeg; - -constructor TEDBImage.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - ControlStyle := ControlStyle + [csOpaque, csReplicatable]; - if not NewStyleControls then ControlStyle := ControlStyle + [csFramed]; - Width := 105; - Height := 105; - TabStop := True; - ParentColor := False; - FPicture := TPicture.Create; - FPicture.OnChange := PictureChanged; - FBorderStyle := bsSingle; - FAutoDisplay := True; - FCenter := True; - FDataLink := TFieldDataLink.Create; - FDataLink.Control := Self; - FDataLink.OnDataChange := DataChange; - FDataLink.OnUpdateData := UpdateData; - FQuickDraw := True; - Memoria := TmemoryStream.Create; -end; - -destructor TEDBImage.Destroy; -begin - FPicture.Free; - FDataLink.Free; - FDataLink := nil; - Memoria.Free; - inherited Destroy; -end; - -function TEDBImage.GetDataSource: TDataSource; -begin - Result := FDataLink.DataSource; -end; - -procedure TEDBImage.SetDataSource(Value: TDataSource); -begin - if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then - FDataLink.DataSource := Value; - if Value <> nil then Value.FreeNotification(Self); -end; - -function TEDBImage.GetDataField: string; -begin - Result := FDataLink.FieldName; -end; - -procedure TEDBImage.SetDataField(const Value: string); -begin - FDataLink.FieldName := Value; -end; - -function TEDBImage.GetReadOnly: Boolean; -begin - Result := FDataLink.ReadOnly; -end; - -procedure TEDBImage.SetReadOnly(Value: Boolean); -begin - FDataLink.ReadOnly := Value; -end; - -function TEDBImage.GetField: TField; -begin - Result := FDataLink.Field; -end; - -function TEDBImage.GetPalette: HPALETTE; -begin - Result := 0; - if FPicture.Graphic <> nil then - Result := FPicture.Graphic.Palette; -{TGraphic has a property Pallete read GetPalette. and GetPalette is Virtual -Desendants re-implements GetPalette so I don't need ask what kind of Graphic is stored} -end; - -procedure TEDBImage.SetAutoDisplay(Value: Boolean); -begin - if FAutoDisplay <> Value then - begin - FAutoDisplay := Value; - if Value then LoadPicture; - end; -end; - -procedure TEDBImage.SetBorderStyle(Value: TBorderStyle); -begin - if FBorderStyle <> Value then - begin - FBorderStyle := Value; - RecreateWnd; - end; -end; - -procedure TEDBImage.SetCenter(Value: Boolean); -begin - if FCenter <> Value then - begin - FCenter := Value; - Invalidate; - end; -end; - -procedure TEDBImage.SetPicture(Value: TPicture); -begin - FPicture.Assign(Value); -end; - -procedure TEDBImage.SetStretch(Value: Boolean); -begin - if FStretch <> Value then - begin - FStretch := Value; - Invalidate; - end; -end; - -procedure TEDBImage.Paint; -var - Size: TSize; - R: TRect; - S: string; - DrawPict: TPicture; - Form: TCustomForm; - Pal: HPalette; -begin - with Canvas do - begin - Brush.Style := bsSolid; - Brush.Color := Color; - FillRect(ClientRect); - if FPictureLoaded or (csPaintCopy in ControlState) then - begin - DrawPict := TPicture.Create; - Pal := 0; - try - if (csPaintCopy in ControlState) and Assigned(FDataLink.Field) and FDataLink.Field.IsBlob then - begin - DrawPict.Assign(FDataLink.Field); - if DrawPict.Graphic is TBitmap then - DrawPict.Bitmap.IgnorePalette := QuickDraw; - end - else - begin - DrawPict.Assign(Picture); - if Focused and (DrawPict.Graphic <> nil) and (DrawPict.Graphic.Palette <> 0) then - begin { Control has focus, so realize the bitmap palette in foreground } - Pal := SelectPalette(Handle, DrawPict.Graphic.Palette, False); - RealizePalette(Handle); - end; - end; - if Stretch then - if (DrawPict.Graphic = nil) or DrawPict.Graphic.Empty then - FillRect(ClientRect) - else - StretchDraw(ClientRect, DrawPict.Graphic) - else - begin - SetRect(R, 0, 0, DrawPict.Width, DrawPict.Height); - if Center then - OffsetRect(R, (ClientWidth - DrawPict.Width) div 2, (ClientHeight - DrawPict.Height) div 2); - StretchDraw(R, DrawPict.Graphic); - ExcludeClipRect(Handle, R.Left, R.Top, R.Right, R.Bottom); - FillRect(ClientRect); - SelectClipRgn(Handle, 0); - end; - finally - if Pal <> 0 then SelectPalette(Handle, Pal, True); - DrawPict.Free; - end; - end - else - begin - Font := Self.Font; - if FDataLink.Field <> nil then - S := FDataLink.Field.DisplayLabel - else - S := Name; - S := '(' + S + ')'; - Size := TextExtent(S); - R := ClientRect; - TextRect(R, (R.Right - Size.cx) div 2, (R.Bottom - Size.cy) div 2, S); - end; - Form := GetParentForm(Self); - if (Form <> nil) and (Form.ActiveControl = Self) and - not (csDesigning in ComponentState) and not (csPaintCopy in ControlState) then - begin - Brush.Color := clWindowFrame; - FrameRect(ClientRect); - end; - end; -end; - -procedure TEDBImage.PictureChanged(Sender: TObject); -begin - if FPictureLoaded then FDataLink.Modified; - FPictureLoaded := True; - Invalidate; -end; - -procedure TEDBImage.Notification(AComponent: TComponent; Operation: TOperation); -begin - inherited Notification(AComponent, Operation); - if (Operation = opRemove) and (FDataLink <> nil) and - (AComponent = DataSource) then DataSource := nil; -end; - -procedure TEDBImage.LoadPicture; -var B: TGraphic; - Buf: word; -begin - with fDatalink do - if (Field = nil) or not Field.IsBlob or Field.IsNull then - begin - Picture.Assign(Nil); - Exit; - end; - - if not FPictureLoaded and (not Assigned(FDataLink.Field) - or FDataLink.Field.IsBlob) then - try - Memoria.Clear; - TBlobField(Field).SaveToStream(Memoria); - Memoria.Position :=0; - B:= nil; - if Memoria.Size > SizeOf(buf) then - begin - Memoria.read(buf, SizeOf(buf)); - case buf of - $0000 : B := TIcon.Create; - $0001 : begin - Picture.Assign(FDataLink.Field); - Exit; - end; - $4D42 : B := TBitmap.Create; - $CDD7 : B := TMetafile.Create; - $D8FF : B := TJPEGImage.Create; - end; - end; - Memoria.Position := 0; - if B <> nil then - try - B.LoadFromStream(Memoria); - except - B:= nil; - end; - //if the stored image is not ico, bmp, wmf, emf, jpg, jpeg - //or I cant load it then fire the event - if (b = nil) and Assigned(fonloadCustomImage) then - try - memoria.Position := 0; - fOnLoadCustomImage(B, Memoria); - except - B:= nil; - end; - - Picture.Assign(B);//B can be NIL, no problem with that - finally - B.Free; - Memoria.Clear; - end; -end; - -procedure TEDBImage.DataChange(Sender: TObject); -begin - Picture.Graphic := nil; - FPictureLoaded := False; - if FAutoDisplay then LoadPicture; -end; - -procedure TEDBImage.UpdateData(Sender: TObject); -var MS: TMemoryStream; -begin - if (Picture.Graphic is TBitmap) then - FDataLink.Field.Assign(Picture.Graphic) - else - begin - MS := TMemoryStream.Create; - try - try - Ms.Clear; - Picture.Graphic.SaveToStream(MS); - Ms.Position := 0; - TBlobField(Fdatalink.field).LoadFromStream(MS); - except - FDataLink.Field.Clear; - end; - finally - Ms.Free; - end; - end; -end; - -procedure TEDBImage.CopyToClipboard; -var TempBMP: tbitmap; -begin - if Picture.Graphic <> nil then - if Picture.Graphic is TICon then - begin - Tempbmp := Tbitmap.Create; - tempbmp.Width := Picture.graphic.width; - tempbmp.Height:= Picture.graphic.Height; - tempbmp.Canvas.Draw(0,0, Picture.Graphic); - clipboard.Assign(tempBmp); - tempbmp.Free; - end - else - Clipboard.Assign(Picture); -end; - -procedure TEDBImage.CutToClipboard; -begin - if Picture.Graphic <> nil then - if FDataLink.Edit then - begin - CopyToClipboard; - Picture.Graphic := nil; - PictureChanged(Self); - end; -end; - -procedure TEDBImage.PasteFromClipboard; -begin - if fDatalink.edit then - if ClipBoard.HasFormat(CF_BITMAP) then - Picture.Bitmap.Assign(Clipboard) - else - if ClipBoard.HasFormat(CF_METAFILEPICT)or ClipBoard.HasFormat(CF_ENHMETAFILE) then - picture.Metafile.Assign(ClipBoard) - else - if ClipBoard.hasformat(Cf_picture) then - picture.Assign(ClipBoard); - PictureChanged(Self); -end; - -procedure TEDBImage.CreateParams(var Params: TCreateParams); -begin - inherited CreateParams(Params); - with Params do - begin - if FBorderStyle = bsSingle then - if NewStyleControls and Ctl3D then - ExStyle := ExStyle or WS_EX_CLIENTEDGE - else - Style := Style or WS_BORDER; - WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW); - end; -end; - -procedure TEDBImage.KeyDown(var Key: Word; Shift: TShiftState); -begin - inherited KeyDown(Key, Shift); - case Key of - VK_INSERT: if ssShift in Shift then - PasteFromClipBoard - else - if ssCtrl in Shift then - CopyToClipBoard; - VK_DELETE: if ssShift in Shift then - CutToClipBoard; - end; -end; - -procedure TEDBImage.KeyPress(var Key: Char); -begin - inherited KeyPress(Key); - case Key of - ^X: CutToClipBoard; - ^C: CopyToClipBoard; - ^V: PasteFromClipBoard; - #13: LoadPicture; - #27: FDataLink.Reset; - end; -end; - -procedure TEDBImage.CMGetDataLink(var Message: TMessage); -begin - Message.Result := Integer(FDataLink); -end; - -procedure TEDBImage.CMEnter(var Message: TCMEnter); -begin - Invalidate; { Draw the focus marker } - inherited; -end; - -procedure TEDBImage.CMExit(var Message: TCMExit); -begin - try - FDataLink.UpdateRecord; - except - SetFocus; - raise; - end; - Invalidate; { Erase the focus marker } - inherited; -end; - -procedure TEDBImage.CMTextChanged(var Message: TMessage); -begin - inherited; - if not FPictureLoaded then Invalidate; -end; - -procedure TEDBImage.WMLButtonDown(var Message: TWMLButtonDown); -begin - if TabStop and CanFocus then SetFocus; - inherited; -end; - -procedure TEDBImage.WMLButtonDblClk(var Message: TWMLButtonDblClk); -begin - LoadPicture; - inherited; -end; - -procedure TEDBImage.WMCut(var Message: TMessage); -begin - CutToClipboard; -end; - -procedure TEDBImage.WMCopy(var Message: TMessage); -begin - CopyToClipboard; -end; - -procedure TEDBImage.WMPaste(var Message: TMessage); -begin - PasteFromClipboard; -end; - -procedure TEDBImage.WMSize(var Message: TMessage); -begin - inherited; - Invalidate; -end; - -function TEDBImage.ExecuteAction(Action: TBasicAction): Boolean; -begin - Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and - FDataLink.ExecuteAction(Action); -end; - -function TEDBImage.UpdateAction(Action: TBasicAction): Boolean; -begin - Result := inherited UpdateAction(Action) or (FDataLink <> nil) and - FDataLink.UpdateAction(Action); -end; - -procedure TEDBImage.LoadFromFile(const FileName: string); -begin - if Assigned(fDatalink.Field) and fDatalink.Field.IsBlob and fDatalink.Edit then - begin - TBlobField(fDatalink.Field).LoadFromFile(FileName); - PictureChanged(Self); - end; - -end; - -procedure TEDBImage.SaveToFile(const FileName: string); -begin - if FPictureLoaded and Assigned(FDataLink.Field) and FDataLink.Field.IsBlob then - TBlobField(fDatalink.Field).SaveToFile(FileName); -end; - -end. diff --git a/components/edbimage/source/QREDBImage.pas b/components/edbimage/source/QREDBImage.pas deleted file mode 100644 index c88d5d4e..00000000 --- a/components/edbimage/source/QREDBImage.pas +++ /dev/null @@ -1,296 +0,0 @@ -unit QREDBImage; -{ - TQREDBImage 1.0 (Enhaced TQRDBImage): - by Sebastián Mayorá - Argentina - DelphiHelper@yahoo.com.ar - Please read QREDBImage.txt or readme.txt for more information -} -interface - -uses - Windows, Classes,{Tstream } Graphics {TGraphic}, Db{field}, Controls{csopaque,csframe},forms {screen}, - QuickRpt; - -type - - TLoadCustomImageEvent = procedure (var B: TGraphic; Stream: TStream)of object; - - TQREDBImage = class(TQRPrintable) - private - FField : TField; - FDataSet : TDataSet; - FDataField : string; - FPicture: TPicture; - FStretch: boolean; - FCenter: boolean; - FPictureLoaded: boolean; - fOnLoadCustomImage: TLoadCustomImageEvent; - procedure PictureChanged(Sender: TObject); - procedure SetCenter(Value: Boolean); - procedure SetDataField(const Value: string); - procedure SetDataSet(Value: TDataSet); - procedure SetPicture(Value: TPicture); - procedure SetStretch(Value: Boolean); - protected - Memoria: TMemoryStream; - function GetPalette: HPALETTE; override; - procedure Notification(AComponent: TComponent; Operation: TOperation); override; - procedure Paint; override; - procedure Prepare; override; - procedure Print(OfsX, OfsY : integer); override; - procedure UnPrepare; override; - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - procedure LoadPicture;//Si hubiera sido virtual en la clase ancestro... - property Field: TField read FField; - property Picture: TPicture read FPicture write SetPicture; - published - property Center: boolean read FCenter write SetCenter default True; - property DataField: string read FDataField write SetDataField; - property DataSet: TDataSet read FDataSet write SetDataSet; - property Stretch: boolean read FStretch write SetStretch default False; - property OnLoadCustomImage :TLoadCustomImageEvent read fOnLoadCustomImage write fOnLoadCustomImage; - end; - -implementation -uses JPeg; - -constructor TQREDBImage.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - ControlStyle := ControlStyle + [csFramed, csOpaque]; - Width := 105; - Height := 105; - FPicture := TPicture.Create; - FPicture.OnChange := PictureChanged; - FCenter := True; - Memoria := TMemoryStream.Create; -end; - -destructor TQREDBImage.Destroy; -begin - FPicture.Free; - Memoria.Free; - inherited Destroy; -end; - -procedure TQREDBImage.Prepare; -begin - inherited Prepare; - if assigned(FDataSet) then - begin - FField := DataSet.FindField(FDataField); - if Field is TBlobField then - Caption := ''; - LoadPicture; - end - else - FField := nil; -end; - -procedure TQREDBImage.Print(OfsX, OfsY : integer); -var - H: integer; - Dest: TRect; - DrawPict: TPicture; -begin - with QRPrinter.Canvas do - begin - Brush.Style := bsSolid; - Brush.Color := Color; - DrawPict := TPicture.Create; - H := 0; - try - if assigned(FField) and (FField is TBlobField) then - begin - if not fPictureLoaded then - LoadPicture; - DrawPict.Assign(Picture); - if (DrawPict.Graphic <> nil) and (DrawPict.Graphic.Palette <> 0) then - begin - H := SelectPalette(Handle, DrawPict.Graphic.Palette, false); - RealizePalette(Handle); - end; - Dest.Left := QRPrinter.XPos(OfsX + Size.Left); - Dest.Top := QRPrinter.YPos(OfsY + Size.Top); - Dest.Right := QRPrinter.XPos(OfsX + Size.Width + Size.Left); - Dest.Bottom := QRPrinter.YPos(OfsY + Size.Height + Size.Top); - if Stretch then - begin - if (DrawPict.Graphic = nil) or DrawPict.Graphic.Empty then - FillRect(Dest) - else - with QRPrinter.Canvas do - StretchDraw(Dest, DrawPict.Graphic); - end - else - begin - IntersectClipRect(Handle, Dest.Left, Dest.Top, Dest.Right, Dest.Bottom); - Dest.Right := Dest.Left + - round(DrawPict.Width / Screen.PixelsPerInch * 254 * ParentReport.QRPrinter.XFactor); - Dest.Bottom := Dest.Top + - round(DrawPict.Height / Screen.PixelsPerInch * 254 * ParentReport.QRPrinter.YFactor); - if Center then OffsetRect(Dest, - (QRPrinter.XSize(Size.Width) - - round(DrawPict.Width / Screen.PixelsPerInch * 254 * ParentReport.QRPrinter.XFactor)) div 2, - (QRPrinter.YSize(Size.Height) - - round(DrawPict.Height / Screen.PixelsPerInch * 254 * ParentReport.QRPrinter.YFactor)) div 2); - QRPrinter.Canvas.StretchDraw(Dest, DrawPict.Graphic); - SelectClipRgn(Handle, 0); - end; - end; - finally - if H <> 0 then SelectPalette(Handle, H, True); - DrawPict.Free; - fPictureLoaded := False; - end; - end; - inherited Print(OfsX,OfsY); -end; - -procedure TQREDBImage.Unprepare; -begin - FField := nil; - inherited Unprepare; -end; - -procedure TQREDBImage.SetDataSet(Value: TDataSet); -begin - FDataSet := Value; - if Value <> nil then Value.FreeNotification(Self); -end; - -procedure TQREDBImage.SetDataField(const Value: string); -begin - FDataField := Value; -end; - -function TQREDBImage.GetPalette: HPALETTE; -begin - Result := 0; - if FPicture.Graphic <> nil then - Result := FPicture.Graphic.Palette; -end; - -procedure TQREDBImage.SetCenter(Value: Boolean); -begin - if FCenter <> Value then - begin - FCenter := Value; - Invalidate; - end; -end; - -procedure TQREDBImage.SetPicture(Value: TPicture); -begin - FPicture.Assign(Value); -end; - -procedure TQREDBImage.SetStretch(Value: Boolean); -begin - if FStretch <> Value then - begin - FStretch := Value; - Invalidate; - end; -end; - -procedure TQREDBImage.Paint; -var - W, H: Integer; - R: TRect; - S: string; -begin - with Canvas do - begin - Brush.Style := bsSolid; - Brush.Color := Color; - Font := Self.Font; - if Field <> nil then - S := Field.DisplayLabel - else - S := Name; - S := '(' + S + ')'; - W := TextWidth(S); - H := TextHeight(S); - R := ClientRect; - TextRect(R, (R.Right - W) div 2, (R.Bottom - H) div 2, S); - end; - Inherited Paint; -end; - -procedure TQREDBImage.PictureChanged(Sender: TObject); -begin - FPictureLoaded := True; - Invalidate; -end; - -procedure TQREDBImage.Notification(AComponent: TComponent; - Operation: TOperation); -begin - inherited Notification(AComponent, Operation); - if (Operation = opRemove) and (AComponent = DataSet) then - DataSet := nil; -end; - -procedure TQREDBImage.LoadPicture; -{ begin - if not FPictureLoaded and (Field is TBlobField) then - Picture.Assign(FField); } -var B: TGraphic; - Buf: word; -begin - if (Field = nil) or not Field.IsBlob or Field.IsNull then - begin - Picture.Assign(Nil); - Exit; - end; - - if not FPictureLoaded and (not Assigned(Field) - or Field.IsBlob) then - try - Memoria.Clear; - TBlobField(Field).SaveToStream(Memoria); - Memoria.Position := 0; - B:= nil; - if Memoria.Size > SizeOf(buf) then - begin - Memoria.read(buf, SizeOf(buf)); - case buf of - $0000 : B := TIcon.Create; - $0001 : begin - Picture.Assign(Field); - Exit; - end; - $4D42 : B := TBitmap.Create; - $CDD7 : B := TMetafile.Create; - $D8FF : B := TJPEGImage.Create; - end; - end; - Memoria.Position := 0; - if B <> nil then - try - B.LoadFromStream(Memoria); - except - B:= nil; - end; - //if the stored image is not ico, bmp, wmf, emf, jpg, jpeg - //or I cant load it then fire the event - if (b = nil) and Assigned(fOnLoadCustomImage) then - try - memoria.Position := 0; - fOnLoadCustomImage(B, Memoria); - except - B:= nil; - end; - - Picture.Assign(B);//B can be NIL, no problem with that - finally - B.Free; - Memoria.Clear; - end; -end; - - -end. - diff --git a/components/edbimage/source/uSerREG.pas b/components/edbimage/source/uSerREG.pas deleted file mode 100644 index 1998a8c7..00000000 --- a/components/edbimage/source/uSerREG.pas +++ /dev/null @@ -1,80 +0,0 @@ -unit UserReg; - -interface - -{$R CompsSer.dcr} -{$I compilers.inc} -procedure Register; - -implementation -uses Classes , {RegisterComponent} - - {$IFDEF DELPHI_6_UP} - DesignIntf, DesignEditors, - {$ELSE} - DsgnIntf, { RegisterComponentEditor} - {$ENDIF} - - TypInfo, {propiedad Dataset del QREDBimage} - DB, {para acceder al Dataset del reporte} - - { PictEdit, {TGraphicEditor } - // qrEDBimage, - edbimage; { mis componentes } - -{type - TQREDBImageFieldProperty = Class (TStringProperty) - public - function GetAttributes : TPropertyAttributes; override; - procedure GetValues(Proc : TGetStrProc); override; - procedure GetValueList(List : TStrings); - end;} - - -{ TQREDBImageFieldProperty } - -{function TQREDBImageFieldProperty.GetAttributes: TPropertyAttributes; -begin - Result := [paValueList, paSortList, paMultiSelect]; -end; - -procedure TQREDBImageFieldProperty.GetValueList(List: TStrings); -var - Instance: TComponent; - PropInfo: PPropInfo; - DataSet: TDataSet; -begin - Instance := TComponent(GetComponent(0)); - PropInfo := TypInfo.GetPropInfo(Instance.ClassInfo, 'DataSet'); - if (PropInfo <> nil) and (PropInfo^.PropType^.Kind = tkClass) then - begin - DataSet := TObject(GetOrdProp(Instance, PropInfo)) as TDataSet; - if (DataSet <> nil) then - DataSet.GetFieldNames(List); - end; -end; - -procedure TQREDBImageFieldProperty.GetValues(Proc: TGetStrProc); -var - I: Integer; - Values: TStringList; -begin - Values := TStringList.Create; - try - GetValueList(Values); - for I := 0 to Values.Count - 1 do Proc(Values[I]); - finally - Values.Free; - end; -end;} - -procedure Register; -begin - RegisterComponents('Data Controls', [TEDBImage]); - //RegisterComponents('QReport',[TQREDBImage]); - //RegisterPropertyEditor(TypeInfo(string), TQREDBImage, 'DataField', TQREDBImageFieldProperty); {<-- do not resource } -end; - - -end. - diff --git a/extra/build_everything.cmd b/extra/build_everything.cmd index 1186b64d..0f4d012b 100644 --- a/extra/build_everything.cmd +++ b/extra/build_everything.cmd @@ -174,13 +174,6 @@ goto :eof :build echo. -rem Build EDBImage -call :compile edbimage VCLSer -if not %err% == 0 goto end -call :compile edbimage DCLSer -if not %err% == 0 goto end - - rem Build SynEdit call :compile synedit SynEditR if not %err% == 0 goto end diff --git a/extra/install_ide_components.cmd b/extra/install_ide_components.cmd index 720285b1..89baddf4 100644 --- a/extra/install_ide_components.cmd +++ b/extra/install_ide_components.cmd @@ -101,11 +101,6 @@ goto :eof :start echo. -rem Install EDBImage -call :install edbimage DCLSer -if not %err% == 0 goto end - - rem Install SynEdit call :install synedit SynEditD if not %err% == 0 goto end diff --git a/superpackages/delphi11/heidisql.groupproj b/superpackages/delphi11/heidisql.groupproj index 753f079c..3a2abb04 100644 --- a/superpackages/delphi11/heidisql.groupproj +++ b/superpackages/delphi11/heidisql.groupproj @@ -8,24 +8,6 @@ - - - - - - - - - - - - - - - - - - @@ -180,12 +162,12 @@ - + - + - + - \ No newline at end of file +