How can I make something like this in Delphi:
I know I can make it from 3 tables so it would be easier, but how can I make Table cells split & merge and how to get the text to turn 90deg.?
Is there some good content libraries that have split & merge built in?
Check out woll2woll or infopower. They will do the grid for sure. The font can be achieved by overriding the OnDrawDataCell, OnDrawGroupHeaderCell and OnDrawTitleCell events and writing the text with rotated font.
{****************************************************************
* Create angled font. Procedure writen by Keith Wood *
****************************************************************}
procedure CreateAngledFont (AFont : TFont; const AAngle : Integer);
var
FntLogRec: TLogFont { Storage area for font information } ;
begin
{ Get the current font information. We only want to modify the angle }
fillchar (FntLogRec, sizeof(FntLogRec), #0);
GetObject (AFont.Handle, SizeOf(FntLogRec), Addr(FntLogRec));
{ Modify the angle. "The angle, in tenths of a degrees, between the base
line of a character and the x-axis." (Windows API Help file.) }
FntLogRec.lfEscapement := (AAngle * 10);
FntLogRec.lfOrientation := (AAngle * 10);
FntLogRec.lfOutPrecision := OUT_TT_PRECIS; { Request TrueType precision }
{ Delphi will handle the deallocation of the old font handle }
AFont.Handle := CreateFontIndirect (FntLogRec);
end;
Related
I need to draw angled text on TDirect2DCanvas, but no success.
procedure TForm1.FormPaint(Sender: TObject);
var
LCanvas: TDirect2DCanvas;
const
myText = 'Kikimor';
begin
LCanvas := TDirect2DCanvas.Create(Canvas, ClientRect);
LCanvas.BeginDraw;
try
LCanvas.Font.Orientation := 90;
LCanvas.TextOut(100,100,myText);
finally
LCanvas.EndDraw;
LCanvas.Free;
end;
end;
No matter what angle I give for orientation, it always draws a straight text.
Is orientation not working or I need to do something else?
Setting TDirect2DCanvas.Font.Orientation does not have any effect (most likely not implemented, sorry, no time to debug). Direct2D wrapper supplied in Delphi is very basic.
To achieve your goal, apply transformation by hand:
procedure TForm1.FormPaint(Sender: TObject);
var
LCanvas: TDirect2DCanvas;
currentTransform: TD2D1Matrix3x2F;
ptf: TD2DPoint2f;
const
myText = 'Kikimor';
begin
LCanvas := TDirect2DCanvas.Create(self.Canvas, ClientRect);
LCanvas.BeginDraw;
try
// backup the current transformation
LCanvas.RenderTarget.GetTransform(currentTransform);
ptf.x:= 100.0; ptf.y:= 100.0; //rotation center point
// apply transformation to rotate text at 90 degrees:
LCanvas.RenderTarget.SetTransform(TD2D1Matrix3x2F.Rotation(90, ptf));
// draw the text (rotated)
LCanvas.TextOut(100, 100, myText);
// restore the original transform
LCanvas.RenderTarget.SetTransform(currentTransform);
finally
LCanvas.EndDraw;
LCanvas.Free;
end;
end;
For more extensive information/effects you can look at:
Drawing text using the IDWriteTextLayout.Draw()
The whole Direct2D category at the same site is also interesting (use Google Translate).
For those using C++ Builder I got this to work:
#include <Vcl.Direct2D.hpp>
// needed for the D2D1::Matrix3x2F::Rotation transform
#ifdef _WIN64
#pragma comment(lib,"D2D1.a")
#else
#pragma comment(lib,"D2D1.lib")
#endif
TD2DPoint2f point; // rotation centre
point.x = 100.0;
point.y = 100.0;
canvas_2d->RenderTarget->SetTransform(D2D1::Matrix3x2F::Rotation(90, point));
canvas_2d->TextOut(100, 100, text);
// restore 0 rotation afterwards
canvas_2d->RenderTarget->SetTransform(D2D1::Matrix3x2F::Rotation(0, point));
Note that trying to use GetTransform like in the Delphi version causes an exception, so I cleared the transform by passing it a new one with zero rotation, there may be a better way to do this.
The pragma is needed due to a link error, see this answer for details.
I am dynamically creating a number of TBitBtn with custom bitmaps. Works nice, except if the screen is high res - which causes positioning and size to change. The other controls on the form are not affected.
Do not know what to try.
BitBbegersopp:= TbitBtn.Create(Form2);
with BitBbegersopp do
begin
Parent:=Form2;
Glyph.LoadFromFile('beger.bmp');
OnClick:= BitBbegersoppClick;
Left:= Start.Left + HDistStartB + 0*HSpacingBitB;
Height:= HSizeBitB;
Width:= VSizeBitB;
Top:= Start.Top + VDistStartB + 0*VSpacingBitB;
Hint:= 'Begersopp, sporer på oversiden';
ShowHint:= True;
Tag:= 1;
end;
Although you didn't provide an example, which leaves us with a lot of guessing, I can see two problems in your code.
The scaling to the current PPI is done inside the assignment to Parent.
In case Start is an existing control, its Left and Top properties are already scaled while the offsets used as well as the values for Width and Height are probably not.
To tackle both problems I suggest the following code sequence:
BitBbegersopp:= TbitBtn.Create(Form2);
with BitBbegersopp do
begin
Glyph.LoadFromFile('beger.bmp');
OnClick:= BitBbegersoppClick;
{ use unscaled values }
Left:= HDistStartB + 0*HSpacingBitB;
Height:= HSizeBitB;
Width:= VSizeBitB;
Top:= VDistStartB + 0*VSpacingBitB;
{ this will scale the control }
Parent:=Form2;
{ Now uses scaled values }
Left:= Start.Left + Left;
Top:= Start.Top + Top;
Hint:= 'Begersopp, sporer på oversiden';
ShowHint:= True;
Tag:= 1;
end;
BTW, please avoid with!
I want to convert the workspace coordinates returned by GetWindowPlacement in rcNormalPosition.Left and rcNormalPosition.Top to screen coordinates that I can assign later to MainForm.Left and MainForm.Top. How can I do that ?
You can use the monitor property of your form to determine if the workspace of the monitor that the form is on has got any offset with the monitor's placement. E.g.
ScreenLeft := wplc.rcNormalPosition.Left +
Monitor.WorkareaRect.Left - Monitor.Left;
ScreenTop := wplc.rcNormalPosition.Top +
Monitor.WorkareaRect.Top - Monitor.Top;
The simplest and cleanest way is to use the API function that partners with GetWindowPlacement, namely SetWindowPlacement. That way you don't need to convert between workspace and screen coordinates because you let the system do the work for you.
var
WindowPlacement: TWindowPlacement;
....
WindowPlacement.length := SizeOf(WindowPlacement);
Win32Check(GetWindowPlacement(Handle, WindowPlacement));
....
Win32Check(SetWindowPlacement(Handle, WindowPlacement));
In the above code, Handle is assumed to be the window handle of the form.
If you have persisted the left and top then you'd restore them like this:
var
WindowPlacement: TWindowPlacement;
....
WindowPlacement.length := SizeOf(WindowPlacement);
Win32Check(GetWindowPlacement(Handle, WindowPlacement));
WindowPlacement.rcNormalPosition.Left := NewLeft;
WindowPlacement.rcNormalPosition.Top := NewTop;
Win32Check(SetWindowPlacement(Handle, WindowPlacement));
I am attempting to translate this code from Delphi to C++ Builder:
procedure HandleStyleSheets(const Document: IDispatch);
var
Doc: IHTMLDocument2; // document object
StyleSheets: IHTMLStyleSheetsCollection; // document's style sheets
SheetIdx: Integer; // loops thru style sheets
OVSheetIdx: OleVariant; // index of a style sheet
StyleSheet: IHTMLStyleSheet; // reference to a style sheet
OVStyleSheet: OleVariant; // variant ref to style sheet
RuleIdx: Integer; // loops thru style sheet rules
Style: IHTMLRuleStyle; // ref to rule's style
begin
// Get IHTMLDocument2 interface of document
if not Supports(Document, IHTMLDocument2, Doc) then
Exit;
// Loop through all style sheets
StyleSheets := Doc.styleSheets;
for SheetIdx := 0 to Pred(StyleSheets.length) do
begin
OVSheetIdx := SheetIdx; // sheet index as variant required for next call
// Get reference to style sheet (comes as variant which we convert to
// interface reference)
OVStyleSheet := StyleSheets.item(OVSheetIdx);
if VarSupports(OVStyleSheet, IHTMLStyleSheet, StyleSheet) then
begin
// Loop through all rules within style a sheet
for RuleIdx := 0 to Pred(StyleSheet.rules.length) do
begin
// Get style from a rule and reset required attributes.
// Note: style is IHTMLRuleStyle, not IHTMLStyle, although many
// attributes are shared between these interfaces
Style := StyleSheet.rules.item(RuleIdx).style;
Style.backgroundImage := ''; // removes any background image
Style.backgroundColor := ''; // resets background colour to default
end;
end;
end;
end;
Everything went fine until this line:
if (VarSupports(OVStyleSheet, IID_IHTMLStyleSheet, StyleSheet))
It reports: E2285 Could not find a match for 'VarSupports(OleVariant,_GUID,_di_IHTMLStyleSheet)'
Everything else translated just fine. Can anyone help me with above line?
My translation so far:
DelphiInterface<IHTMLDocument2> Doc; // document object
DelphiInterface<IHTMLStyleSheetsCollection> StyleSheets; // document's style sheets
int SheetIdx; // loops thru style sheets
OleVariant OVSheetIdx; // index of a style sheet
DelphiInterface<IHTMLStyleSheet> StyleSheet; // reference to a style sheet
OleVariant OVStyleSheet; // variant ref to style sheet
int RuleIdx; // loops thru style sheet rules
DelphiInterface<IHTMLRuleStyle> Style; // ref to rule's style
DelphiInterface<IHTMLStyleSheetRule> StyleSheetRule;
// Get IHTMLDocument2 interface of document
if (!Supports(EmbeddedWB1->Document, IID_IHTMLDocument2, Doc)) throw Exception("Not supported");
// Loop through all style sheets
StyleSheets = Doc->styleSheets;
for (SheetIdx = 0; SheetIdx < StyleSheets->length; SheetIdx++)
{
OVSheetIdx = SheetIdx; // sheet index as variant required for next call
// Get reference to style sheet (comes as variant which we convert to interface reference)
StyleSheets->item(OVSheetIdx, OVStyleSheet);
if (VarSupports(OVStyleSheet, IID_IHTMLStyleSheet, StyleSheet))
{
// Loop through all rules within style a sheet
for (RuleIdx = 0; RuleIdx < StyleSheet->rules->length; RuleIdx)
{
// Get style from a rule and reset required attributes.
// Note: style is IHTMLRuleStyle, not IHTMLStyle, although many
// attributes are shared between these interfaces
StyleSheet->rules->item(RuleIdx, StyleSheetRule);
Style = StyleSheetRule->style;
Style->backgroundImage = L""; // removes any background image
Style->backgroundColor = L""; // resets background colour to default
}
}
}
}
The reason for the compile error is that VarSupports is defined as taking a Variant, and you are passing an OleVariant.
It looks to me as if the code is trying to assign the OVStyleSheet to the IHTMLStyleSheet interface StyleSheet. In C++ Builder, you should be able to just assign it, as in
_di_IInterface inter = _di_IInterface(OVStyleSheet);
StyleSheet = inter;
If that succeeds and StyleSheet is not NULL, you should be able to use StyleSheet. Note that invalid Variant assignments can throw an exception, so you might want to handle that (and assume that the exception also means that the OVStyleSheet does not support the IHTMLStyleSheet interface)
Also, C++ Builder has an Interface.Supports function that appears to do what VarSupports does, except that VarSupports takes a variant, so Interface.Supports also requires you to obtain the interface from the OleVariant yourself. Probably something like:
di_IInterface inter = _di_IInterface(OVStyleSheet);
if (inter->Supports(StyleSheet))
{
ShowMessage("StyleSheet has been assigned");
}
This compiles, but I have not tested it.
I am drawing a dashed line on the TImage Canvas and found out that the size of dashes is way too big for the drawing area. Is there a way to change the size of dashes of lines drawn on canvas?
This is what i do to be able to draw dashed lines.
Canvas.Pen.Style := psDash;
Canvas.Polyline(myPoints);
And i didn't find any Pen property which could change the dash size/length.
Thanks
According to http://docwiki.embarcadero.com/VCL/e/index.php/Graphics.TPenStyle you can use psUserStyle
The docs for ExtCreatePen are at http://msdn.microsoft.com/en-us/library/dd162705(VS.85).aspx
Here's my interpretation of how ExtCreatePen is meant to be used in combination with TPen:
const
NumberOfSections = 8;
LineLengths: array[0..NumberOfSections-1] of DWORD =
(20, 15, 14, 17, 14, 8, 16, 9);
var
logBrush: TLogBrush;
begin
logBrush.lbStyle := BS_SOLID;
logBrush.lbColor := DIB_RGB_COLORS;
logBrush.lbHatch := HS_BDIAGONAL; // ignored
Canvas.Pen.Handle := ExtCreatePen(PS_GEOMETRIC or PS_USERSTYLE or PS_ENDCAP_ROUND or PS_JOIN_BEVEL,
4, logBrush, NumberOfSections, #LineLengths[0]);
// now Canvas.Pen.Style = psUserStyle
Canvas.Polyline([Point(0,0), Point(100,100), Point(200, 100)]);
end;
I don't know, but, which is the implementation of Polyline()? When you control+click it, which code do you see? Is it using an property-exposed variable may be? If so, you can set it, otherwise -if it is hardcoded- you will see it, and know that you can't.