I would like to know if there is a way to change the orientation of a TShape thus instead of a square , i would like to rotate it to look like a diamond..
If not a way with TShape, how could this be done?
A Delphi TShape is nothing more than drawing a bunch of vector graphics.
You can "rotate" the X/Y coordinates themselves with a 2-D transformation matrix. Computer Graphics 101:
http://www.cs.uic.edu/~jbell/CourseNotes/ComputerGraphics/2DTransforms.html
http://www.willamette.edu/~gorr/classes/GeneralGraphics/Transforms/transforms2d.htm
A TShape itself cannot be rotated. But you can use a TPaintBox to draw your own graphics anyway you wish, it is just a matter of mathematically plotting the points to draw between. For example:
procedure TForm1.PaintBox1Paint(Sender: TObject);
var
Points: array[0..3] of TPoint;
W, H: Integer;
begin
W := PaintBox1.Width;
H := PaintBox1.Height;
Points[0].X := W div 2;
Points[0].Y := 0;
Points[1].X := W;
Points[1].Y := H div 2;
Points[2].X := Points[0].X;
Points[2].Y := H;
Points[3].X := 0;
Points[3].Y := Points[1].Y;
PaintBox1.Canvas.Brush.Color := clBtnFace;
PaintBox1.Canvas.FillRect(Rect(0, 0, W, H));
PaintBox1.Canvas.Brush.Color := clBlue;
PaintBox1.Canvas.Pen.Color := clBlack;
PaintBox1.Canvas.Pen.Width := 1;
PaintBox1.Canvas.Polygon(Points);
end;
Related
I cannot seem to figure out how to print multiple images in one page using Printer,
I want to display images side by side like this:
But the problem is the images always display in full page like this:
I have this code:
procedure TForm1.Button1Click(Sender: TObject);
var
MyRect: TRect;
scale: Double;
Bitmap : TBitmap;
i: integer;
begin
try
Bitmap := TBitmap.Create;
Bitmap.Width := Image1.Picture.Width;
Bitmap.Height := Image1.Picture.Height;
Bitmap.Canvas.Draw(0,0,Image1.Picture.Graphic);
if PrintDialog1.Execute then
begin
if Printer.Orientation = poPortrait then
scale := GetDeviceCaps(Printer.Handle, LOGPIXELSX) / Screen.PixelsPerInch
else
scale := GetDeviceCaps(Printer.Handle, LOGPIXELSY) / Screen.pixelsperinch;
Printer.BeginDoc;
MyRect := Rect(0,0, trunc(Bitmap.Width * scale), trunc(Bitmap.Height * scale));
Printer.Canvas.StretchDraw(MyRect, Bitmap);
Printer.EndDoc;
end;
finally
Bitmap.Free;
end;
end;
I want to the printer to printout images side by side, how can I accomplish that?
Can any one help me please?
Update:
procedure TForm1.Button1Click(Sender: TObject);
var
MyRect: TRect;
scale: Double;
Bitmap : TBitmap;
i, x, y, width, height, img_count: integer;
begin
Bitmap := TBitmap.Create;
x := 0;
y := 0;
img_count := 3;
try
begin
Bitmap.Width := Image1.Picture.Width;
Bitmap.Height := Image1.Picture.Height;
Bitmap.Canvas.Draw(0,0,Image1.Picture.Graphic);
if PrintDialog1.Execute then
begin
if Printer.Orientation = poPortrait then
scale := GetDeviceCaps(Printer.Handle, LOGPIXELSX) / Screen.PixelsPerInch
else
scale := GetDeviceCaps(Printer.Handle, LOGPIXELSY) / Screen.pixelsperinch;
Printer.BeginDoc;
for i := 1 to img_count do
begin
width := trunc(Bitmap.Width * scale / img_count);
height := trunc(Bitmap.Height * scale / img_count);
MyRect := Rect(x, y, width, height);
Printer.Canvas.StretchDraw(MyRect, Bitmap);
x := x + width;
end;
Printer.EndDoc;
end;
end;
finally
Bitmap.Free;
end;
end;
Now it displays the images like sticking at each other, an I want them to display with a little margin between them:
This is when I add margins:
This is without margins:
You have to halfway understand your code, then it will all become obvious. Canvas and Rect are literally just that - and if you max your rectangle out by scale you'll never put two pictures side by side. Cut the values in half and use understand the parameters of functions - I'll use more variables to make it more obvious why your approach is very easy to solve:
var
x, y, width, height: Integer;
...
begin
...
Printer.BeginDoc;
x:= 0; // Start on top left
y:= 0;
width:= trunc( Bitmap1.Width* scale/ 2 ); // Half of the size
height:= trunc( Bitmap1.Height* scale/ 2 )
Printer.Canvas.StretchDraw( Rect( x, y, width, height ), Bitmap1 );
x:= width; // Continue after picture on the right side
width:= trunc( Bitmap2.Width* scale/ 2 ); // Again half of the size
height:= trunc( Bitmap2.Height* scale/ 2 )
Printer.Canvas.StretchDraw( Rect( x, y, width, height ), Bitmap2 );
Printer.EndDoc;
This example presumes Bitmap1 and Bitmap2 have similar dimensions.
I am using a paintbox component to draw various shapes using rect, polygon and other canvas methods. After the user has created the drawing, I want to save a bitmap for use in a listbox. The problem is that the drawing may only use a small portion of the canvas and the resulting image in the listbox would be very small unless I adjust its size by selecting only the used portion of the paintbox's original canvas. So the question is how do I determine what portion of the canvas has been used so I can extract only that part of the canvas to load into a bitmap for display in listbox?
(Note:I edited above to clarify the question a bit)
The actual program has a paintbox (200x200) and an image (32 x 32). The image gets its bitmap from the paintbox using Bitmap1.Canvas.CopyRect(Dest, PaintBox1.Canvas, Source);. If the drawing in the paintbox is only 20x20 in the 200x200 paintbox.canvas, then the resulting bitmap in the Image.canvas will be very small in the 32x32 image.canvas. I need it to be enlarged and that means that I must determine the actual size of the used area in the paintbox and change the source size in 'CopyRec'.
One approach I have worked out is based on the assumption that the various items that have been drawn such as circles, rectangles, text, etc are all placed on a neutral background. In that case I can read the bitmap using tbitmap.scanline to compare the color of the drawing vs the background color and calculate the extents of the drawing in each row to determine the extents of the drawing in the overall bitmap.
TRGBTriple = packed record
rgbtBlue: Byte;
rgbtGreen: Byte;
rgbtRed: Byte;
end;
TRGBTripleArray = ARRAY[Word] of TRGBTriple;
pRGBTripleArray = ^TRGBTripleArray; // use a PByteArray for pf8bit color
function findBMPExtents (Bmp : tbitmap; BkgdClr : longint):trect;
// finds the extents of an image in a background or BkgdClr color
//works on 24 bit colors
var
P : pRGBTripleArray;
x,y : integer;
tfound, bfound, done : boolean;
WorkTrpl : TRGBTriple;
WorkRect : trect;
begin
result.top := 0;
result.bottom := Bmp.height;
result.left := Bmp.Width;
result.right := 0;
tfound := false;
bfound := false;
WorkTrpl := getRGB (BkgdClr);
//find left and top
y := 0;
done := false;
Repeat
P := Bmp.ScanLine[y];
x := 0;
Repeat
if (p[x].rgbtBlue <> WorkTrpl.rgbtBlue) or
(p[x].rgbtGreen <> WorkTrpl.rgbtGreen) or
(p[x].rgbtRed <> WorkTrpl.rgbtRed) then
begin
tfound := true;
if x <= result.left then begin
result.left := x;
done := true;
end;
end;
inc (x);
until (x = bmp.width) or done;
done := false;
inc (y);
if not tfound then
inc(result.top);
until (y = bmp.height);
//find right and bottom
y := bmp.height - 1;
done := false;
Repeat
P := Bmp.ScanLine[y];
x := bmp.width-1;
Repeat
if (p[x].rgbtBlue <> WorkTrpl.rgbtBlue) or
(p[x].rgbtGreen <> WorkTrpl.rgbtGreen) or
(p[x].rgbtRed <> WorkTrpl.rgbtRed) then
begin
bfound := true;
if x >= result.right then begin
result.right := x;
done := true;
end;
end;
dec (x);
Until (x = 0) or done;
if not bfound then
dec(result.bottom);
done := false;
dec (y);
Until (y = -1);
dec(result.bottom);
end;
Hi I use the follow code to draw a rotate text in my Delphi application. The user can choose if use or not use GDI+ to draw the text:
procedure TForm1.Button1Click(Sender: TObject);
var
MyLogFont: TLogFont;
MyFont: HFont;
t: string;
ff: IGPFontfamily;
ft: IGPFont;
br: IGPSolidBrush;
gr: IGPGraphics;
pp: TGPPointF;
Pen: IGPPen;
begin
t := 'Hello';
if not DrawUsingGDIP.Checked then
begin
// Draw using GDI
FillChar(MyLogFont, Sizeof(MyLogFont), 0);
with MyLogFont do
begin
lfHeight:=0;
lfWidth:=0;
lfEscapement:=-StrToInt(Edit1.Text)*10;
lfOrientation:=-StrToInt(Edit1.Text)*10;
lfWeight:=FW_NORMAL;
lfItalic:=0;
lfUnderline:=0;
lfStrikeOut:=0;
lfCharSet:=DEFAULT_CHARSET;
lfOutPrecision:=OUT_DEFAULT_PRECIS;
lfClipPrecision:=CLIP_DEFAULT_PRECIS;
lfQuality:=DEFAULT_QUALITY;
lfPitchAndFamily:=1;
end;
MyFont:=CreateFontIndirect(MyLogFont);
Form1.Canvas.Font.Handle:=MyFont;
Form1.Canvas.Font.Name := 'Arial';
Form1.Canvas.Font.Size := 13;
Form1.Canvas.TextOut(103, 100, t);
end
else
begin
// Draw using GDI+
Pen := TGPPen.Create($FF000000);
ff := TGPFontFamily.Create('Arial');
ft := TGPFont.Create(ff, 16, FontStyleRegular, UnitPixel);
br := TGPSolidBrush.Create(TGPColor.Red);
gr := TGPGraphics.Create(Form1.Canvas.Handle);
gr.SetTextRenderingHint(TextRenderingHintAntiAlias);
gr.TranslateTransform(100.0, 100.0);
gr.RotateTransform(StrToInt(Edit1.Text));
pp := TGPPointF.Create(0, 0);
gr.DrawString(t, ft, pp, br);
gr.ResetTransform;
end;
end;
Now I need know (if possible without draw the text) the coordinates of the vertices of the rectangle that bounds the text (see the image):
Is there a simple way to get these coordinates both with and without use GDI+ library?
For the GDI implementation you can use something like
tsiz := Form1.Canvas.TextExtent(t); // tsiz : tagSIZE
ang := (2.0*Pi*StrToInt(Edit1.Text))/360; // ang : double
tpts[0].X := 100; // tpts : Array[0..4] of TPoint
tpts[0].Y := 100;
tpts[1].X := 100 + Round(tsiz.cx * Cos(ang));
tpts[1].Y := 100 + Round(tsiz.cx * Sin(ang));
tpts[2].X := tpts[1].X - Round(tsiz.cy*Sin(ang));
tpts[2].Y := tpts[1].Y + Round(tsiz.cy*Cos(ang));
tpts[3].X := tpts[0].X - Round(tsiz.cy*Sin(ang));
tpts[3].Y := tpts[0].Y + Round(tsiz.cy*Cos(ang));
tpts[4] := tpts[0];
//tpts now contains corner points of the bounding rect
Form1.Canvas.TextOut(100, 100, t); // draw text
Form1.Canvas.Polyline(tpts); // draw bounding rect
for GDI+ it's a lot easier
sft := TGPStringFormat.GenericDefault; // sft : IGPStringFormat
mRect := gr.MeasureString(t, ft, pp, sft); // mRect : TGPRectF
// do this after transforms
// mRect is now the bounding rect
gr.DrawRectangle(Pen,mRect);
// mRect is transformed by DrawRectangle - coordinates can be
// calculated in the same way as the GDI case where
// mRect.Width -> tsiz.cx and mRect.Height -> tsiz.cy
I use Toolbar2000 component. It shows button's hint below correct position with system scale > 100%. So, I need to set HintPos manually. I have Mouse.CursorPos. But hint should be displayed below mouse cursor image.
How to get mouse cursor dimensions?
You should ask Windows for System Metrics - see http://msdn.microsoft.com/en-us/library/windows/desktop/ms724385.aspx
However if user installed something like Stardock CursorFX those values would not match what the user really sees and what behavior he expects from programs.
That seems to be one of Win32 API limitations, that the value cannot be changed apart of few relatively small standard values from old approved set.
You can create an Icon, use GetCursor to set the handle, additional information can be retrieved with GetIconInfo. This will even work if userdefined cursors are shown, which might have nearly any size.
var
ico: TIcon;
IcoInfo: TIconInfo;
begin
ico := TIcon.Create;
try
ico.Handle := GetCursor;
try
GetIconInfo(ico.Handle, IcoInfo);
Caption := Format('Width %d, Height %d HotSpotX %d, HotSpotY %d',
[ico.Width, ico.Height, IcoInfo.xHotspot, IcoInfo.yHotspot]);
finally
ico.ReleaseHandle;
end;
finally
ico.Free;
end;
end;
// Just as example for an very unusual cursor
procedure TForm1.Button1Click(Sender: TObject);
var
IconInfo: TIconInfo;
AndMask, Bmp: TBitmap;
w, h: Integer;
begin
w := Screen.Width * 2;
h := Screen.Height * 2;
// Creation And Mask
AndMask := TBitmap.Create;
AndMask.Monochrome := True;
AndMask.Height := h;
AndMask.Width := w;
// Draw on And Mask
AndMask.Canvas.Brush.Color := clWhite;
AndMask.Canvas.FillRect(AndMask.Canvas.ClipRect);
AndMask.Canvas.Pen.Color := clwhite;
AndMask.Canvas.Pen.Width := 5;
AndMask.Canvas.MoveTo(w div 2, 0);
AndMask.Canvas.LineTo(w div 2, h);
AndMask.Canvas.MoveTo(0, h div 2);
AndMask.Canvas.LineTo(w, h div 2);
{Create the "XOr" mask}
Bmp := TBitmap.Create;
Bmp.Width := w;
Bmp.Height := h;
{Draw on the "XOr" mask}
Bmp.Canvas.Brush.Color := clblack;
Bmp.Canvas.FillRect(Rect(0, 0, w, h));
Bmp.Canvas.Pen.Color := clwhite;
Bmp.Canvas.Pen.Width := 5;
Bmp.Canvas.MoveTo(w div 2, 0);
Bmp.Canvas.LineTo(w div 2, h);
Bmp.Canvas.MoveTo(0, h div 2);
Bmp.Canvas.LineTo(w, h div 2);
IconInfo.fIcon := true;
IconInfo.xHotspot := w div 2;
IconInfo.yHotspot := h div 2;
IconInfo.hbmMask := AndMask.Handle;
IconInfo.hbmColor := Bmp.Handle;
Screen.Cursors[1]:= CreateIconIndirect(IconInfo);
Screen.Cursor:=1;
end;
This is Windows 7 issue and there is no proper solution. GetSystemMetrics(SM_CYCURSOR) returns size of cursor image with background. And it seems this value is much more incorrect with system scale >100%. Delphi XE2 shows a hint on incorrect position too. But it's interesting to note that Explorer shows a hint on the correct position.
What is the fastest way of getting the area of any arbitrary Windows region?
I know I can enumerate all points of bounding rectangle and call the PtInRegion() function but it seems not very fast. Maybe you know some faster way?
When you call GetRegionData, you'll get a list of non-overlapping rectangles that make up the region. Add up their areas, something like this:
function GetRegionArea(rgn: HRgn): Cardinal;
var
x: DWord;
Data: PRgnData;
Header: PRgnDataHeader;
Rects: PRect;
Width, Height: Integer;
i: Integer;
begin
x := GetRegionData(rgn, 0, nil);
Win32Check(x <> 0);
GetMem(Data, x);
try
x := GetRegionData(rgn, x, Data);
Win32Check(x <> 0);
Header := PRgnDataHeader(Data);
Assert(Header.iType = rdh_Rectangles);
Assert(Header.dwSize = SizeOf(Header^));
Rects := PRect(Cardinal(Header) + Header.dwSize);
// equivalent: Rects := PRect(#Data.Buffer);
Result := 0;
for i := 0 to Pred(Header.nCount) do begin
Width := Rects.Right - Rects.Left;
Height := Rects.Bottom - Rects.Top;
Inc(Result, Width * Height);
Inc(Rects);
end;
finally
FreeMem(Data);
end;
end;