Hope this is clear...
I want to know if the PaintBox control can allow the user to scroll, left to right through data? Imagine it like an oscilloscope display where a single capture allows zooming and scrolling. In this case I do not need zooming. So, my Paintbox is 800x600 and my data set is 16000x600.
I can plot in the 800x600 region as shown below, no problems at all, and can apply scaling to get all the data in, but I want to keep the Y-axis scaled to 1 and be able to scroll/drag left/right and view the data.
for J := 1 to ((Form1.Memo1.Lines.count)-1) do
begin
MyTorques[J] := StrToInt(Form1.Memo1.Lines[J]);
Tqmult := ((StrToInt(Label6.Caption) + 500) Div 600);
Ycalc[J] := ((MyTorques[J]) Div Tqmult);
InvY[J] := (600 - (Ycalc[J]));
X1 := (J-1);
Y1 := InvY[J-1];
X2 := (J);
Y2 := InvY[J];
with PaintBox1.Canvas do
begin
pen.Style := psSolid;
pen.Color := clBlack;
pen.Width := 1;
moveto(X1, Y1);
Lineto(X2, Y2);
Label51.Caption := IntToStr(X1);
Label52.Caption := IntToStr(Y1);
Label28.Caption := IntToStr(X2);
Label29.Caption := IntToStr(Y2);
Label35.Caption := IntToStr(Tqmult);
Label37.Caption := IntToStr(Ycalc[J]);
Label39.Caption := IntToStr(InvY[J]);
Label41.Caption := IntToStr(MyTorques[J]);
end;
if MyTorques[J] < Smallest Then
Begin
Smallest := MyTorques[J];
SmallestIndex := J;
end;
if MyTorques[J] > Largest Then
begin
Largest := MyTorques[J];
LargestIndex := J;
end;
Label30.Caption := IntToStr(Smallest);
Label31.Caption := IntToStr(SmallestIndex);
Label32.Caption := IntToStr(Largest);
Label33.Caption := IntToStr(LargestIndex);
end;
So, does my paintbox.canvas need to be sized 16000x600 with a "window" over the top sized 800x600, and the paintbox control is drag-able with vertical and horizontal constraints?
PaintBox by default does not have any scrolling support built in.
So if you want to have scrolling capabilities you will have to place your PaintBox into some other scrollable control like ScrollBox and set size of your PaintBox large enoought to contain rendering of your entire plot.
But this is a bad practice. Why? Doing so you will spend a lot of time painting your plot even thou only a part of it is visible to user at one time.
Instead you should be thinking of painting just part of your plot that can actually be visible by your user at the sima time (fits into PaintBox) and then redraw the plot when user scrolls to different position on a plot.
Related
I want to be able to programatically resize one layer (the selected one) on click of a button.
So basically I have an ImgView32, and I add layers to it. The last one is selected, then I want to press a button and onClick of that button I want the selected layer to be enlarged...
I want to be able to draw lines horizontal and vertical, in order to allow the user to draw the layout of a house (in 2D). But I want the user to be able to resize a line without the mouse... so he should be able to enter the width and height in editboxes and on click of a button apply the dimensions to the respective (selected) line.
How can I do that in graphics32?
I tried like this:
var
orig,Tmp: TBitmap32;
Transformation: TAffineTransformation;
begin
Tmp := TBitmap32.Create;
Orig := TBitmap32.Create;
Transformation := TAffineTransformation.Create;
if Selection is TBitmapLayer then
begin
orig := TBitmapLayer(Selection).Bitmap;
try
Transformation.BeginUpdate;
Transformation.SrcRect := FloatRect(0, 0, orig.Width+200, orig.Height+200);
Transformation.Translate(-0.5 * orig.Width, -0.5 * orig.Height);
tmp.SetSize(200,200);
Transformation.Translate(0.5 * Tmp.Width, 0.5 * Tmp.Height);
Transformation.EndUpdate;
orig.DrawMode := dmTransparent;
Transform(Tmp, orig, Transformation);
orig.Assign(Tmp);
orig.DrawMode := dmTransparent;
finally
Transformation.Free;
Tmp.Free;
end;
end;
end;
But the selected layer remains the same size and the contents shrink...
I do not know what I am doing wrong.
Please help.
Thank you
Something like:
begin
if Selection is TBitmapLayer then
begin
TBitmapLayer(Selection).Location := FloatRect(TBitmapLayer(Selection).Location.Left,
TBitmapLayer(Selection).Location.Top, TBitmapLayer(Selection).Location.Right + 200, TBitmapLayer(Selection).Location.Bottom + 200);
end;
end;
would make the layer wider by 200 pixel (in both x- and y- dimension). Doing so, the content will (typically) be stretched, if not specified otherwise.
The ugly assignment can be written more elegantly using a function like IncreaseRect(), which however is not present, but must be written by yourself.
It could look like:
function IncreaseRect(SourceRect: TFloatRect; IncX, IncY: TFloat): TFloatRect;
begin
Result := FloatRect(SourceRect.Left, SourceRect.Top,
SourceRect.Right + IncX, SourceRect.Top + IncY);
end;
and called with
TBitmapLayer(Selection).Location := IncreaseRect(TBitmapLayer(Selection).Location, 200, 200);
Still I'm not sure if this is what you're after.
I have a grid that can be resized. And i'm now stuggeling with filling the blank space around columns in the grid. I'm trying to achieve this on FormResize.
First i calculate what is the total of columns width and then i'm comparing it to the string grid width. if the stringgrid widths is bigger then i add to each columns width equal portions of the blank space left. This is how it looks in formResize Procedure:
procedure TBDDTool.FormResize(Sender: TObject);
var
totColWidth,i : integer;
begin
totColWidth := 0;
for i := 0 to sgFilePreview.ColCount - 1 do
totColWidth := totColWidth + sgFilePreview.ColWidths[i];
if sgFilePreview.Width > TotColWidth then
begin
for i := 0 to sgFilePreview.ColCount - 1 do
begin
sgFilePreview.ColWidths[i] := round(sgFilePreview.ColWidths[i] +
((sgFilePreview.Width - totColWidth)/(sgFilePreview.colCount)));
end;
end;
end;
This actualy doesn't work cause sgFilePReview.Width is the width of my grid. And i don't know how to get the width of the whole space inside the grid, like every columns + blank space left. How can i get the real width of the grid? Cause sgFilePreview.Width return the width of the grid but as seen from outside the grid.
Thank you!
EDIT
Addine new columns
for val in sLineSplitted do
begin
if Pos('#',val) <> 0 then propVal := copy(val,0,pos('#',val)-1)
else propVal := val;
col := col +1;
if (row = 1) then
begin
if (col >1) then
//Add column
sgFilePreview.ColCount := col;
sgFilePreview.Cols[col-1].Text := propVal;
SetLength(aSourceData[row-1],col);
aSourceData[row-1,col-1] := val;
end
else
begin
sgFilePreview.RowCount := row;
SetLength(aSourceData[row-1],col);
aSourceData[row-1, col-1] := val;
sgFilePreview.Cells[col-1, row-1] := propVal;
pnlFileManager.Visible := true;
end;
end;
Auto size columns to fit word if the world is bigger than the cell's width
procedure TBDDTool.AutoSizeGrid(Grid: TStringGrid);
const
ColWidthMin = 10;
var
C,R,W, ColWidthMax: integer;
begin
for c := 0 to Grid.ColCount - 1 do
begin
ColWidthMax := ColWidthMin;
for R := 0 to Grid.RowCount - 1 do
begin
W := Grid.Canvas.TextWidth(Grid.Cells[C,R]);
if W > ColWidthMax then
ColWidthMax :=W;
end;
Grid.ColWidths[C] := ColWidthMax +5;
end;
end;
The main problem why these empty spaces are occurring to you even when you have too many columns so that all of them can be seen at the same time is the fact that in StringGrid scrolling works a bit different than you are used to in other controls.
When you scroll around in StringGrid the scrolling position is always aligned to the position of TopLeft visible cell. So if the combined width of visible cols isn't the same as ClientWidth this means that you will either have partially visible col at the right side or and empty space when you have scrolled all the way to the right.
Now one possible way to avoid this is to resize the columns so that they always fit into the client width (no partially visible columns). But the problem is that this becomes practically impossible if you have different widths for each column.
In case if you can live with the fact that all columns will have same width you can use the code below which works in most cases. It isn't perfect because you can only set column width to integer values where sometimes you would need larger precision.
procedure TForm1.FormResize(Sender: TObject);
var cwDefaultWidth: Integer;
VisibleCols: Integer;
ColWidth: Integer;
begin
cwDefaultWidth := 64;
VisibleCols := StringGrid1.ClientWidth div cwDefaultWidth;
if VisibleCols >= StringGrid1.ColCount then
begin
ColWidth := Round(StringGrid1.ClientWidth / StringGrid1.ColCount-1);
end
else
begin
ColWidth := Round(StringGrid1.ClientWidth / VisibleCols-1);
end;
StringGrid1.DefaultColWidth := ColWidth;
end;
But if you are using variable column widths then the only thing that you could do is adjust the size of the last column so that it's width fills the empty space that would otherwise appear.
In order to do that you would first have to check to see if you are scrolled fully to the right. Then you would have to sum up the width of currently seen columns. You could do this by using:
for I := StringGrid1.LeftCol to StringGrid1.RowCount-1 do
begin
VisibleColsWidth := VisibleColsWidth + StringGrid1.ColWidths[I];
end;
Then you subtract this width from StringGrid1.ClientWidth and you get the width of empty space. So finally you increase the size of last column for the empty space width.
I really hope that even if my answer doesn't provide you with an actual solution it would at least guide you towards finding the right solution.
I have a code, that draws the message str directly to center of the screen without a visible window.
Why using this code first works OK, but after dozens of calls, it gives Out of system resources.
It seems to free BM ok, and I don't see that it allocates other resources at all.
procedure ttsplash.UpdateSplash(const Str: string);
var
R: TRect;
P: TPoint;
S: TPoint;
bm: TBitmap;
bf: TBlendFunction;
EXSTYLE: DWORD;
x, y: integer;
pixel: PRGBQuad;
TextRed,
TextGreen,
TextBlue: byte;
begin
if str='' then exit;
EXSTYLE := GetWindowLong(Handle, GWL_EXSTYLE);
SetWindowLong(Handle, GWL_EXSTYLE, EXSTYLE or $80000);
R := ClientRect;
bm := TBitmap.Create;
try
bm.PixelFormat := pf32bit;
// bm.SetSize(ClientWidth, ClientHeight);
bm.Width := clientwidth;
bm.height := clientheight;
bm.Canvas.Brush.Color := clBlack;
bm.Canvas.FillRect(ClientRect);
bm.Canvas.Font.Assign(Self.Font);
bm.Canvas.Font.Color := clWhite;
DrawText(bm.Canvas.Handle, PChar(Str), Length(Str), R,
DT_SINGLELINE or DT_VCENTER or DT_CENTER or DT_WORD_ELLIPSIS);
TextRed := GetRValue(ColorToRGB(Font.Color));
TextGreen := GetGValue(ColorToRGB(Font.Color));
TextBlue := GetBValue(ColorToRGB(Font.Color));
for y := 0 to bm.Height - 1 do
begin
pixel := bm.ScanLine[y];
x := 0;
while x < bm.Width do
begin
with pixel^ do
begin
rgbReserved := (rgbRed + rgbGreen + rgbBlue) div 3;
rgbBlue := TextBlue * rgbReserved div 255;
rgbGreen := TextGreen * rgbReserved div 255;
rgbRed := TextRed * rgbReserved div 255;
end;
inc(pixel);
inc(x);
end;
end;
P := Point(0, 0);
S := Point(bm.Width, bm.Height);
bf.BlendOp := AC_SRC_OVER;
bf.BlendFlags := 0;
bf.SourceConstantAlpha := 255;
bf.AlphaFormat := AC_SRC_ALPHA;
UpdateLayeredWindow(Handle, 0, nil, #S, bm.Canvas.Handle, #P, 0, #bf, ULW_ALPHA)
finally
bm.Free;
end;
end;
How to debug this.
Enable debug DCUs in your project options, disable optimizations.
When you get out of resources error, hit "Break".
Inspect call stack :
The problem happens in CopyBitmap when calling GDICheck -> double click GDICheck to go there.
Put a breakpoint. Run the program - count how many times it takes before the error shows up and break just before you expect the error.
Have a look around for anything that might be odd. A good place to start is the bitmap itself. Your first clue should be that each time you call this method your text is creeping away up into the corner of your invisible form.
Let's check the bitmap header and see what's going on :
Looks like your bitmap dimensions are negative. I wonder how that happened. In fact, if you watch each time this is called, your bitmap is shrinking each time. In fact, it is shrinking by 16px in width and 38px in height - the size of the window frame.
Each time you are calling UpdateLayeredWindow you are resizing your form (its outside dimension) to be the size of the client area - the size without the window frame. Your new window gets a new frame and the client area shrinks.
Eventually there is nothing left and you are trying to make a bitmap with negative dimensions. You should therefore take into account the frame size when building your bitmap. Use the form width and height rather than the client size :
bm.Width := Width;
bm.height := Height;
Also, when making API calls, please get into the habit of checking the return values for errors, as described in the documentation for the function in question. If you are not checking for errors you are asking for problems.
Without your feedback this remains a guess, but passing a device context with the size of your form's client area, you reduce the size of your form with each call to UpdateLayeredWindow. When, eventually, you request a negative value for the bitmap dimensions, CreateCompatibleBitmap in the code path returns an error.
I'm building a custom menu and have been having some issues with the hover states on the links. Now, after much tinkering I've managed to get my menu rectangle responding properly to mouse hover states - Almost.
I can't for the life of me work out how to get them to revert back to normal once the mouse has left the rectangle - it remains in it's hovered state. Moving onto a different rectangle resets correctly, anywhere else on the canvas is treated as still being in last rectangle hovered over.
My MouseMove procedure.
procedure TOC_MenuPanel.MouseMove(Shift:TShiftState; X,Y:Integer);
var
i : integer;
begin
pt := Mouse.CursorPos;
pt := ScreenToClient(pt);
for i := 0 to High(MenuRects) do
begin
if PtInRect(MenuRects[i], Point(X, Y)) then
begin
chosenRect := i;
Refresh;
end
else
begin
chosenRect := -1;
end;
end;
inherited;
end;
And my paint procedure:
procedure TOC_MenuPanel.Paint;
var
// TextStyle: TTextStyle;
R, itemR: TRect;
count : Integer;
x1,y1,x2,y2 : Integer;
begin
// Set length of array
SetLength(MenuRects, fLinesText.Count);
// Set TRect to Canvas size
R := Rect(5, 5, Width-5, Height-5);
x1 := 10;
y1 := 10;
x2 := Width-10;
inherited Paint;
with Canvas do begin
// Set fonts
Font.Height := MenuFontHeight;
Font.Color := clWhite;
// Draw outerbox
GradientFill(R, clLtGray, clWhite, gdVertical);
// Draw inner boxes
if fLinesText.Count = 0 then exit
else
for count := 0 to fLinesText.Count - 1 do
begin
// Define y2
y2 := TextHeight(fLinesText.strings[count])*2;
itemR := Rect(x1, y1, x2, y2*(count+1));
Pen.color := clGray;
// Test against chosenRect value and compare mouse position against that of the rectangle
if (chosenRect = count) and (PtInRect(MenuRects[count], pt)) then
Brush.color := stateColor[bttn_on]
else
Brush.color := stateColor[bttn_off];
Rectangle(itemR);
// Push rectangle info to array
MenuRects[count] := itemR;
// Draw the text
TextRect(itemR, x1+5, y1+5, fLinesText.strings[count]);
// inc y1 for positioning the next box
y1 := y1+y2;
end;
end;
end;
The painting that you do in the mouse move event handler is immediately lost because you force a paint cycle by calling Invalidate. As a general rule, it is best to do all painting to the screen in a paint cycle. In some scenarios it can make sense to paint outside of a paint cycle, but it is notoriously hard to get right.
So, I suspect that you need to move all the drawing code into your paint routine, wherever and whatever that is. So, in the mouse move event you need to invalidate the form or paint box or whatever it is that paints the scene. Then in your paint routine you use GetCursorPos, or Mouse.Pos or similar to find the position of the cursor. And you use that to determine how to paint the scene. You may well find it more effective, in terms of flicker avoidance, to paint to an off-screen bitmap and then blit that onto the canvas.
Now, if you invalidate on every single mouse move then you might find the painting burden to be excessive. So perhaps you should keep track of the state of the most recently painted scene. Test in the mouse move handler whether or not the new state differs from the most recently painted. Only if it does differ would you force a paint cycle.
The error was in the MouseMove procedure, the following produces the correct behaviour:
procedure TOC_MenuPanel.MouseMove(Shift:TShiftState; X,Y:Integer);
var
i : integer;
begin
// Get cursor position within the control
pt := Mouse.CursorPos;
pt := ScreenToClient(pt);
// loop through Array of Rectangles
for i := 0 to High(MenuRects) do
begin
if PtInRect(MenuRects[i], Point(X, Y)) then
begin
chosenRect := i;
Break; // If statement evaluates to true, stop the loop
end
else
begin
chosenRect := -1;
end;
end;
Refresh; // Refresh the canvs
inherited;
end;
I have a Delphi DBGrid that looks normal when it first loads. I have setup an OnTitleClick event that sorts the DBGrid by the column when the title is clicked. As soon as you click on the title, the column title acts like a button being pressed and an ugly black line appears. (See Fig. 2 below)
As soon as the click event is done, the grid looks normal again.
How do you prevent this black line from appearing when you click the column title?
EDIT: QC Submitted to Embarcadero
While turning off the ability to resize columns does make the black line behavior disappear it does take away a very nice feature. I think this behavior needs to be fixed. I have submitted the following QC 98255 to Embarcadero. Please vote for this entry.
UPDATE: 2017-07-30
I found where this horizontal black line is being drawn.
Vcl.Grids > procedure TCustomGrid.DrawMove;
The Canvas.Pen.Width is set to 5. I changed it so the Canvas.Pen.Width := 1;
It looks much so much better. Now when I clicked on the "Contact_Last" title cell the black indicator line is just one pixel wide and much less intrusive.
procedure TCustomGrid.DrawMove;
var
OldPen: TPen;
Pos: Integer;
R: TRect;
begin
OldPen := TPen.Create;
try
with Canvas do
begin
OldPen.Assign(Pen);
try
Pen.Style := psDot;
Pen.Mode := pmXor;
//+----------------------------------------------------------------+
// Modified 2017-07-30 by Michael J Riley (MJR)
// Changed Pen.Width from 5 to 1
// This makes the vertical black move-indicator line 1 pixel wide
// Which is the same width as column resize vertical line
//+----------------------------------------------------------------+
//Pen.Width := 5;
Pen.Width := 1;
if FGridState = gsRowMoving then
begin
R := CellRect(0, FMovePos);
if FMovePos > FMoveIndex then
Pos := R.Bottom else
Pos := R.Top;
MoveTo(0, Pos);
LineTo(ClientWidth, Pos);
end
else
begin
R := CellRect(FMovePos, 0);
if FMovePos > FMoveIndex then
if not UseRightToLeftAlignment then
Pos := R.Right
else
Pos := R.Left
else
if not UseRightToLeftAlignment then
Pos := R.Left
else
Pos := R.Right;
MoveTo(Pos, 0);
LineTo(Pos, ClientHeight);
end;
finally
Canvas.Pen := OldPen;
end;
end;
finally
OldPen.Free;
end;
end;
The black line looks like a column order insert marker.
Try looking for an option that disables column re-ordering.