I'm creating an application with Delphi Seattle with FMX, and I'm working with creating meshes directly myself. What I don't understand is why this mesh doesn't appear:
Mesh.Data.VertexBuffer.Length := 4;
Mesh.Data.IndexBuffer.Length := 6;
with Mesh.Data.VertexBuffer do
begin
Vertices[0] := TPoint3D.Create( 1, 1, 0);
Vertices[1] := TPoint3D.Create( 1, -1, 0);
Vertices[2] := TPoint3D.Create(-1, -1, 0);
Vertices[3] := TPoint3D.Create(-1, 1, 0);
TexCoord0[0] := TPointF.Create(0, 1);
TexCoord0[1] := TPointF.Create(0, 1);
TexCoord0[2] := TPointF.Create(0, 1);
TexCoord0[3] := TPointF.Create(0, 1);
end;
with Mesh.Data.IndexBuffer do
begin
Indices[0] := 0;
Indices[1] := 1;
Indices[2] := 2;
Indices[3] := 2;
Indices[4] := 3;
Indices[5] := 0;
end;
The mesh has a colour material however when I run it, the mesh does not appear. Everything else does (a cube and a grid).
The answer is to set the mesh to TwoSide true, then I can see it. I did try rotating the object, but still couldn't see anything.
Related
I draw several textures on my canvas and on one of them i would like to apply a TGaussianBlurEffect. Problem is that TGaussianBlurEffect will apply to all the container in with it is placed (so all the canvas) where me i want to apply it only to one texture.
i found this function in delphi
procedure TFilterEffect.ProcessTexture(const Visual: TTexture; const Context: TContext3D);
var
Ver: TVertexBuffer;
Ind: TIndexBuffer;
Mat: TTextureMaterial;
begin
if Assigned(FFilter) then
begin
FFilter.ValuesAsTexture['Input'] := Visual;
FFilter.ApplyWithoutCopytoOutput;
if Assigned(Context) then
if Context.BeginScene then
try
Ver := TVertexBuffer.Create([TVertexFormat.Vertex, TVertexFormat.TexCoord0], 4);
Ver.Vertices[0] := Point3D(Context.PixelToPixelPolygonOffset.X,
Context.PixelToPixelPolygonOffset.Y, 0);
Ver.TexCoord0[0] := PointF(0.0, 0.0);
Ver.Vertices[1] := Point3D(Context.PixelToPixelPolygonOffset.X + Visual.Width,
Context.PixelToPixelPolygonOffset.Y, 0);
Ver.TexCoord0[1] := PointF(Visual.Width / TFilterManager.FilterTexture.Width, 0.0);
Ver.Vertices[2] := Point3D(Context.PixelToPixelPolygonOffset.X + Visual.Width,
Context.PixelToPixelPolygonOffset.Y + Visual.Height, 0);
Ver.TexCoord0[2] := PointF(Visual.Width / TFilterManager.FilterTexture.Width,
Visual.Height / TFilterManager.FilterTexture.Height);
Ver.Vertices[3] := Point3D(Context.PixelToPixelPolygonOffset.X,
Context.PixelToPixelPolygonOffset.Y + Visual.Height, 0);
Ver.TexCoord0[3] := PointF(0.0, Visual.Height / TFilterManager.FilterTexture.Height);
Ind := TIndexBuffer.Create(6);
Ind[0] := 0;
Ind[1] := 1;
Ind[2] := 3;
Ind[3] := 3;
Ind[4] := 1;
Ind[5] := 2;
Mat := TTextureMaterial.Create;
Mat.Texture := TFilterManager.FilterTexture;
Context.Clear(0);
Context.SetContextState(TContextState.cs2DScene);
Context.SetContextState(TContextState.csZWriteOff);
Context.SetContextState(TContextState.csZTestOff);
Context.SetMatrix(TMatrix3D.Identity);
Context.DrawTriangles(Ver, Ind, Mat, 1);
Mat.Free;
Ind.Free;
Ver.Free;
finally
Context.EndScene;
end;
end;
end;
but i don't understand it's purpose and how to use it :(
I have put a RichEdit on a form to represent part of a page. The size of the 'page' is reduced so that the user can see the whole page to gauge the effect of input. When the 'page' is printed, the RichEdit area is expanded and moved on the printer page to the required position. The code below does this very well with one slight (read MASSIVE) problem. The font does not scale.
I have tried playing around with setting the Window and Viewport origins and extents as the reading I have done seem to point to this. Unfortunately, I have had no success. Could someone please point me in the right direction?
procedure TForm10.PrintNewClick(Sender: TObject);
const
PgHeight=1170;
PgWidth=1170*210 div 294;
var
EdTop,EdLeft,EdWidth,EdHeight :integer;
wPage, hPage, xPPI, yPPI, wTwips, hTwips: integer;
pageRect, rendRect, outline: TRect;
po: TPageOffset;
fr: TFormatRange;
lastOffset, currPage, pageCount: integer;
xOffset, yOffset: integer;
FPageOffsets: array of TPageOffset;
TextLenEx: TGetTextLengthEx;
firstPage: boolean;
PrinterRatioH,PrinterRatioV, ratio:Real;
begin
Printer.Orientation:=poPortrait;
//get printer to 'page' ratios
PrinterRatioH :=Printer.PageWidth/PgWidth;
PrinterRatioV :=Printer.PageHeight/PgHeight;
//get positions and size of richedit on screen 'page'
//top of richedit on screen page
EdTop:=StrToInt(EditTop.Text);
//left of richedit on screen page
if EditCentre.Checked then
EdLeft:=(PgWidth-StrToInt(EditWidth.Text)) div 2
else
EdLeft:=StrToInt(EditLeft.Text);
//Width of richedit on screen page
EdWidth:=StrToInt(EditWidth.Text);
// Height of richedit on screen page
EdHeight:=StrToInt(EditHeight.Text);
//get bounding richedit rectangle on printer
with outline do
begin
left:=Round(EdLeft*PrinterRatioH );
top:=Round(EdTop*PrinterRatioV );
Right:=Left+Round(EdWidth*PrinterRatioH);
Bottom:=Top+Round(EdHeight*PrinterRatioV);
end;
//Get the size of a printed page in printer device units
wPage := GetDeviceCaps(Printer.Handle, PHYSICALWIDTH);
hPage := GetDeviceCaps(Printer.Handle, PHYSICALHEIGHT);
//Next, get the device units per inch for the printer
xPPI := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
if TwipFactor=567 then
xPPI :=round(xPPI / 2.54 ); //change to metric base
yPPI := GetDeviceCaps(Printer.Handle, LOGPIXELSY);
if TwipFactor=567 then
yPPI :=round(yPPI / 2.54 );
//Convert the page size from device units to twips
wTwips := MulDiv(wPage, TwipFactor, xPPI);
hTwips := MulDiv(hPage, TwipFactor, yPPI);
//Save the page size in twips
with pageRect do
begin
Left := 0;
Top := 0;
Right := wTwips;
Bottom := hTwips
end;
//calculate the size and position of the rendering rectangle in twips
with rendRect do
begin
Left :=MulDiv(Outline.Left, TwipFactor, xPPI);
Top := MulDiv(Outline.Top, TwipFactor, yPPI);
Right := MulDiv(Outline.Right, TwipFactor, xPPI);
Bottom := MulDiv(Outline.Bottom, TwipFactor, yPPI);
end;
//set starting offset to zero
po.mStart := 0;
//Define and initialize a TFormatRange structure.
with fr do
begin
hdc := Printer.Handle;
hdcTarget := Printer.Handle;
chrg.cpMin := po.mStart;
chrg.cpMax := -1;
end;
// how much text is in the control.
with TextLenEx do
begin
flags := GTL_DEFAULT;
codepage := CP_ACP;
end;
lastOffset := SendMessage(TestEdit.Handle, EM_GETTEXTLENGTHEX, wParam(#TextLenEx), 0);
//clear the formatting buffer
SendMessage(TestEdit.Handle, EM_FORMATRANGE, 0, 0);
SaveDC(fr.hdc);
SetMapMode(fr.hdc, MM_ANISOTROPIC{MM_TEXT});
SetViewportOrgEx(fr.hdc, 0, 0, nil);
SetViewportExtEx(fr.hdc, TestEdit.Width ,testedit.Height , nil);
//build a table of page entries,
while ((fr.chrg.cpMin <> -1) and (fr.chrg.cpMin < lastOffset)) do
begin
fr.rc := rendRect;
fr.rcPage := pageRect;
po.mStart := fr.chrg.cpMin;
fr.chrg.cpMin := SendMessage(TestEdit.Handle, EM_FORMATRANGE, 0, Longint(#fr));
po.mEnd := fr.chrg.cpMin - 1;
po.rendRect := fr.rc;
if High(FPageOffsets) = -1 then SetLength(FPageOffsets, 1)
else
SetLength(FPageOffsets, Length(FPageOffsets) + 1);
FPageOffsets[High(FPageOffsets)] := po
end;
pageCount := Length(FPageOffsets);
SendMessage(TestEdit.Handle, EM_FORMATRANGE, 0, 0);
RestoreDC(fr.hdc, - 1);
// print.
Printer.BeginDoc;
fr.hdc := Printer.Handle;
fr.hdcTarget := Printer.Handle;
SaveDC(fr.hdc);
SetViewportOrgEx(fr.hdc, 0, 0, nil);
SetViewportExtEx(fr.hdc, TestEdit.Width ,testedit.Height , nil);
firstPage := True;
//select from page and to page
currPage := 0; //Print from the first page
pageCount := 1; //Only One page for testing REMOVE LATER!!!
while (currPage < pageCount) do
begin
if firstPage then
firstPage := False
else
Printer.NewPage;
SetViewportExtEx(fr.hdc, TestEdit.Width ,testedit.Height
, nil);
fr.rc := FPageOffsets[currPage].rendRect;
fr.rcPage := pageRect;
fr.chrg.cpMin := FPageOffsets[currPage].mStart;
fr.chrg.cpMax := FPageOffsets[currPage].mEnd;
fr.chrg.cpMin := SendMessage(TestEdit.Handle, EM_FORMATRANGE, 1, Longint(#fr));
Inc(currPage);
end;
SetViewportOrgEx(fr.hdc, 0, 0, nil);
//draw bounding rect
Printer.Canvas.MoveTo(outline.Left-2,outline.Top-2);
Printer.Canvas.LineTo(outline.Right+4,outline.Top-2);
Printer.Canvas.LineTo(outline.Right+4,outline.Bottom+4);
Printer.Canvas.LineTo(outline.Left-2,outline.Bottom+4);
Printer.Canvas.LineTo(outline.Left-2,outline.Top-2);
//restore the printer's HDC settings
RestoreDC(fr.hdc, - 1);
Printer.EndDoc;
// clear RichEdit control's formatting buffer
fr.chrg.cpMin := SendMessage(TestEdit.Handle, EM_FORMATRANGE, 0, 0);
//delete saved page table info
Finalize(FPageOffsets);
end;
I have finally found the answer (unfortunately by trial and error rather than logic). The following is the code I used for a similar situation:
procedure DoRTF(RTF: TRichedit);
var
r: TRect;
richedit_outputarea: TRect;
printresX, printresY: Real;
fmtRange: TFormatRange;
Ratio: Real;
ScaleFactor: Real;
begin
ScaleFactor:= 1;
Ratio:=GetDeviceCaps(printer.canvas.handle, LOGPIXELSX)/GetDeviceCaps(MainForm.canvas.handle, LOGPIXELSX);
//"r" is the position of the richedit on the printer page
r := Rect(badgerect.left+round((RTF.Left-WordsBottom.Left)*Ratio),
badgerect.Top+round((RTF.Top-WordsTop.Top)*Ratio),
badgerect.left+round((RTF.Left-WordsBottom.Left)*Ratio +RTF.width*Ratio),
badgerect.Top+round((RTF.Top-WordsTop.Top)*Ratio+RTF.Height*Ratio) );
SetMapMode( printer.canvas.handle, MM_ANISOTROPIC );
SetWindowExtEx(printer.canvas.handle,
GetDeviceCaps(printer.canvas.handle, LOGPIXELSX),
GetDeviceCaps(printer.canvas.handle, LOGPIXELSY),
nil);
SetViewportExtEx(printer.canvas.handle,
Round(GetDeviceCaps(printer.canvas.handle, LOGPIXELSX)*ScaleFactor ),
Round(GetDeviceCaps(printer.canvas.handle, LOGPIXELSY)*ScaleFactor ),
nil);
with Printer.Canvas do
begin
printresX := GetDeviceCaps( handle, LOGPIXELSX) ;
printresY := GetDeviceCaps( handle, LOGPIXELSY) ;
richedit_outputarea := Rect(
round(r.left * 1440 / printresX),
round(r.top * 1440 / printresY),
round(r.right * 1440 / printresX),
round(r.bottom* 1440 / printresY) );
fmtRange.hDC := Handle;
fmtRange.hdcTarget := Handle;
fmtRange.rc := richedit_outputarea;
fmtRange.rcPage:= Rect( 0, 0, round(Printer.PageWidth * 1440 / printresX) , round(Printer.PageHeight * 1440 / printresY) );
fmtRange.chrg.cpMin := 0;
fmtRange.chrg.cpMax := RTF.GetTextLen-1;
// format text
RTF.Perform(EM_FORMATRANGE, 1, Longint(#fmtRange));
// Free cached information
RTF.Perform(EM_FORMATRANGE, 0, 0);
end
end;
I'm trying to create a mask window with "loading" text, to alert the user about a busy state of my application.
For this, I first created a single form with:
BorderStyle = bsNone
Color = clBlack
AlphaBlend = True
AlphaBlendValue = 180;
As the second step, I want to create another Form, but this one will has dynamic content.
I need to create a transparent bitmap with some status text and use the UpdateLayeredWindow to draw the window as the text.
Take a look and my desired result:
Remember: the text will be different in some cases, like:
Recalculating
Loading resources
Loading report
That's the reason what I need a dynamic bitmap generation.
QUESTION
How can I create a transparent bitmap with text and use it on a form with UpdateLayeredWindow?
I'm trying this, but without success ( to try the code put a Button5 and Label2 on a form):
procedure Inc(var p: pointer);
begin
p := Pointer(Integer(p) + 1);
end;
var
s: string;
frm: TForm;
f: HFont;
tx: HDC;
bmp, old: HBITMAP;
rc: TRect;
h: BITMAPINFOHEADER;
pvBits: Pointer;
t: tagBITMAPINFO;
x,y: integer;
a, r, g, b: byte;
sz: TSize;
p: tpoint;
BlendFunction: TBlendFunction;
begin
tx := CreateCompatibleDC(0);
s := label2.Caption;
f := SelectObject(tx, label2.Font.Handle);
fillchar(rc, SizeOf(rc), 0);
DrawText(tx, PChar(s), length(s), rc, DT_CALCRECT);
fillchar(h, SizeOf(h), 0);
pvBits := nil;
h.biSize := SizeOf(h);
h.biWidth := rc.Right - rc.Left;
h.biHeight := rc.Bottom - rc.Top;
h.biPlanes := 1;
h.biBitCount := 32;
h.biCompression := BI_RGB;
FillChar(t, SizeOf(t), 0);
t.bmiHeader := h;
bmp := CreateDIBSection(tx, t, 0, pvBits, 0, 0);
old := SelectObject(tx, bmp);
if old > 0 then
begin
SetTextColor(tx, $00FFFFFF);
SetBkColor(tx, $00000000);
SetBkMode(tx, TRANSPARENT);
DrawText(tx, PChar(s), length(s), rc, DT_NOCLIP);
r := GetRValue($FF);
g := GetGValue($FF);
b := GetBValue($FF);
for x := 0 to h.biWidth-1 do
for y := 0 to h.biHeight-1 do
begin
a := Byte(pvBits^);
Inc(pvBits);
Byte(pvBits^) := (b * a) shr 8;
Inc(pvBits);
Byte(pvBits^) := (g * a) shr 8;
Inc(pvBits);
Byte(pvBits^) := (r * a) shr 8;
Inc(pvBits);
Byte(pvBits^) := a;
end;
SelectObject(tx, old);
end;
SelectObject(tx, f);
deleteDC(tx);
sz.cx := h.biWidth;
sz.cy := h.biHeight;
p := Point(0,0);
BlendFunction.BlendOp := AC_SRC_OVER;
BlendFunction.BlendFlags := 0;
BlendFunction.SourceConstantAlpha := 255;
BlendFunction.AlphaFormat := AC_SRC_ALPHA;
frm := TForm.CreateNew(self);
frm.BorderStyle := bsNone;
frm.Position := poOwnerFormCenter;
frm.Show;
UpdateLayeredWindow(frm.Handle, 0, nil, #sz, bmp, #p, 0, #BlendFunction, ULW_ALPHA);
end;
Assuming you can use Windows API functions from Delphi (since you've tagged winapi), one easy way is:
CreateDIBSection() to create a 32 bit bitmap
FillRect() to fill the background, DrawText() to draw the text
Fix up the alpha
Use that bitmap with UpdateLayeredWindow()
Fixing up the alpha is done by directly modifying the bitmap bits that you get back from CreateDIBSection(). Note that UpdateLayeredWindow() requires pre-multiplied alpha, so you have to multiple the RGB components by the alpha value in advance.
The following code is C but hopefully will give you the idea:
LPVOID pBits; // bits from CreateDIBSection
const int width, height; // size of bitmap
const int alpha; // level of transparency
RGBQUAD* pPtr = (RGBQUAD*)pBits;
for (int y = 0; y < height; ++y)
{
for (int x = 0; x < width; ++x, ++pPtr)
{
pPtr->rgbBlue = (alpha * pPtr->rgbBlue) / 255;
pPtr->rgbGreen = (alpha * pPtr->rgbGreen) / 255;
pPtr->rgbRed = (alpha * pPtr->rgbRed) / 255;
pPtr->rgbReserved = alpha;
}
}
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.
How can i display data in the form of table in the FastReport ?
Edit
I mean ,I want to create a report like this : (with tabular format).
The easiest way to use FR wizard
from FR File menu > new > Standard report wizard
when you reach the "Layout" page, choose tabular from layout then OK
I think you need to build the grid yourself. Here's a bit of code that builds a grid layout to get you started. You will need to adjust the column widths and add the formatting code (memo.frame) to get your desired look.
procedure CreateHeader(frxDataset: TfrxDBDataSet; Page: TfrxReportPage);
var
i: Integer;
X, Y, ThisWidth: Extended;
HeaderMemo: TfrxCustomMemoView;
Column: TcxGridDBColumn;
begin
Band := TfrxPageHeader.Create(Page);
Band.CreateUniqueName;
Band.SetBounds(0, 0, 0, fr01cm * 7);
Band.Height := edtHeightHeader.Value;
HeaderMemo := CreateMemo(Band);
HeaderMemo.SetBounds(0, 0, PageWidth, 0);
// Set memo style
// Or just add a frame HeaderMemo.Frame....
HeaderMemo.Style := 'Header line';
X := 0;
Y := 0;
Memo := CreateMemo(Band);
Memo.SetBounds(0, Y, X, fr01cm * 6);
Memo.Height := Band.Height - 1;
for i := 0 to pred(frxDataset.Fields.Count) do
begin
ThisWidth := 100;
Memo := CreateMemo(Band);
Memo.SetBounds(X, Y, ThisWidth, fr01cm * 6);
Memo.Text := frxDataset.Fields[i].FieldName;
// Set memo style
// Or just add a frame HeaderMemo.Frame....
Memo.Style := 'Header';
Memo.Height := Band.Height - 1;
X := X + ThisWidth;
end;
HeaderMemo.Height := Band.Height;
end;
procedure CreateFastReportDataBand(frxDataset: TfrxDBDataSet; Page: TfrxReportPage);
var
i: Integer;
X, Y, ThisWidth: Extended;
begin
Band := TfrxMasterData.Create(Page);
Band.CreateUniqueName;
Band.SetBounds(0, CurY, 0, 0);
Band.Height := edtHeightData.Value;
TfrxMasterData(Band).frxDataset := frxDataset;
X := 0;
Y := 0;
for i := 0 to pred(frxDataset.Fields.Count) do
begin
ThisWidth := 100;
Memo := CreateMemo(Band);
Memo.SetBounds(X, Y, ThisWidth, fr01cm * 5);
Memo.Dataset := frxDataset;
Memo.DataField := frxDataset.Fields[i].FieldName;
// Set memo style
// Or just add a frame HeaderMemo.Frame....
Memo.Style := 'Data';
Memo.Height := Band.Height - 1;
X := X + ThisWidth;
end;
end;
It should work ok, but I've not had a chance to test since decoupling it from my application.
It will be possible using Framing Property of Memos.