I am working on one project where I need the pixel of Last visible item in the TRichview.
By using 'LastVisibleItem' Property of TRichView I am able to find the Item Start Cordinate.
but the Problem is I need a pixel value of very last visible word.
Can any one tell me how I can get that?
Thanks in advance.
I'm a bit unsure how your LastVisibleItem property works. Below is a suggested solution to get the top-right coordinate of the last visible character. Hope it works for you.
//Function GetCharPos source: http://www.delphipages.com/forum/showthread.php?t=33707
function GetCharPos(AOwner : TControl; Index : LongInt) : TPoint;
var
p : TPoint;
begin
AOwner.Perform(EM_POSFROMCHAR,WPARAM(#p),Index);
Result := p;
end;
//Inspired by: http://www.swissdelphicenter.ch/en/showcode.php?id=1213
function GetLastVisibleCharIndex(AOwner : TControl):integer;
var
r: TRect;
begin
//The EM_GETRECT message retrieves the formatting rectangle of an edit control.
AOwner.Perform(EM_GETRECT, 0, Longint(#r));
r.Right := r.Right - 1;
r.Bottom := r.Bottom - 2;
//The EM_CHARFROMPOS message retrieves information about the character closest to a specified point in the client area of an edit control
result := AOwner.Perform(EM_CHARFROMPOS, 0, Integer(#r.BottomRight));
end;
//Get the Top-Right coordinate of the last visible character
function GetLastVisibleCharPos(AOwner : TControl):TPoint;
var Index : integer;
begin
index := GetLastVisibleCharIndex(AOwner);
result := GetCharPos(AOwner, index);
end;
Example usage:
procedure TForm2.Button3Click(Sender: TObject);
var
p : TPoint;
begin
p := GetLastVisibleCharPos(RichEdit1);
DrawCrossHair(p); //Help visualize the point
end;
//Helper proc to draw a cross-hair
procedure TForm2.DrawCrossHair(p : TPoint);
var
aCanvas: Tcanvas;
X, Y: Integer;
begin
aCanvas := TCanvas.Create;
Y := RichEdit1.Height;
X := RichEdit1.Width;
try
aCanvas.Handle := GetDC(RichEdit1.Handle);
aCanvas.Font := RichEdit1.Font;
aCanvas.Pen.color := clGreen; // Color of line
//Draw vertical line
aCanvas.MoveTo(p.x, 0);
aCanvas.LineTo(p.x, Y);
//Draw horizontal line
aCanvas.MoveTo(0, p.Y);
aCanvas.LineTo(x, p.y);
finally
ReleaseDC(RichEdit1.Handle, aCanvas.Handle);
aCanvas.Free;
end;
end;
Related
Delphi 10 with an Embedded TeeChart.
I would like to hide a partial of tLineSeries and detect ONLY the visible parts by CalcClickedPart.
Assume a non sorted XY line with many cross among them, some of the points could be selected by user as not visible. I'm doing so by setting the color of the "hidden" points to clNone. When the user is moving the mouse, on MouseMove event, a CalcClickedPart is called, but it is response to the "hidden" points too, since it is not a real hidden way.
The chart creation:
procedure TForm1.FormCreate(Sender: TObject);
const
clHideColor = {clDefault}clNone; // clNone, clDefault
begin
Chart1.View3D := false;
with Chart1.AddSeries(TLineSeries) as TLineSeries do
begin
// AddXY(Const AXValue, AYValue: TChartValue; Const ALabel: String; AColor: TColor):
XValues.Order := loNone;
YValues.Order := loNone;
AddXY( 0, 0, '', clHideColor); // Origin point
AddXY( 50, 50, '', clHideColor); // / Cross point
AddXY(100, 100); // /
AddXY(100, 0); // |
AddXY( 50, 50); // \ Cross point
AddXY( 0, 100); // \ End point
end;
end;
The CalcClickedPart code in Chart's MouseMove event
procedure TForm1.Chart1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
Var
ClickedPart: tChartClickedPart;
sCursorText: string;
begin
sCursorText := '';
Chart1.CalcClickedPart(Point(X, Y), ClickedPart); // Return information about the TeeChart component below the Mouse pointer at an X,Y location.
Case ClickedPart.Part of
cpNone : sCursorText := 'cpNone';
cpLegend : sCursorText := 'cpLegend';
cpAxis : sCursorText := 'cpAxis';
cpSeries : sCursorText := 'cpSeries';
cpTitle : sCursorText := 'cpTitle';
cpFoot : sCursorText := 'cpFoot';
cpChartRect : sCursorText := 'cpChartRect';
cpSeriesMarks : sCursorText := 'cpSeriesMarks';
cpSeriesPointer : sCursorText := 'cpSeriesPointer' +
ClickedPart.PointIndex.ToString;
cpSubTitle : sCursorText := 'cpSubTitle';
cpSubFoot : sCursorText := 'cpSubFoot';
cpAxisTitle : sCursorText := 'cpAxisTitle';
end;
Chart1.Title.Text.Text := sCursorText;
end;
In the above example, when the mouse on the middle (50,50) the shown point is #1 (which is hidden) instead of 4.
I could go through all series points and find other closer points, but is there a "clean" way to hide partial series?
The entire series is visible:
First two points are "hidden", see title with point index 1 instead 4 (round red circle)
I decided to write my own CalcClickedPart function which go through all series and value index and checking if series' ValueColor[Inx] <> clNone as follow:
function CalcClickedPartHidenPoints(aChart: tChart; Pos: TPoint; Out Part: tChartClickedPart): boolean;
var
nSeriesInx, nValueInx: integer;
aSeries: TCustomSeries;
begin
Result := false;
for nSeriesInx := 0 to aChart.SeriesCount-1 do // Go through all series
begin
aSeries := aChart[nSeriesInx] as TCustomSeries;
if aSeries.Visible then // Series is selected in Legend
begin
for nValueInx := 0 to aSeries.Count-1 do
if (abs(aSeries.CalcXPos(nValueInx) - Pos.X) <= aSeries.ClickTolerance) and
(abs(aSeries.CalcYPos(nValueInx) - Pos.Y) <= aSeries.ClickTolerance) then
if aSeries.ValueColor[nValueInx] <> clNone then // A "visible" point
begin
Part.ASeries := aSeries;
Part.Part := cpSeriesPointer;
Part.PointIndex := nValueInx;
Result := true;
Break; // Stop searching for a visible point under the mouse
end;
end;
if Result then
Break;
end;
end;
Now the cursor in the example shows point #4 as should be:
Another option is to split a series to many series, but I don't like it.
I am developing an application on Embarcadero XE where i receive real time data from the ethernet port and display on a teechart chart on the screen.
The application works like an osciloscope, that is, there is a time window (10 seconds for example) of data that the chart displays, and each new incoming point overwrites what already is on screen.
I would like your help to make a code that puts a marker on only the newest point added, so the user can keep track of which of the points on the screen is the most recent point. I don´t want all of the points with a marker, i want only the newest.
The series being used is a fastline.
Here is the code i'm using to add data to the chart:
//Delete already existing point
if (Oscilografia.Series[0].Count>1) then
begin
Oscilografia.Series[0].Delete(cont);
end;
//Write point
Oscilografia.Series[0].addxy(cont,data, '', clblue);
You have several options. The simplest is to make a new TPointSeries to display the current point. If you wish to not show this series in the legend then simply set :
Oscilografia.Series[n].ShowInLegend := false;
where n is the index of the series you wish to exclude from the legend.
Alternatively, you can custom-draw any relevant items in the OnAfterDraw handler. For example :
procedure TForm1.Chart1AfterDraw(Sender: TObject);
var
xPos, yPos : integer;
begin
Chart1.Canvas.Pen.Color := clRed;
Chart1.Canvas.Pen.Style := psSolid;
Chart1.Canvas.Pen.Width := 1;
Chart1.Canvas.Pen.Mode := pmCopy;
xPos := Chart1.BottomAxis.CalcPosValue(CurrentXValue);
yPos := Chart1.LeftAxis.CalcPosValue(CurrentYValue);
// Parameters are
// X-Coord, Y-Coord, X-Radius, Y-Radius, Start Angle, End Angle, Hole%
Chart1.Canvas.Donut(xPos, yPos, 3, 3, 0, 360, 0);
end;
This produces, for example :
Custom drawing lets you do other things also, like add markers, etc. For example :
procedure TForm1.Chart1AfterDraw(Sender: TObject);
var
xPos, yPos : integer;
yMax, yMin : integer;
begin
Chart1.Canvas.Pen.Color := clRed;
Chart1.Canvas.Pen.Style := psSolid;
Chart1.Canvas.Pen.Width := 1;
Chart1.Canvas.Pen.Mode := pmCopy;
xPos := Chart1.BottomAxis.CalcPosValue(CurrentXValue);
yPos := Chart1.LeftAxis.CalcPosValue(CurrentYValue);
Chart1.Canvas.Donut(xPos, yPos, 3, 3, 0, 360, 0);
Chart1.Canvas.Pen.Color := clGreen;
Chart1.Canvas.Pen.Style := psDash;
yMax := Chart1.LeftAxis.CalcPosValue(Chart1.LeftAxis.Maximum);
yMin := Chart1.LeftAxis.CalcPosValue(Chart1.LeftAxis.Minimum);
Chart1.Canvas.DoVertLine(xPos, yMax, yMin);
end;
Which gives a dashed vertical line that follows the current point :
Note that the CalcPosValue function is exposed by the chart axes and allows you to translate a point in the axis-space to an integer (screen) coordinate in the chart's canvas space.
As an alternative to J's proposal of using custom drawing techniques to draw a pointer, you could change the TFastLineSeries to use a TLineSeries and make its Pointer Visible. Then, you can use OnGetPointerStyle event to hide all the pointers except the last one:
uses Series;
var Series1: TLineSeries;
procedure TForm1.FormCreate(Sender: TObject);
var i: Integer;
begin
Chart1.View3D:=false;
Series1:=Chart1.AddSeries(TLineSeries) as TLineSeries;
for i:=0 to 360 do
Series1.Add(Sin(PI*i/180));
Series1.Pointer.Visible:=true;
Series1.OnGetPointerStyle:=SeriesGetPointerStyle;
end;
function TForm1.SeriesGetPointerStyle(Sender:TChartSeries; ValueIndex:Integer):TSeriesPointerStyle;
begin
result:=(Sender as TLineSeries).Pointer.Style;
if (ValueIndex<>Sender.Count-1) then
result:=psNothing;
end;
And as a complement, if you want to show the Mark of the last point in the series, you can make the series' Marks Visible and use OnGetMarkText event to hide all the Marks except the last one:
uses Series;
var Series1: TLineSeries;
procedure TForm1.FormCreate(Sender: TObject);
var i: Integer;
begin
Chart1.View3D:=false;
Series1:=Chart1.AddSeries(TLineSeries) as TLineSeries;
for i:=0 to 360 do
Series1.Add(Sin(PI*i/180));
Series1.Pointer.Visible:=true;
Series1.OnGetPointerStyle:=SeriesGetPointerStyle;
Series1.Marks.Visible:=true;
Series1.OnGetMarkText:=SeriesGetMarkText;
end;
function TForm1.SeriesGetPointerStyle(Sender:TChartSeries; ValueIndex:Integer):TSeriesPointerStyle;
begin
result:=(Sender as TLineSeries).Pointer.Style;
if (ValueIndex<>Sender.Count-1) then
result:=psNothing;
end;
procedure TForm1.SeriesGetMarkText(Sender:TChartSeries; ValueIndex:Integer; var MarkText:String);
begin
if (ValueIndex<>Sender.Count-1) then
MarkText:='';
end;
Note I'm using a TLineSeries here also, but if you are only interested on showing the Marks and not the Pointer, you can still use a TFastLineSeries.
I have an image list containing several bitmaps which I would like to save together as one single bitmap, but I need it saving just like how a spritesheet or tilesheet is drawn in 2d and rpg games etc.
Typically the tilesheet is drawn with several images across (in a row), so for example if I wanted a maximum of 6 images per row, it will only draw 6, with further images been drawn underneath in a new row.
I can save it in one single row like so:
var
CurrentFrame: Integer;
StripWidth: Integer;
Strip: TBitmap;
Bmp: TBitmap;
I: Integer;
begin
if SaveDialog.Execute then
begin
StripWidth := ImageList1.Width * ImageList1.Count - ImageList1.Width;
CurrentFrame := - ImageList1.Width;
Strip := TBitmap.Create;
try
Strip.SetSize(StripWidth, ImageList1.Height);
Bmp := TBitmap.Create;
try
for I := 0 to ImageList1.Count - 1 do
begin
CurrentFrame := CurrentFrame + ImageList1.Width;
ImageList1.GetImage(I, Bmp);
Strip.Canvas.Draw(CurrentFrame, 0, Bmp);
end;
finally
Bmp.Free;
end;
Strip.SaveToFile(SaveDialog.FileName);
finally
Strip.Free;
end;
end;
end;
So imagine the result for the above is:
The result I want is something like:
So the above would have considered in the procedure/ function a parameter to allow only 3 images per row as an example.
How do I export all images from an imagelist into one single bitmap, allowing only x amount if images to be drawn horizontally before creating a new row?
Thanks.
EDIT
Thanks to David's answer, I put together these procedures:
procedure DrawImageOnSheet(Images: TImageList; Sheet: TBitmap;
ImageIndex, X, Y: Integer);
var
Bitmap: TBitmap;
begin
Bitmap := TBitmap.Create;
try
Images.GetBitmap(ImageIndex, Bitmap);
Sheet.Canvas.Draw(X, Y, Bitmap);
finally
Bitmap.Free;
end;
end;
procedure SaveImageListAsSheet(Images: TImageList; FileName: string;
NumberOfColumns: Integer);
var
Sheet: TBitmap;
nImage: Integer;
nCol: Integer;
nRow: Integer;
nToDraw: Integer;
nRemaining: Integer;
ImageIndex: Integer;
X, Y: Integer;
I: Integer;
begin
Sheet := TBitmap.Create;
try
nImage := Images.Count;
nCol := NumberOfColumns;
nRow := (nImage + nCol - 1) div nCol;
Sheet.Height := nRow * Images.Height;
Sheet.Width := nCol * Images.Width;
nRemaining := nImage;
ImageIndex := 0;
Y := 0;
while nRemaining > 0 do
begin
nToDraw := Math.Min(nRemaining, nCol);
X := 0;
for I := 0 to nToDraw - 1 do
begin
DrawImageOnSheet(Images, Sheet, ImageIndex, X, Y);
Inc(ImageIndex);
Inc(X, Images.Width);
end;
Inc(Y, Images.Height);
Dec(nRemaining, nToDraw);
end;
Sheet.SaveToFile(FileName);
finally
Sheet.Free;
end;
end;
According to clarification from the comments, you are struggling with the counting of the images, the organisation of the rows/columns and so on. So, let's assume you already have this function which draws image ImageIndex to the output bitmap at a position of X, Y.
procedure Draw(ImageIndex, X, Y: Integer);
Let's also assume that the images have dimensions given by ImageWidth and ImageHeight. Finally, there are nImage images and you want to have nCol images per column.
So, first of all, how many rows do you need?
nRow := (nImage + nCol - 1) div nCol;
Now you can set the size of the output bitmap. Its width is nCol * ImageWidth and its height is nRow * ImageHeight.
Now to draw the images.
nRemaining := nImage;
ImageIndex := 0;
Y := 0;
while nRemaining > 0 do
begin
nToDraw := Math.Min(nRemaining, nCol);
X := 0;
for i := 0 to nToDraw - 1 do
begin
Draw(ImageIndex, X, Y);
inc(ImageIndex);
inc(X, ImageWidth);
end;
inc(Y, ImageHeight);
dec(nRemaining, nToDraw);
end;
When designing a form in the IDE, non-visual components (eg TMainMenus, TDatamodules) can be freely placed and positioned. The position is persisted, so that on reloading the form these components appear in the correct place.
But, TComponent does not have Top or Left properties!
So, how can my code access the 'designed position' of non visual components?
This can be accessed at runtime, but it's sort of a hack. (Mostly because it's implemented as sort of a hack.)
The Left and Top properties are set up as Word-size values, and the two of them are packed together into a Longint called TComponent.FDesignInfo. You can obtain its value with the DesignInfo property. Have a look at TComponent.DefineProperties to get a look into how it's used.
And also:
How to set DesignInfo to a point like (-100,-100)?
Objective: Put the icon out of visual area, hide it on design-time.
Note: It is very usefull when for example creating simple visual components derived directly from TComponent, i have in mind a very simple label (taht is allways aligned to top, has allways left=0, top is auto-calculated, bla bla bla) that only stores it's caption property into the .dfm file; and also any localizer will only see that caption property.
SOLUTION is to Override ReadState with code like this:
procedure TMyComponent.ReadState(Reader:TReader);
var
NewDesignInfo:LongRec;
begin
inherited ReadState(Reader);
NewDesignInfo.Hi:=Word(-100); // Hide design-time icon (top position = -100)
NewDesignInfo.Lo:=Word(-100); // Hide design-time icon (left position = -100)
DesignInfo:=Longint(NewDesignInfo); // Set the design-icon position out of visual area
end;
Hope help others!
This worked for me. Source: CnPack CnAlignSizeWizard.pas.
procedure SetNonVisualPos(Form: TCustomForm; Component: TComponent; X, Y: Integer);
const
NonvisualClassNamePattern = 'TContainer';
csNonVisualSize = 28;
csNonVisualCaptionSize = 14;
csNonVisualCaptionV = 30;
var
P: TSmallPoint;
H1, H2: HWND;
Offset: TPoint;
function HWndIsNonvisualComponent(hWnd: hWnd): Boolean;
var
AClassName: array[0..256] of Char;
begin
AClassName[GetClassName(hWnd, #AClassName, SizeOf(AClassName) - 1)] := #0;
Result := string(AClassName) = NonvisualClassNamePattern;
end;
procedure GetComponentContainerHandle(AForm: TCustomForm; L, T: Integer; var H1, H2: hWnd; var Offset: TPoint);
var
R1, R2: TRect;
P: TPoint;
ParentHandle: hWnd;
AControl: TWinControl;
I: Integer;
begin
ParentHandle := AForm.Handle;
AControl := AForm;
if AForm.ClassNameIs('TDataModuleForm') then // ÊÇ DataModule
begin
for I := 0 to AForm.ControlCount - 1 do
if AForm.Controls[I].ClassNameIs('TComponentContainer')
and (AForm.Controls[I] is TWinControl) then
begin
AControl := AForm.Controls[I] as TWinControl;
ParentHandle := AControl.Handle;
Break;
end;
end;
H2 := 0;
H1 := GetWindow(ParentHandle, GW_CHILD);
H1 := GetWindow(H1, GW_HWNDLAST);
while H1 <> 0 do
begin
if HWndIsNonvisualComponent(H1) and GetWindowRect(H1, R1) then
begin
P.x := R1.Left;
P.y := R1.Top;
P := AControl.ScreenToClient(P);
if (P.x = L) and (P.y = T) and (R1.Right - R1.Left = csNonVisualSize)
and (R1.Bottom - R1.Top = csNonVisualSize) then
begin
H2 := GetWindow(ParentHandle, GW_CHILD);
H2 := GetWindow(H2, GW_HWNDLAST);
while H2 <> 0 do
begin
if HWndIsNonvisualComponent(H2) and GetWindowRect(H2, R2) then
begin
if (R2.Top - R1.Top = csNonVisualCaptionV) and (Abs(R2.Left + R2.Right - R1.Left - R1.Right) <= 1)
and (R2.Bottom - R2.Top = csNonVisualCaptionSize) then
begin
Offset.x := R2.Left - R1.Left;
Offset.y := R2.Top - R1.Top;
Break;
end;
end;
H2 := GetWindow(H2, GW_HWNDPREV);
end;
Exit;
end;
end;
H1 := GetWindow(H1, GW_HWNDPREV);
end;
end;
begin
P := TSmallPoint(Component.DesignInfo);
GetComponentContainerHandle(Form, P.x, P.y, H1, H2, Offset);
Component.DesignInfo := Integer(PointToSmallPoint(Point(X, Y)));
if H1 <> 0 then
SetWindowPos(H1, 0, X, Y, 0, 0, SWP_NOSIZE or SWP_NOZORDER);
if H2 <> 0 then
SetWindowPos(H2, 0, X + Offset.x, Y + Offset.y, 0, 0, SWP_NOSIZE or SWP_NOZORDER);
end;
Use sample:
SetNonVisualPos(TCustomForm(Designer.Root),MyComponent,10,10);
I have a TGridPanel on a form and wish to add a control to a specific "cell" that is clicked on.
I can get the point easily enough:
procedure TForm1.GridPanel1DblClick(Sender: TObject);
var
P : TPoint;
InsCol, InsRow : Integer;
begin
P := (Sender as TGridPanel).ScreenToClient(Mouse.CursorPos);
if (Sender as TGridPanel).ControlAtPos(P) = nil then
begin
InsCol := ???;
InsRow := ???;
(Sender as TGridPanel).ControlCollection.AddControl(MyControl, InsCol, InsRow)
end;
end;
I probably don't need the if ControlAtPos(P) = nil then line, but I want to make sure I'm not inserting a control in a cell that already has one in it.
So... what code do I use to get InsCol and InsRow? I've been up and down the TGridPanel and TControlCollection class code and can't find anything that will give me a column or row value from mouse coordinates. Nor does their seem to be a relevant event to use other than OnDblClick().
Any help would be greatly appreciated.
EDIT: Changed variable Result to MyControl to avoid confusion.
procedure TForm1.GridPanel1Click(Sender: TObject);
var
P: TPoint;
R: TRect;
InsCol, InsRow : Integer;
begin
P := (Sender as TGridPanel).ScreenToClient(Mouse.CursorPos);
for InsCol := 0 to GridPanel1.ColumnCollection.Count - 1 do
begin
for InsRow := 0 to GridPanel1.RowCollection.Count - 1 do
begin
R:= GridPanel1.CellRect[InsCol,InsRow];
if PointInRect(P,R) then
begin
ShowMessage (Format('InsCol = %s and InsRow = %s.',[IntToStr(InsCol), IntToStr(InsRow)]))
end;
end;
end;
end;
function TForm1.PointInRect(aPoint: TPoint; aRect: TRect): boolean;
begin
begin
Result:=(aPoint.X >= aRect.Left ) and
(aPoint.X < aRect.Right ) and
(aPoint.Y >= aRect.Top ) and
(aPoint.Y < aRect.Bottom);
end;
end;
Here is an optimization of Ravaut123's approach (should be MUCH faster for larger grids). This function will return the X/Y grid location in a TPoint. If the user clicked on a valid column but not a valid row, then the valid column information is still returned, and the same goes for rows. So it isn't "all or nothing" (valid cell or invalid cell). This function assumes the grid is "regular" (every column has the same row height as the first column, likewise every row has the same column width as the first row). If the grid is not regular then Ravaut123's solution is the better choice.
// APoint is a point in local coordinates for which you want to find the cell location.
function FindCellInGridPanel(AGridPanel: TGridPanel; const APoint: TPoint): TPoint;
var
ICol, IRow : Integer;
R : TRect;
begin
Result.X := -1;
Result.Y := -1;
for ICol := 0 to AGridPanel.ColumnCollection.Count - 1 do
begin
R := AGridPanel.CellRect[ICol, 0];
if (APoint.X >= R.Left) and (APoint.X <= R.Right) then
begin
Result.X := ICol;
Break;
end;
end;
for IRow := 0 to AGridPanel.RowCollection.Count - 1 do
begin
R := AGridPanel.CellRect[0, IRow];
if (APoint.Y >= R.Top) and (APoint.Y <= R.Bottom) then
begin
Result.Y := IRow;
Break;
end;
end;
end;