Using the Magnifying Glass (Delphi 4.0)
Take the following steps to enable the generation of the MagGlassExt event and updating the zoomed image using the Internet COM object toolkit.
1. |
Start Delphi. |
|
2. |
If you didn’t install LEAD RasterView Control, install it. |
|
|
On the Component pull-down menu, use the Import ActiveX Control… and select the LEAD RasterView Control (14.5), and Press install. |
|
3. |
On the Project pull-down menu, use the Import Type library… and select the LEAD Raster Internet Object Library (14.5). |
|
4. |
On the Project pull-down menu, use the Import Type library… and select the LEAD Raster Object Library (14.5) |
|
5. |
Select the LEAD RasterView control; then add the control to your main form. Size and position the control as you want it to appear at run time. |
|
6. |
If you didn’t install LEvntSnk, install it. |
|
|
On the Component pull-down menu, use install component …, and browse to LEADXX\Include\LEvntSnk.pas, and press Ok. |
|
7. |
From the ActiveX controls, Add the LEvntSnk control to your form. |
|
8. |
Add seven command buttons to your main form and name them as follows: |
|
|
Name |
Caption |
|
StartUpServer |
Start Up Server |
|
ShutDownServer |
Shut Server Down |
|
ConnectToRemoteServer |
Connect To Remote Server |
|
DisconnectFromRemoteServer |
Disconnect From Remote Server |
|
LoadRemoteImage |
Load Remote Image |
|
StartMagnifyingGlass |
Start Magnifying Glass |
|
StopMagnifyingGlass |
Stop Magnifying Glass |
9. |
Add an Edit box to your main form and name it as follows: |
|
|
Name |
|
|
RemoteComputer. |
|
10. |
Set the Text property to the name of the computer you will use as a server. |
|
11. |
Declare the following in the Private section of Unit1. |
hServer: Integer; //handle to server
gnCommandID: Longint;
bMagGlass: Boolean;
RasterIO: LEADRasterIO;
LEADNet1: LEADRasterInet;
12. |
Add the following initialization code to the main form's Load procedure. In online help, you can use the Edit pull-down menu to copy the block of code. |
procedure TForm1.FormCreate(Sender: TObject);
var
LEADRas: LEADRaster;
begin
// Initialize some variables
hServer := 0;
gnCommandID := 0;
bMagGlass := False;
// Set defaults for displaying the image.
// These are all persistent properties that can be set in the properties box.
LEADRasterView1.Appearance := RASTERVIEW_APPEARANCE_FLAT;
LEADRasterView1.BorderStyle := 1;
LEADRasterView1.BackColor := RGB(255, 255, 125);
LEADRasterView1.PaintDither := PAINTDITHER_DIFFUSION;
LEADRasterView1.PaintPalette := PAINTPALETTE_AUTO;
LEADRasterView1.AutoRepaint := True;
LEADRasterView1.AutoSize := False;
LEADRasterView1.AutoSetRects := True;
LEADRasterView1.PaintSizeMode := PAINTSIZEMODE_FIT;
// Create the Raster IO and Raster Inet objects
RasterIO := CoLEADRasterIO.Create ();
LEADNet1 := CoLEADRasterInet.Create ();
// Create a temp LEADRaster object and use it
// to unlock support for the Inet object
LEADRas := CreateComObject (CLASS_LEADRaster) as LEADRaster;
// Stop generation of runtime exceptions for LEAD RasterView Control, LEAD
// RasterIO Object Library and LEAD Raster Internet Object Library.
LEADRasterView1.EnableMethodErrors := False;
RasterIO.EnableMethodErrors := False;
LEADNet1.EnableMethodErrors := 0;
end;
13. |
Code the main form's Destroy procedure as follows: |
procedure TForm1.FormDestroy(Sender: TObject);
var
sRet: Smallint;
i: Integer;
begin
//Disconnect all connections
LEADNet1.ConnectListNum;
for i := 0 to LEADNet1.ConnectListNum - 1 do
LEADNet1.InetDisconnect (LEADNet1.ConnectList [i]);
if (bMagGlass) then
LEADRasterView1.StopMagGlass (sRet);
end;
14. |
Code the StartUpServer button's click procedure as follows: |
procedure TForm1.StartUpServerClick(Sender: TObject);
var
nRet: Integer;
begin
//Initialize server on port 1000
nRet:= LEADNet1.InetServerInit (1000);
hServer:= LEADNet1.InetServerHandle;
if (nRet <> 0) then
ShowMessage ('Error Initializing server: ' + IntToStr(nRet));
end;
15. |
Code the ShutDownServer button's click procedure as follows: |
procedure TForm1.ShutDownServerClick(Sender: TObject);
var
nRet: Integer;
begin
if (hServer <> 0) then
begin
nRet:= LEADNet1.InetServerClose (hServer);
if (nRet <> 0) then
ShowMessage ('Error Shutting Down server: ' + IntToStr(nRet))
else
hServer:= 0;
end;
end;
16. |
Code the LEADEventSink1 OnInvoke event as follows: |
procedure TForm1.LEADEventSink1Invoke(Sender: TObject; DispID: Integer;
const IID: TGUID; LocaleID: Integer; Flags: Word; Params: tagDISPPARAMS;
varResult, ExcepInfo, ArgErr: Pointer);
var
hComputer: Smallint;
hName: WideString;
nRet: Integer;
iComputer: Smallint;
sRemote: WideString;
nStatus: Integer;
vColorBuffer: LEADRasterVariant;
vString: LEADRasterVariant;
InetCommand: Integer;
nCommandID: longint;
nError: Integer;
nParams : LEADRasterInetPacket;
sRet: Smallint;
begin
vColorBuffer:= coLEADRasterVariant.Create ( );
vString:= coLEADRasterVariant.Create ( );
case (DispID) of
LEADRASTERINETEVENTS_INETACCEPT:
begin
nRet:= LEADNet1.InetAcceptConnect(hServer);
hComputer:= LEADNet1.InetConnectedComputer;
if (nRet <> 0) then
begin
ShowMessage ('Error accepting connection: ' + IntToStr(nRet));
Exit;
end;
LEADNet1.InetGetHostName (hComputer, HOST_NAME_DESCRP);
hName:= LEADNet1.InetHostName;
//Add to our list
LEADNet1.SendList [LEADNet1.SendListNum]:= hComputer;
ShowMessage ('Connection accepted from: ' + hName);
end;
LEADRASTERINETEVENTS_INETCONNECTED:
begin
iComputer:= OleVariant(Params.rgvarg^[0]);
//Get remote host name
LEADNet1.InetGetHostName (iComputer, HOST_NAME_DESCRP);
sRemote:= LEADNet1.InetHostName;
//Add this connection to our SendList
LEADNet1.SendList [LEADNet1.SendListNum]:= iComputer;
ShowMessage ('Successfully connected to remote computer: ' + sRemote);
end;
LEADRASTERINETEVENTS_INETDISCONNECTED:
begin
if (hServer = 0) then
ShowMessage ('Disconnect from remote server')
else
ShowMessage ('Connection to remote computer closed');
end;
LEADRASTERINETEVENTS_INETRECEIVECMD:
begin
InetCommand:= OleVariant(Params.rgvarg^[5]);
nCommandID:= OleVariant(Params.rgvarg^[4]);
nError:= OleVariant(Params.rgvarg^[3]);
nParams := LEADRasterInetPacket(Params.rgvarg[2].dispVal);
nStatus:= ERROR_FEATURE_NOT_SUPPORTED;
if (nError <> 0) then
nStatus:= ERROR_TRANSFER_ABORTED
else
begin
Case (InetCommand) of
INETCMD_LOAD:
begin
//check the validity of the parameters
if ((nParams.ParamCount = 4) And
(nParams.ParamType[0] = PARAM_TYPE_STRING) And
(nParams.ParamType[1] = PARAM_TYPE_INT32) And
(nParams.ParamType[2] = PARAM_TYPE_INT32) And
(nParams.ParamType[3] = PARAM_TYPE_UINT32)) then
begin
nStatus:= RasterIO.Load( LEADRasterView1.Raster,
nParams.ParamValue[0].StringValue,
nParams.ParamValue[1].LongValue,
1,
1 );
if (nStatus <> 0) then
ShowMessage ('Load Bitmap failed with error code: ' + IntToStr(nStatus))
else
begin
nStatus:= LEADNet1.InetSendBitmap (LEADRasterView1.Raster, FILE_CMP, 0, TOleEnum(QFACTOR_PQ2));
if (nStatus <> 0) then
ShowMessage ('SendBitmap failed with error code: ' + IntToStr(nStatus));
end;
end
else
nStatus:= ERROR_INV_PARAMETER; //Invalid parameters
LEADNet1.InetSendLoadRsp (nCommandID, 0, 0, Nil, nStatus);
Exit;
end;
INETCMD_GET_MAGGLASS_DATA:
begin
//check the validity of the parameters
if ((nParams.ParamCount = 5) And (nParams.ParamType[0] = PARAM_TYPE_UINT32)
And (nParams.ParamType[1] = PARAM_TYPE_UINT32) And (nParams.ParamType[2] = PARAM_TYPE_USTRING)
And (nParams.ParamType[3] = PARAM_TYPE_INT32) And (nParams.ParamType[4] = PARAM_TYPE_INT32)) Then
begin
if LEADRasterView1.Raster.Bitmap <> 0 Then
begin
vString.Type_:= VALUE_STRING;
vString.StringValue:= nParams.ParamValue[2].StringValue;
nStatus:= LEADNet1.InetGetMagGlassData ( LEADRasterView1.Raster,
vColorBuffer,
vString,
nParams.ParamValue[3].LongValue,
nParams.ParamValue[4].LongValue );
if (nStatus <> 0) then
ShowMessage ('InetGetMagGlassData failed with error code: ' + IntToStr(nStatus))
end
else
nStatus:= ERROR_INV_PARAMETER //Invalid parameter
end
else
nStatus:= ERROR_INV_PARAMETER; //Invalid parameters
vString.Type_:= VALUE_STRING;
vString.StringValue:= nParams.ParamValue[2].StringValue;
LEADNet1.InetSendGetMagGlassDataRsp ( nCommandID,
vColorBuffer,
vString,
nParams.ParamValue[3].LongValue,
nParams.ParamValue[4].LongValue,
0,
Nil,
nStatus );
Exit;
end;
end;
end;
LEADNet1.InetSendRsp(InetCommand, nCommandID, Nil, 0, Nil, nStatus);
end;
LEADRASTERINETEVENTS_INETRECEIVEBITMAP:
begin
LEADRasterView1.Raster.Bitmap:= OleVariant(Params.rgvarg^[0]);
end;
LEADRASTERINETEVENTS_INETRECEIVERSP:
begin
InetCommand:= OleVariant(Params.rgvarg^[6]);
nError:= OleVariant(Params.rgvarg^[4]);
nStatus:= OleVariant(Params.rgvarg^[3]);
nParams := LEADRasterInetPacket(Params.rgvarg[2].dispVal);
if (nError <> 0) then
Exit;
Case (InetCommand) of
INETCMD_LOAD:
begin
if (nStatus <> 0) then
ShowMessage ('Load failed with error code: ' + IntToStr(nStatus));
end;
INETCMD_GET_MAGGLASS_DATA:
begin
if (nStatus = 0) then
begin
if ((nParams.ParamCount = 6) And (nParams.ParamType[0] = PARAM_TYPE_UINT32)
And (nParams.ParamType[1] = PARAM_TYPE_USTRING) And (nParams.ParamType[2] = PARAM_TYPE_UINT32)
And (nParams.ParamType[3] = PARAM_TYPE_USTRING) And (nParams.ParamType[4] = PARAM_TYPE_INT32))
And (nParams.ParamType[5] = PARAM_TYPE_INT32) then
begin
nRet:= LEADRasterView1.UpdateMagGlass ( nParams.ParamValue[1],
nParams.ParamValue[3],
nParams.ParamValue[4].LongValue,
nParams.ParamValue[5].LongValue,
True,
sRet );
if (nRet <> 0) then
ShowMessage ('UpdateMagGlass failed with error code: ' + IntToStr(nRet))
end
else
ShowMessage ('Invalid parameter passed to INETCMD_GET_MAGGLASS_DATA response');
end
else
ShowMessage ('Get MagGlass Data from server with error code ' + IntToStr(nStatus));
end;
end;
end;
end;
end;
17. |
Code the ConnectToRemoteServer button's click procedure as follows: |
procedure TForm1.ConnectToRemoteServerClick(Sender: TObject);
var
nRet: Integer;
begin
//Connect to remote computer on port 1000
nRet:= LEADNet1.InetConnect (RemoteComputer.Text, 1000);
if (nRet <> 0) then
ShowMessage ('Error connecting to ' + RemoteComputer.Text + ': ' + IntToStr(nRet));
end;
18. |
Code the DisconnectFromRemoteServer button's click procedure as follows: |
procedure TForm1.DisconnectFromRemoteServerClick(Sender: TObject);
var
nRet: Integer;
begin
{ We are assuming only one connection in this example.
Therefore, the handle to the remote computer will be
in the first position in the SendList}
nRet:= LEADNet1.InetDisconnect (LEADNet1.SendList [0]);
if (nRet <> 0) then
ShowMessage ('Error disconnecting from remote: ' + IntToStr(nRet));
end;
19. |
Code the LoadRemoteImage button's click procedure as follows: |
procedure TForm1.LoadRemoteImageClick(Sender: TObject);
var
nRet: Integer;
begin
nRet:= LEADNet1.InetSendLoadCmd (999, 'v:\images\Eagle.cmp', 0, 1);
if ((nRet <> 0) And (nRet <> ERROR_DATA_QUEUED)) then
ShowMessage ('ERROR ' + IntToStr(nRet) + ' calling InetSendLoadCmd.');
end;
20. |
Code the StartMagnifyingGlass button's click procedure as follows: |
procedure TForm1.StartMagnifyingGlassClick(Sender: TObject);
var
sRet: Smallint;
nRet: Integer;
begin
if ((LEADRasterView1.Raster.Bitmap <> 0) And (hServer = 0)) then
begin
//Enable MagGlassExt event.
if LEADRasterView1.EnableMagGlassEvent = False Then
LEADRasterView1.EnableMagGlassEvent:= True;
LEADRasterView1.RgnFrameType:= 0;
//Start the Magnifying Glass
nRet:= LEADRasterView1.StartMagGlass (100, 100, 400, RGB(255, 0, 0), RGB(128, 128, 128), True, 1, False, CROSSHAIR_FINE, True, True, sRet);
if (nRet = 0) then
bMagGlass:= True;
end;
end;
21. |
Code the StopMagnifyingGlass button's click procedure as follows: |
procedure TForm1.StopMagnifyingGlassClick(Sender: TObject);
var
sRet: Smallint;
nRet: Integer;
begin
if ((LEADRasterView1.Raster.Bitmap <> 0) And (hServer = 0)) then
begin
nRet:= LEADRasterView1.StopMagGlass (sRet);
if (nRet = 0) then
bMagGlass:= False
end;
end;
22. |
Code the LEADRasterView1’s MagGlassExt event as follows: |
procedure TForm1.LEADRasterView1MagGlassExt (Sender: TObject;
nMaskPlaneStart, nMaskPlaneEnd: Integer; const pvMaskPlane: ILEADRasterVariant);
var
nRet: Integer;
begin
gnCommandID:= gnCommandID + 1;
nRet:= LEADNet1.InetSendGetMagGlassDataCmd (gnCommandID, 0, pvMaskPlane, nMaskPlaneStart, nMaskPlaneEnd);
if ((nRet <> 0) And (nRet <> ERROR_DATA_QUEUED)) then
ShowMessage ('ERROR ' + IntToStr(nRet) + ' calling InetSendGetMagGlassDataCmd.');
end;
23. |
At the beginning of the Unit1 file, add LEADRasterInetLib_TLB, LTRASTERIOLib_TLB, LTRASTERLib_TLB, LTDLLDef, ComObj, ActiveX, to the Uses section. |
24. |
Run the exe file two times to execute two applications. |
25. |
In the first application press Start Up Server button. |
26. |
In the second application fill the edit box with the IP Address of the Remote computer on which you run the first application as Server then press Connect To Remote Server button to connect to the specified address. |
27. |
After that press the Load Remote Image button of application number two to load an image on Server then press the Start Magnifying Glass button to start the Magnifying Glass with Internet support, then start press the left key and move over the image to see the zoomed area using the Magnifying Glass with Internet support. |