Levente
asked on
Restrict drawing on a canvas into a rectangle?
I need to specify a rectangle on a canvas where drawing is enabled, and outside it is forbidden. For example, in Rect(25, 25, 200, 200) drawing is enabled, and anything drawn outside it is not displayed.
Please note, that the canvas in question is the canvas of a printer.
How can I do that?
Thank you for your help.
Levente
Please note, that the canvas in question is the canvas of a printer.
How can I do that?
Thank you for your help.
Levente
opps silly me ,im sorry i pasted in wrong question :-)
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
For TPrinter :
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses printers;
{$R *.DFM}
procedure TForm1.Button1Click(Sender : TObject);
Var Region, OldRegion : HRgn;
DC : HDC;
begin
Printer.BeginDoc;
DC:=Printer.Canvas.Handle;
Region:=CreateRectRgn(10,1 0,50,50);
GetClipRgn(DC,OldRegion);
SelectClipRgn(DC,Region);
DeleteObject(Region);
with Printer do
begin
Canvas.Pen.Color := Random(65535);
Canvas.Pen.Style := psSolid;
Canvas.Rectangle(5, 5, 20,20);
end;
Printer.EndDoc;
SelectClipRgn(DC,OldRegion );
end;
end.
What you see printed is just the right-bottom corner of the rectangle. The rest is clipped.
Regards, Zif.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses printers;
{$R *.DFM}
procedure TForm1.Button1Click(Sender
Var Region, OldRegion : HRgn;
DC : HDC;
begin
Printer.BeginDoc;
DC:=Printer.Canvas.Handle;
Region:=CreateRectRgn(10,1
GetClipRgn(DC,OldRegion);
SelectClipRgn(DC,Region);
DeleteObject(Region);
with Printer do
begin
Canvas.Pen.Color := Random(65535);
Canvas.Pen.Style := psSolid;
Canvas.Rectangle(5, 5, 20,20);
end;
Printer.EndDoc;
SelectClipRgn(DC,OldRegion
end;
end.
What you see printed is just the right-bottom corner of the rectangle. The rest is clipped.
Regards, Zif.
here an example of reading .lnk files:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,shlobj,activex,co
type
TForm1 = class(TForm)
Button1: TButton;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
NeedToUninitialize : boolean = false;
implementation
{$R *.DFM}
function LoadShellLink(shellLinkFil
var description, linkedObj, params: string;
var pidl: PItemIDList; var findData: TWin32FindData;
var iconPath: string; var iconIndex: integer;
var workingDir, hotKey: string;
var showCmd: integer) : boolean;
var sl : IShellLink;
w1 : word;
s1 : string;
wfd : TWin32FindData;
i1 : integer;
begin
NeedToUninitialize:=NeedTo
sl:=CreateComObject(CLSID_
result:=(sl as IPersistFile).Load(PWideCh
if not result then exit;
SetLength(description,MAX_
if sl.GetDescription(PChar(de
else description:='';
SetLength(s1,MAX_PATH+1);
if sl.GetPath(PChar(s1),MAX_P
linkedObj:=string(PChar(s1
findData :=wfd;
end else begin
linkedObj:='';
ZeroMemory(@findData,sizeO
end;
SetLength(params,MAX_PATH+
if sl.GetArguments(PChar(para
else params:='';
if sl.GetIDList(pidl)<>NOERRO
SetLength(s1,MAX_PATH+1);
if sl.GetIconLocation(pchar(s
iconPath :=string(pchar(s1));
iconIndex:=i1;
end else begin
iconPath :='';
iconIndex:=-1;
end;
SetLength(workingDir,MAX_P
if sl.GetWorkingDirectory(PCh
else workingDir:='';
sl.GetHotKey(w1);
if w1 and (HOTKEYF_ALT shl 8)<>0 then w1:=(w1 and (not (HOTKEYF_ALT shl 8))) or scAlt;
if w1 and (HOTKEYF_CONTROL shl 8)<>0 then w1:=(w1 and (not (HOTKEYF_CONTROL shl 8))) or scCtrl;
if w1 and (HOTKEYF_SHIFT shl 8)<>0 then w1:=(w1 and (not (HOTKEYF_SHIFT shl 8))) or scShift;
hotKey:=ShortCutToText(w1)
if sl.GetShowCmd(showCmd)<>NO
end;
procedure FreePidl(var pidl: PItemIDList);
var malloc : IMalloc;
begin
if (pidl<>nil) and (SHGetMalloc(malloc)=NOERR
malloc.Free(pidl);
pidl:=nil;
end;
end;
procedure TForm1.Button1Click(Sender
var
pi:PItemIDList;
s1,Desc,s2:String;
icon,workdir,htkey:string;
Data: TWin32FindData;
i,ii : integer;
begin
opendialog1.execute;
loadshelllink(opendialog1.
ShowMessage('File ShortCut : '+opendialog1.filename+#13
+'HotKey : '+htkey+#13#10+'Show Command : '+inttostr(ii));
FreePidl(pi);
end;
initialization
finalization
if NeedToUninitialize then CoUninitialize;
end.
Regards Barry