I have a TChart (Steema TeeChart included in Delphi IDE) component which may have up to 64 Chart Series (Stacked Area in my case). I need to display all existent series in chart, but Legend, unfortunately, doesn't show all of existing series, only some firsts of them 10-16 (see picture).
Is it possible somehow to Scroll Legend for viewing all existing series?
If not directly maybe some workaround?
used Delphi7, Chart v4
Here is my own implementation, based on TChart.OnMouseWheel event, simulating Legend scrolling (it is scrolled, but without any scroll bar - maybe it will be task for future):
procedure TForm1.Chart1MouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
function GetChartActiveSeriesCount(aChart: TChart): Integer;
var
iIdx: Integer;
begin
Result := 0;
for iIdx := 0 to aChart.SeriesCount-1 do
begin
if aChart.Series[iIdx].Active = True then
Inc(Result);
end;
end;
var
lCliMousePos: TPoint;
lActiveCount: Integer;
lChart: TChart;
begin
lChart := TChart(Sender);
lCliMousePos := lChart.ScreenToClient(MousePos);
if PtInRect(lChart.Legend.RectLegend, lCliMousePos) then
begin
if WheelDelta > 0 then
begin
if lChart.Legend.FirstValue > 0 then
lChart.Legend.FirstValue := lChart.Legend.FirstValue-1;
end
else
begin
lActiveCount := GetChartActiveSeriesCount(lChart);
if (lChart.Legend.FirstValue + lChart.Legend.NumRows) < lActiveCount then
lChart.Legend.FirstValue := lChart.Legend.FirstValue+1;
end;
end;
Handled := True;
end;
Also there are some tricks how to trigger TChart.OnMouseWheel event, because Tchart cannot get focus it is needed to play with Main Form OnMouseWheel event or WM_MOUSEWHEEL windows message. HowTos here:
http://delphi.about.com/od/delphitips2010/qt/delphi-redirect-mouse-wheel-control-under-the-mouse.htm or here: http://delphi.about.com/od/delphitips2010/qt/timage-handling-mouse-wheel-messages.htm
This is only possible with the Professional edition of TeeChart. It includes the Legend ScrollBar tool (TLegendScrollBar) for this purpose. Fully functional evaluation versions can be downloaded here.
Related
Some background info. I work at a very small company who has recently upgraded Delphi from version 6 (!!!) to Rad Studio XE5 and things have certainly changed a lot in 10+ years. Most things seems to have been improved in the IDE and framework, but we're having big problems with the new VCL Styles feature. It's just very buggy and not up to par with the quality we were used to from Borland back in the day. We have done lots of tweaks and work arounds to get things working but one issue is really bugging me at the moment and it has to do with the preview form in FastReport 4.
The toolbar gets a white border around it.
Controls in the print dialog and others are misaligned or wrongly positioned
We really want to use VCL Styles to give our software a new fresh look, so we hope there is a solution to these problems.
Steps to reproduce the issues:
Create a new VCL Forms Application
Check a VCL Style in Project > Options > Application > Appearance, e.g. Sapphire Kamri.
Add a TfrxReport report Component to the form
Double click the component frxReport1 and add a Page Header band just to have some content
Add a TButton and in OnClick event, call frxReport1.ShowReport();
Run the program and click on the button. In the preview form you now see that the toolbar is surrounded by a white border which looks weird.
Click the leftmost print button to bring up the print dialog and you can see how the group boxes and cancel button is positioned outside of the client area.
Do you have any solutions or suggestions to solve the issues?
Edit: RRUZ gave a good answer, but there were some side effects to his solution to problem #1 so I decided to simplify the code and just paint the border around the toolbar manually. Like this:
procedure TToolBarStyleHookEx.PaintNC(Canvas: TCanvas);
begin
if TToolBar(Control).BorderWidth>0 then
begin
Canvas.Pen.Width := 4;
Canvas.Pen.Color := StyleServices.GetStyleColor(scWindow);
Canvas.Brush.Style := bsClear;
Canvas.Rectangle(2,2,Control.Width-2,Control.Height-1);
end;
inherited;
end;
Effectively both issues it seems VCL Styles bugs.
1) Q: The toolbar gets a white border around it.
A: The TToolBarStyleHook Style hook in not handling the BorderWidth property. so you must create a new style hook and override the PaintNC to overcome this issue.
type
TToolBarStyleHookEx = class(TToolBarStyleHook)
protected
procedure PaintNC(Canvas: TCanvas); override;
end;
{ TToolBarStyleHookEx }
procedure TToolBarStyleHookEx.PaintNC(Canvas: TCanvas);
var
Details: TThemedElementDetails;
LStyle: TCustomStyleServices;
R: TRect;
begin
if TToolBar(Control).BorderWidth>0 then
begin
LStyle := StyleServices;
R := Rect(0, 0, Control.Width, Control.Height);
Details.Element := teToolBar;
Details.Part := 0;
Details.State := 0;
if LStyle.HasTransparentParts(Details) then
LStyle.DrawParentBackground(Handle, Canvas.Handle, Details, False);
LStyle.DrawElement(Canvas.Handle, Details, R);
end;
inherited;
end;
and register like so
initialization
TCustomStyleEngine.RegisterStyleHook(TToolBar, TToolBarStyleHookEx);
2) Q : Controls in the print dialog and others are misaligned or wrongly positioned
A: It seems a issue related with the TFormStyleHook, you had 3 alternatives.
1) you can edit the frxPrintDialog unit and increase the width of the form.
2) you can patch the form style hook.
3) You can change the width of the print dialog in run-time.
Check this code which changes the width of the dialog in run-time using a HCBT_ACTIVATE hook
var
hhk: HHOOK;
function CBT_FUNC(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
const
ClassNameBufferSize = 1024;
var
hWindow: HWND;
RetVal : Integer;
ClassNameBuffer: Array[0..ClassNameBufferSize-1] of Char;
i : integer;
begin
Result := CallNextHookEx(hhk, nCode, wParam, lParam);
if nCode<0 then exit;
case nCode of
HCBT_ACTIVATE:
begin
hWindow := HWND(wParam);
if (hWindow>0) then
begin
RetVal := GetClassName(wParam, ClassNameBuffer, SizeOf(ClassNameBuffer));
if (RetVal>0) and SameText(ClassNameBuffer, 'TfrxPrintDialog') then
for i:= 0 to Screen.FormCount-1 do
if (SameText(Screen.Forms[i].ClassName, 'TfrxPrintDialog')) and (Screen.Forms[i].Width<=563) then
Screen.Forms[i].Width:=Screen.Forms[i].Width+8;
end;
end;
end;
end;
Procedure InitHook();
var
dwThreadID : DWORD;
begin
dwThreadID := GetCurrentThreadId;
hhk := SetWindowsHookEx(WH_CBT, #CBT_FUNC, hInstance, dwThreadID);
if hhk=0 then RaiseLastOSError;
end;
Procedure KillHook();
begin
if (hhk <> 0) then
UnhookWindowsHookEx(hhk);
end;
initialization
InitHook();
finalization
KillHook();
After of apply both fixes this will be the result
Note: please report these issues to the QC page of Embarcadero.
I have a DBChart with four PieSeries on it. Each chart has multiple slices, and is multicolored. I'd like to have the title of each series written either on it or beneath it, instead of the legend. Is there any easy way to accomplish this? I'm using TeeChart Standard v2011.03.32815 VCL
The Pro version includes the Annotation tool that would be useful here.
With the Standard version, you could just have 4 TDBCharts as mentioned in a comment above, or you could also draw manually your texts on the canvas. Ie:
procedure TForm1.FormCreate(Sender: TObject);
var i: Integer;
begin
for i:=0 to 3 do
with Chart1.AddSeries(TPieSeries) as TPieSeries do
begin
FillSampleValues;
end;
end;
procedure TForm1.Chart1AfterDraw(Sender: TObject);
var i, tmpX, tmpY: Integer;
tmpStr1, tmpStr2: string;
begin
tmpStr1:='My Pie nº';
for i:=0 to Chart1.SeriesCount-1 do
begin
tmpStr2:=tmpStr1+IntToStr(i+1);
with (Chart1[i] as TPieSeries), Chart1.Canvas do
begin
tmpX:=CircleXCenter-(TextWidth(tmpStr2) div 2);
if (i<2) then
tmpY:=CircleRect.Top-20
else
tmpY:=CircleRect.Bottom+10;
TextOut(tmpX, tmpY, tmpStr2);
end;
end;
end;
I am requiring a Memo with Auto-completion functionality.
Ultimately, I would like the ability to display a custom auto-completion list when the user presses a hotkey (Ctrl-space) similar to Delphi IDE auto-completion.
I have the TMS AdvMemo, but to be honest the help for this particular component is lacking. It appears the AdvMemo supports custom auto completion, but I cant seem to find out how to display a list.
So, if anyone has any suggestions to achieve auto completion on a memo, or to enlighten me as the use of the AdvMemo, it would be appreciated
I decided to write some handlers for a TMemo using a TPopupmenu as the autocomplete list.
For those that read this please refer to my other post:
Delphi - Get the whole word where the caret is in a memo (thanks to RRUZ)
And the following code:
OnPopup for the AutoComplete TPopupMenu: (memoAutoComplete hold the list of autocomplete items)
procedure AutoCompletePopup(Sender: TObject);
var i : integer;
NewItem : TMenuItem;
AutoCompleteToken: String;
begin
//filter list by token
AutoCompleteToken := SelectWordUnderCaret(edtComment);
AutoComplete.Items.Clear;
for i:=0 to memoAutoComplete.Lines.Count -1 do
begin
if SameText(LeftStr(memoAutoComplete.Lines.Strings[i],Length(AutoCompleteToken)),AutoCompleteToken) then
begin
NewItem := TMenuItem.Create(AutoComplete);
NewItem.Caption := memoAutoComplete.Lines.Strings[i];
NewItem.OnClick := AutoComplete1Click;
NewItem.OnMeasureItem := AutoComplete1MeasureItem;
NewItem.OnAdvancedDrawItem := AutoComplete1AdvancedDrawItem;
AutoComplete.Items.Add(NewItem);
end;
end;
end;
And for the Tmemo:
procedure Memo1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var pt : TPoint;
begin
if (Key = VK_SPACE) and (GetKeyState(VK_CONTROL) < 0) then
begin
pt := Memo1.ClientToScreen(Point(0,Memo1.Height));
AutoComplete.Popup(pt.X,pt.Y);
end;
end;
You can have a look at SynEdit. It's free, open source and has an active community to help you out when you get stuck.
What would be the easiest way to make a thumbnail view, where you have a panel with a vertical scroll bar, and a matrix of images describing their associated image? I'd also like it such that if the parent frame resized horizontally, the matrix would shrink to as many columns as necessary to display the thumbnails without a horizontal scroll bar. I'd like to be able to drag and rearrange these thumbnails as well. The toolkit that this is written in doesn't really matter so much. If you know of a good way to do it with MFC, that's cool, Delphi/C++ builder is totally cool too. Just some kind of native app framework.
Wow this is sounding a lot like I'm begging for homework help. I swear this is for some software to drive a laser projector.
Take a look at TMS AdvSmoothImageListBox:
AFAIK, Registered Delphi customers can download TMS Smooth Components for free from Embarcadero website. If you are not a registered Delphi user, then you can buy the collection from TMS website.
Here is excerpted code I use to display of a collection of a variable numImages number of webcams.
const MaxImages = 24;
type
TForm1 = class(TForm)
...
images: array[1..MaxImages] of TWebcamImage;
numImages: integer;
....
end;
TWebCamImage is a descendant of TImage with some additional attributes like the origin url of the webcam, the filename for the saved picture, and a handler for the double click to open the picture in a secondary panel.
Here is the code used to arrange the images in a panel.
procedure TForm1.ArrangeImages;
var i, numh, numv : integer;
const margin=2;
begin
case numImages of
1: begin numh:=1; numv:=1; end;
2: begin numh:=2; numv:=1; end;
3: begin numh:=3; numv:=1; end;
4: begin numh:=2; numv:=2; end;
5,6: begin numh:=3; numv:=2; end;
7,8: begin numh:=4; numv:=2; end;
9: begin numh:=3; numv:=3; end;
10: begin numh:=5; numv:=2; end;
11,12: begin numh:=4; numv:=3; end;
13,14,15: begin numh:=5; numv:=3; end;
16: begin numh:=4; numv:=4; end;
17,18,19,20: begin numh:=5; numv:=4; end;
else begin numh:=6; numv:=4; end;
end;
for i:=1 to numImages do
begin
images[i].Width := (panel2.Width div numh) - margin * 2;
images[i].Height := (panel2.Height div numv) - margin * 2;
images[i].Top := (((i-1) div numh) * (panel2.Height div numv)) + margin;
images[i].Left := (((i-1) mod numh) * (panel2.Width div numh)) + margin;
end;
end;
this method is called in the initialization of the form, hooked in the oncreate event and the onresize event.
procedure TForm1.FormCreate(Sender: TObject);
begin
...
numImages:=0;
for i:=1 to maxImages do
begin
imageURL:=ini.ReadString('images','imageURL'+intToStr(i),imageURLDefault);
if imageURL<>'' then
begin
inc(numimages);
images[numImages]:=TWebCamImage.create(self,panel2,imageURL);
end;
....
end;
....
ArrangeImages;
....
end;
procedure TForm1.FormResize(Sender: TObject);
begin
ArrangeImages;
end;
I'm not quite sure I understand you right, but I would have started with a frame holding the image and it's description. I would then use a TFlowPanel to hold instantiations of the frame. There shouldn't be to much work to implement drag and drop, I think. Never tried, though.
If there is a lot images, you should go for a ownerdraw and doublebuffered solution, I think.
In the end, you should just drop in the laser projection component and hook it up to the laser projector steering unit...
I want a TPageControl and some TTabSheets, with 'per tabsheet' tooltip hints visible as I hover over each tab in turn.
Is there any way of getting this effect in Delphi 2009?
Just hook the Page Control's Mouse Move event and use the TabAtPos property to determine which tab the mouse is hovering over. Then assign that tab's Hint to the Page Control's hint property.
procedure TForm.PageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: integer);
var
tabindex: integer;
begin
tabindex := PageControl.IndexOfTabAt(X, Y);
if (tabindex >= 0) and (PageControl.Hint <> PageControl.Pages[tabindex].Hint) then
begin
Application.CancelHint;
PageControl.Hint := PageControl.Pages[tabindex].Hint;
PageControl.ShowHint := true;
end;
end;
CancelHint/ShowHint will take care of updating the hint window when mouse moves directly from one tab to another.
Improved but ugly version below also temporarily changes HintPause to 0 when mouse is moved directly from tab to tab so that the hint is redisplayed immediately. (The "ugly" part of the solution goes to the Application.ProcessMessages call which forces hint messages to be processed before HintPause is restored.)
procedure TForm.PagesMouseMove(Sender: TObject; Shift: TShiftState; X, Y: integer);
var
hintPause: integer;
tabindex: integer;
begin
tabindex := PageControl.IndexOfTabAt(X, Y);
if (tabindex >= 0) and (PageControl.Hint <> PageControl.Pages[tabindex].Hint) then
begin
hintPause := Application.HintPause;
try
if PageControl.Hint <> '' then
Application.HintPause := 0;
Application.CancelHint;
PageControl.Hint := PageControl.Pages[tabindex].Hint;
PageControl.ShowHint := true;
Application.ProcessMessages; // force hint to appear
finally Application.HintPause := hintPause; end;
end;
end;
To hide the hint on the main page body, assign the following method to the page control's OnMouseLeave event.
procedure TForm.PageMouseLeave(Sender: TObject);
begin
PageControl.Hint := '';
PageControl.ShowHint := false;
end;
In Raize Components, this can be accomplished by setting the trzpagecontrol.tabhints property to true. Good components can save you a lot of time (therefore money).
(just a happy customer, btw)
Update (in response to comment from #Rigel) from raize.com FAQ (Raize Components tab):
What happened to Raize Components?
Back in 2015 Embarcadero acquired Raize Components from us and
rebranded the product as the Konopka Signature VCL Controls (KSVC).
Initially they sold the product separately, but for the past several
releases of RAD Studio, the components have been available for free
through the GetIt Package Manager. Simply open the GetIt Package
Manager from the Delphi or C++Builder Tools menu and search for
“Konopka” to locate the installer. The component names, units, and
packages are the same as they were in Raize Components, just the
product name is different.
1 - fill in the .Hint property, and set the .ShowHint property to True for the PageControl (assuming each tabsheet has ParentShowHint set to true; otherwise you'll have to set each page individually).
2 - Assign this event to the PageControl's OnChange event handler:
procedure TForm1.PageControl1Change(Sender: TObject);
begin
PageControl1.Hint := PageControl1.ActivePage.Hint;
end;
After you do that, the hint will be whatever the active tab is. I am not sure how to make it change the hint based on where the mouse is hovering - that's an interesting phenomenon I've never noticed before, actually.
On the tPageControl.OnMouseMove find TabIndex by Pgctrl.IndexOfTabAt( X, Y ) and assign TabSheet hint to the tPageControl hint
Look here:
http://www.delphigroups.info/2/9/321680.html
Originally working on a C++ Builder 6 (!) project (so please forgive any typo in this transcript), I started with the answer of Gerard[1] and reduced the code as much as possible. To better control the calls of Application.CancelHint, I introduced the member FLastHintTabIndex, it must be initialized with -1.
procedure TForm1.PageControl1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var
TabIndex: Integer;
begin
TabIndex := PageControl1.IndexOfTabAt(X, Y);
if FLastHintTabIndex <> TabIndex then
Application.CancelHint;
if TabIndex <> -1 then
PageControl1.Hint = PageControl1.Pages[TabIndex].Hint;
FLastHintTabIndex := TabIndex;
end;
[1]
my answer doesn't contain much new, but I find all that code and text too distracting.