mirror of
https://github.com/HeidiSQL/HeidiSQL.git
synced 2025-08-06 18:24:26 +08:00
Remove EDBImage.
This commit is contained in:
rosenfield.albert
@ -1,49 +0,0 @@
|
||||
TEDBImage 1.4 and TQREDBImage 1.0 (Enhaced TDBImage and TQRDBImage):
|
||||
by Sebasti<74>n Mayor<6F> - Argentina - DelphiHelper@yahoo.com.ar
|
||||
|
||||
TQREDBimage was designed for printing image files. It has the same features that TEDBImage has.
|
||||
|
||||
<EFBFBD>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,....)
|
||||
|
||||
<EFBFBD>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.!!!
|
||||
|
||||
|
||||
|
||||
<EFBFBD>Please mail me for: - Bugs
|
||||
- Suggestinons
|
||||
- say Hello.
|
||||
- Comments
|
||||
- etc...
|
||||
|
||||
<EFBFBD>New in this version. 1.4
|
||||
- Optimized LoadPicture;
|
||||
- Some bugs fixed
|
||||
- Added LoadFromFile and SavetoFile methods
|
||||
|
||||
<EFBFBD>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<65> Simon and Dayne for their help.
|
||||
|
||||
THIS IS FREEWARE - USE AT YOUR OWN RISK, ETC, ETC
|
||||
@ -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.
|
||||
@ -1,57 +0,0 @@
|
||||
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||
<PropertyGroup>
|
||||
<ProjectGuid>{9a6865b1-e809-47ff-bee6-8a495fadf975}</ProjectGuid>
|
||||
<MainSource>DCLSer.dpk</MainSource>
|
||||
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
|
||||
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
|
||||
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
|
||||
<Version>7.0</Version>
|
||||
<DCC_DebugInformation>False</DCC_DebugInformation>
|
||||
<DCC_WriteableConstants>True</DCC_WriteableConstants>
|
||||
<DCC_LocalDebugSymbols>False</DCC_LocalDebugSymbols>
|
||||
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
|
||||
<DCC_Define>RELEASE</DCC_Define>
|
||||
<DCC_DcuOutput>..\..\build</DCC_DcuOutput>
|
||||
<DCC_ObjOutput>..\..\build</DCC_ObjOutput>
|
||||
<DCC_HppOutput>..\..\build</DCC_HppOutput>
|
||||
<DCC_BplOutput>..\..\build</DCC_BplOutput>
|
||||
<DCC_DcpOutput>..\..\build</DCC_DcpOutput>
|
||||
<DCC_UnitSearchPath>..\..\..\compilerdetection\include;..\..\resources;..\..\build</DCC_UnitSearchPath>
|
||||
<DCC_ResourcePath>..\..\..\compilerdetection\include;..\..\resources;..\..\build</DCC_ResourcePath>
|
||||
<DCC_ObjPath>..\..\..\compilerdetection\include;..\..\resources;..\..\build</DCC_ObjPath>
|
||||
<DCC_IncludePath>..\..\..\compilerdetection\include;..\..\resources;..\..\build</DCC_IncludePath>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
|
||||
<Version>7.0</Version>
|
||||
<DCC_DebugInformation>False</DCC_DebugInformation>
|
||||
<DCC_WriteableConstants>True</DCC_WriteableConstants>
|
||||
<DCC_LocalDebugSymbols>False</DCC_LocalDebugSymbols>
|
||||
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
|
||||
<DCC_DcuOutput>..\..\build</DCC_DcuOutput>
|
||||
<DCC_ObjOutput>..\..\build</DCC_ObjOutput>
|
||||
<DCC_HppOutput>..\..\build</DCC_HppOutput>
|
||||
<DCC_BplOutput>..\..\build</DCC_BplOutput>
|
||||
<DCC_DcpOutput>..\..\build</DCC_DcpOutput>
|
||||
<DCC_UnitSearchPath>..\..\..\compilerdetection\include;..\..\resources;..\..\build</DCC_UnitSearchPath>
|
||||
<DCC_ResourcePath>..\..\..\compilerdetection\include;..\..\resources;..\..\build</DCC_ResourcePath>
|
||||
<DCC_ObjPath>..\..\..\compilerdetection\include;..\..\resources;..\..\build</DCC_ObjPath>
|
||||
<DCC_IncludePath>..\..\..\compilerdetection\include;..\..\resources;..\..\build</DCC_IncludePath>
|
||||
</PropertyGroup>
|
||||
<ProjectExtensions>
|
||||
<Borland.Personality>Delphi.Personality</Borland.Personality>
|
||||
<Borland.ProjectType>Package</Borland.ProjectType>
|
||||
<BorlandProject>
|
||||
<BorlandProject><Delphi.Personality><Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters></Parameters><Package_Options><Package_Options Name="PackageDescription">EDBImage 1.4 by SER</Package_Options><Package_Options Name="ImplicitBuild">False</Package_Options><Package_Options Name="DesigntimeOnly">True</Package_Options><Package_Options Name="RuntimeOnly">False</Package_Options><Package_Options Name="LibSuffix">110</Package_Options></Package_Options><VersionInfo><VersionInfo Name="IncludeVerInfo">True</VersionInfo><VersionInfo Name="AutoIncBuild">False</VersionInfo><VersionInfo Name="MajorVer">1</VersionInfo><VersionInfo Name="MinorVer">0</VersionInfo><VersionInfo Name="Release">0</VersionInfo><VersionInfo Name="Build">0</VersionInfo><VersionInfo Name="Debug">False</VersionInfo><VersionInfo Name="PreRelease">False</VersionInfo><VersionInfo Name="Special">False</VersionInfo><VersionInfo Name="Private">False</VersionInfo><VersionInfo Name="DLL">False</VersionInfo><VersionInfo Name="Locale">1046</VersionInfo><VersionInfo Name="CodePage">1252</VersionInfo></VersionInfo><VersionInfoKeys><VersionInfoKeys Name="CompanyName"></VersionInfoKeys><VersionInfoKeys Name="FileDescription"></VersionInfoKeys><VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="InternalName"></VersionInfoKeys><VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys><VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys><VersionInfoKeys Name="ProductName"></VersionInfoKeys><VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="Comments"></VersionInfoKeys></VersionInfoKeys><Source><Source Name="MainSource">DCLSer.dpk</Source></Source></Delphi.Personality></BorlandProject></BorlandProject>
|
||||
</ProjectExtensions>
|
||||
<Import Project="$(MSBuildBinPath)\Borland.Delphi.Targets" />
|
||||
<ItemGroup>
|
||||
<DelphiCompile Include="DCLSer.dpk">
|
||||
<MainSource>MainSource</MainSource>
|
||||
</DelphiCompile>
|
||||
<DCCReference Include="..\..\source\uSerREG.pas" />
|
||||
<DCCReference Include="designide.dcp" />
|
||||
<DCCReference Include="VCLSer.dcp" />
|
||||
</ItemGroup>
|
||||
</Project>
|
||||
@ -1,40 +0,0 @@
|
||||
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||
<PropertyGroup>
|
||||
<ProjectGuid>{2e7db4ae-1c78-4ce6-a3d4-c1a9b0900a5b}</ProjectGuid>
|
||||
</PropertyGroup>
|
||||
<ItemGroup />
|
||||
<ItemGroup />
|
||||
<ProjectExtensions>
|
||||
<Borland.Personality>Default.Personality</Borland.Personality>
|
||||
<Borland.ProjectType />
|
||||
<BorlandProject>
|
||||
<BorlandProject xmlns=""><Default.Personality></Default.Personality></BorlandProject></BorlandProject>
|
||||
</ProjectExtensions>
|
||||
<Target Name="VCLSer">
|
||||
<MSBuild Projects="VCLSer.dproj" Targets="" />
|
||||
</Target>
|
||||
<Target Name="VCLSer:Clean">
|
||||
<MSBuild Projects="VCLSer.dproj" Targets="Clean" />
|
||||
</Target>
|
||||
<Target Name="VCLSer:Make">
|
||||
<MSBuild Projects="VCLSer.dproj" Targets="Make" />
|
||||
</Target>
|
||||
<Target Name="DCLSer">
|
||||
<MSBuild Projects="DCLSer.dproj" Targets="" />
|
||||
</Target>
|
||||
<Target Name="DCLSer:Clean">
|
||||
<MSBuild Projects="DCLSer.dproj" Targets="Clean" />
|
||||
</Target>
|
||||
<Target Name="DCLSer:Make">
|
||||
<MSBuild Projects="DCLSer.dproj" Targets="Make" />
|
||||
</Target>
|
||||
<Target Name="Build">
|
||||
<CallTarget Targets="VCLSer;DCLSer" />
|
||||
</Target>
|
||||
<Target Name="Clean">
|
||||
<CallTarget Targets="VCLSer:Clean;DCLSer:Clean" />
|
||||
</Target>
|
||||
<Target Name="Make">
|
||||
<CallTarget Targets="VCLSer:Make;DCLSer:Make" />
|
||||
</Target>
|
||||
</Project>
|
||||
@ -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.
|
||||
@ -1,59 +0,0 @@
|
||||
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||
<PropertyGroup>
|
||||
<ProjectGuid>{94ee90f0-216e-4647-98ac-a66563820ad8}</ProjectGuid>
|
||||
<MainSource>VCLSer.dpk</MainSource>
|
||||
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
|
||||
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
|
||||
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
|
||||
<Version>7.0</Version>
|
||||
<DCC_DebugInformation>False</DCC_DebugInformation>
|
||||
<DCC_WriteableConstants>True</DCC_WriteableConstants>
|
||||
<DCC_LocalDebugSymbols>False</DCC_LocalDebugSymbols>
|
||||
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
|
||||
<DCC_Define>RELEASE</DCC_Define>
|
||||
<DCC_DcuOutput>..\..\build</DCC_DcuOutput>
|
||||
<DCC_ObjOutput>..\..\build</DCC_ObjOutput>
|
||||
<DCC_HppOutput>..\..\build</DCC_HppOutput>
|
||||
<DCC_BplOutput>..\..\build</DCC_BplOutput>
|
||||
<DCC_DcpOutput>..\..\build</DCC_DcpOutput>
|
||||
<DCC_UnitSearchPath>..\..\..\compilerdetection\include</DCC_UnitSearchPath>
|
||||
<DCC_ResourcePath>..\..\..\compilerdetection\include</DCC_ResourcePath>
|
||||
<DCC_ObjPath>..\..\..\compilerdetection\include</DCC_ObjPath>
|
||||
<DCC_IncludePath>..\..\..\compilerdetection\include</DCC_IncludePath>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
|
||||
<Version>7.0</Version>
|
||||
<DCC_DebugInformation>False</DCC_DebugInformation>
|
||||
<DCC_WriteableConstants>True</DCC_WriteableConstants>
|
||||
<DCC_LocalDebugSymbols>False</DCC_LocalDebugSymbols>
|
||||
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
|
||||
<DCC_DcuOutput>..\..\build</DCC_DcuOutput>
|
||||
<DCC_ObjOutput>..\..\build</DCC_ObjOutput>
|
||||
<DCC_HppOutput>..\..\build</DCC_HppOutput>
|
||||
<DCC_BplOutput>..\..\build</DCC_BplOutput>
|
||||
<DCC_DcpOutput>..\..\build</DCC_DcpOutput>
|
||||
<DCC_UnitSearchPath>..\..\..\compilerdetection\include;..\..\resources</DCC_UnitSearchPath>
|
||||
<DCC_ResourcePath>..\..\..\compilerdetection\include;..\..\resources</DCC_ResourcePath>
|
||||
<DCC_ObjPath>..\..\..\compilerdetection\include;..\..\resources</DCC_ObjPath>
|
||||
<DCC_IncludePath>..\..\..\compilerdetection\include;..\..\resources</DCC_IncludePath>
|
||||
</PropertyGroup>
|
||||
<ProjectExtensions>
|
||||
<Borland.Personality>Delphi.Personality</Borland.Personality>
|
||||
<Borland.ProjectType>Package</Borland.ProjectType>
|
||||
<BorlandProject>
|
||||
<BorlandProject><Delphi.Personality><Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters></Parameters><Package_Options><Package_Options Name="PackageDescription">EDBImage 1.4 Runtime by SER</Package_Options><Package_Options Name="ImplicitBuild">False</Package_Options><Package_Options Name="DesigntimeOnly">False</Package_Options><Package_Options Name="RuntimeOnly">True</Package_Options><Package_Options Name="LibSuffix">110</Package_Options></Package_Options><VersionInfo><VersionInfo Name="IncludeVerInfo">True</VersionInfo><VersionInfo Name="AutoIncBuild">False</VersionInfo><VersionInfo Name="MajorVer">1</VersionInfo><VersionInfo Name="MinorVer">0</VersionInfo><VersionInfo Name="Release">0</VersionInfo><VersionInfo Name="Build">0</VersionInfo><VersionInfo Name="Debug">False</VersionInfo><VersionInfo Name="PreRelease">False</VersionInfo><VersionInfo Name="Special">False</VersionInfo><VersionInfo Name="Private">False</VersionInfo><VersionInfo Name="DLL">False</VersionInfo><VersionInfo Name="Locale">1046</VersionInfo><VersionInfo Name="CodePage">1252</VersionInfo></VersionInfo><VersionInfoKeys><VersionInfoKeys Name="CompanyName"></VersionInfoKeys><VersionInfoKeys Name="FileDescription"></VersionInfoKeys><VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="InternalName"></VersionInfoKeys><VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys><VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys><VersionInfoKeys Name="ProductName"></VersionInfoKeys><VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="Comments"></VersionInfoKeys></VersionInfoKeys><Source><Source Name="MainSource">VCLSer.dpk</Source></Source></Delphi.Personality></BorlandProject></BorlandProject>
|
||||
</ProjectExtensions>
|
||||
<Import Project="$(MSBuildBinPath)\Borland.Delphi.Targets" />
|
||||
<ItemGroup>
|
||||
<DelphiCompile Include="VCLSer.dpk">
|
||||
<MainSource>MainSource</MainSource>
|
||||
</DelphiCompile>
|
||||
<DCCReference Include="..\..\source\EDBImage.pas" />
|
||||
<DCCReference Include="bdertl.dcp" />
|
||||
<DCCReference Include="dbrtl.dcp" />
|
||||
<DCCReference Include="vcldb.dcp" />
|
||||
<DCCReference Include="vcljpg.dcp" />
|
||||
</ItemGroup>
|
||||
</Project>
|
||||
Binary file not shown.
@ -1,597 +0,0 @@
|
||||
unit EDBImage;
|
||||
{$I compilers.inc}
|
||||
{
|
||||
TEDBImage 1.4 (Enhaced TDBImage):
|
||||
by Sebasti<74>n Mayor<6F> - 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<69>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.
|
||||
@ -1,296 +0,0 @@
|
||||
unit QREDBImage;
|
||||
{
|
||||
TQREDBImage 1.0 (Enhaced TQRDBImage):
|
||||
by Sebasti<74>n Mayor<6F> - 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.
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -8,24 +8,6 @@
|
||||
<BorlandProject>
|
||||
<BorlandProject xmlns=""> <Default.Personality> </Default.Personality> </BorlandProject></BorlandProject>
|
||||
</ProjectExtensions>
|
||||
<Target Name="VCLSer">
|
||||
<MSBuild Projects="..\..\components\edbimage\packages\delphi11\VCLSer.dproj" Targets="" />
|
||||
</Target>
|
||||
<Target Name="VCLSer:Clean">
|
||||
<MSBuild Projects="..\..\components\edbimage\packages\delphi11\VCLSer.dproj" Targets="Clean" />
|
||||
</Target>
|
||||
<Target Name="VCLSer:Make">
|
||||
<MSBuild Projects="..\..\components\edbimage\packages\delphi11\VCLSer.dproj" Targets="Make" />
|
||||
</Target>
|
||||
<Target Name="DCLSer">
|
||||
<MSBuild Projects="..\..\components\edbimage\packages\delphi11\DCLSer.dproj" Targets="" />
|
||||
</Target>
|
||||
<Target Name="DCLSer:Clean">
|
||||
<MSBuild Projects="..\..\components\edbimage\packages\delphi11\DCLSer.dproj" Targets="Clean" />
|
||||
</Target>
|
||||
<Target Name="DCLSer:Make">
|
||||
<MSBuild Projects="..\..\components\edbimage\packages\delphi11\DCLSer.dproj" Targets="Make" />
|
||||
</Target>
|
||||
<Target Name="SynEditR">
|
||||
<MSBuild Projects="..\..\components\synedit\Packages\delphi11\SynEditR.dproj" Targets="" />
|
||||
</Target>
|
||||
@ -180,12 +162,12 @@
|
||||
<MSBuild Projects="..\..\packages\delphi11\heidisql.dproj" Targets="Make" />
|
||||
</Target>
|
||||
<Target Name="Build">
|
||||
<CallTarget Targets="VCLSer;DCLSer;SynEditR;SynEditD;ZCore;ZPlain;ZParseSql;ZDbc;ZComponent;ZComponentDesign;HeidiComponents;TntUnicodeVcl;TntUnicodeVcl_Design;VirtualTreesR;VirtualTreesD;PNG;PngComponents;PngComponentsD;heidisql" />
|
||||
<CallTarget Targets="SynEditR;SynEditD;ZCore;ZPlain;ZParseSql;ZDbc;ZComponent;ZComponentDesign;HeidiComponents;TntUnicodeVcl;TntUnicodeVcl_Design;VirtualTreesR;VirtualTreesD;PNG;PngComponents;PngComponentsD;heidisql" />
|
||||
</Target>
|
||||
<Target Name="Clean">
|
||||
<CallTarget Targets="VCLSer:Clean;DCLSer:Clean;SynEditR:Clean;SynEditD:Clean;ZCore:Clean;ZPlain:Clean;ZParseSql:Clean;ZDbc:Clean;ZComponent:Clean;ZComponentDesign:Clean;HeidiComponents:Clean;TntUnicodeVcl:Clean;TntUnicodeVcl_Design:Clean;VirtualTreesR:Clean;VirtualTreesD:Clean;PNG:Clean;PngComponents:Clean;PngComponentsD:Clean;heidisql:Clean" />
|
||||
<CallTarget Targets="SynEditR:Clean;SynEditD:Clean;ZCore:Clean;ZPlain:Clean;ZParseSql:Clean;ZDbc:Clean;ZComponent:Clean;ZComponentDesign:Clean;HeidiComponents:Clean;TntUnicodeVcl:Clean;TntUnicodeVcl_Design:Clean;VirtualTreesR:Clean;VirtualTreesD:Clean;PNG:Clean;PngComponents:Clean;PngComponentsD:Clean;heidisql:Clean" />
|
||||
</Target>
|
||||
<Target Name="Make">
|
||||
<CallTarget Targets="VCLSer:Make;DCLSer:Make;SynEditR:Make;SynEditD:Make;ZCore:Make;ZPlain:Make;ZParseSql:Make;ZDbc:Make;ZComponent:Make;ZComponentDesign:Make;HeidiComponents:Make;TntUnicodeVcl:Make;TntUnicodeVcl_Design:Make;VirtualTreesR:Make;VirtualTreesD:Make;PNG:Make;PngComponents:Make;PngComponentsD:Make;heidisql:Make" />
|
||||
<CallTarget Targets="SynEditR:Make;SynEditD:Make;ZCore:Make;ZPlain:Make;ZParseSql:Make;ZDbc:Make;ZComponent:Make;ZComponentDesign:Make;HeidiComponents:Make;TntUnicodeVcl:Make;TntUnicodeVcl_Design:Make;VirtualTreesR:Make;VirtualTreesD:Make;PNG:Make;PngComponents:Make;PngComponentsD:Make;heidisql:Make" />
|
||||
</Target>
|
||||
</Project>
|
||||
</Project>
|
||||
|
||||
Reference in New Issue
Block a user