FastReport 4 and VCL Styles bugs - delphi

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.

Related

How to create a non visual component without any icon on the form?

I would like to create a non visual component (like TTimer for example) that I can drop on the form and that I can set up directly from the Object Inspector, but I don't want to see its icon on the form (it'd just obstruct anything). For example TFloatAnimation works like this but I don't understand how.
The GExperts library (http://www.gexperts.org/) has a plug-in which can toggle the visibility
of non-visual components on a form, and it is apparently not Delphi-version-specific but it is
not exactly trivial.
The method which does this is
procedure THideNonVisualCompsExpert.ToggleNonVisualVisible(Form: TCustomForm);
const
NonVisualClassName = 'TContainer';
var
VisibleState: Boolean;
FormHandle: THandle;
CompHandle: THandle;
WindowClass: string;
FirstCompFound: Boolean;
WinControl: TWinControl;
ChildControl: TWinControl;
i: Integer;
begin
Assert(Assigned(Form));
Assert(Form.Handle > 0);
FirstCompFound := False;
WinControl := Form;
if InheritsFromClass(WinControl.ClassType, 'TWinControlForm') then
begin
for i := WinControl.ComponentCount - 1 downto 0 do
begin
if WinControl.Controls[i] is TWinControl then
begin
ChildControl := WinControl.Controls[i] as TWinControl;
if InheritsFromClass(ChildControl.ClassType, 'TCustomFrame') then
begin
WinControl := ChildControl;
Break;
end;
end;
end;
end;
FormHandle := GetWindow(WinControl.Handle, GW_CHILD);
CompHandle := GetWindow(FormHandle, GW_HWNDLAST);
VisibleState := False;
GxOtaClearSelectionOnCurrentForm;
while (CompHandle <> 0) do
begin
WindowClass := GetWindowClassName(CompHandle);
if AnsiSameText(WindowClass, NonVisualClassName) then
begin
if not FirstCompFound then
begin
VisibleState := not IsWindowVisible(CompHandle);
FirstCompFound := True;
end;
if VisibleState then
ShowWindow(CompHandle, SW_SHOW)
else
ShowWindow(CompHandle, SW_HIDE);
end;
CompHandle := GetWindow(CompHandle, GW_HWNDPREV);
end;
end;
in the unit GX_HideNonVisualComps.Pas.
As written, it toggles the visibility of all the non-visual components on the
target form, but looking at the code of the ToggleNonVisualVisible method it looks like it
ought to be possible (but I have not tried) to adapt it to operate on a selected component class and
force instances of the class to a non-visible state. Once you have done that, you would probably
need to experiment with how and when to invoke the method at design-time; if I was doing it, I would probably start
with somewhere like the target component's Loaded method.
(I would feel more comfortable posting this "answer" as a comment but obviously it would be too long)
I have thought about this. A Non Visual Component does not do any painting, in a Windows environment (like the IDE) it has no Window, and therefore cannot influence how the IDE chooses to render it.
One approach would be to derive from TWinControl, making your component a Visual Component, and then to ensure that it is not drawn. Try setting the positioning properties to be non-published, and when you are parented, always set your position outside the parent window. This means that your control is always clipped and never painted.
I haven't tried this, but I can see no reason why it wouldn't work.
You can also use this approach to have an apparently non visual component that renders information in the IDE at designtime, but not at runtime.

How to display Hints on not active form

I wanna display hint just on mouse move, like in Winamp. No need to have focus on app. Thanks for help.
You can make the hint popup, but I'm not sure if you can do that if the application is not the focussed application.
This will show the hint for anything where the hint is set and ShowHint = True. But only if it is the focusseed Application. (As Sertac Akyuz said in a comment on the original post, VCL only does this for the currently active form).
procedure TForm1.ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
aPoint: TPoint;
aControl: TControl;
begin
aControl := TControl(Sender);
if aControl.ShowHint = true then
begin
aPoint.X := X;
aPoint.Y := Y;
if Assigned(aControl.Parent) then
aPoint := aControl.ClientToParent(aPoint);
aPoint := ClientToScreen(aPoint);
Application.ActivateHint(aPoint);
end;
end;
Hope this helps.
There is a way you can detect if mouse cursor position is over some controll by periodically checking mouse cursor position in relation of that controls client rectangle. You can do this using Timer and next code:
procedure TForm4.Timer1Timer(Sender: TObject);
if Panel1.ClientRect.Contains(Panel1.ScreenToClient(Mouse.CursorPos)) then
begin
Form4.Caption := 'Panel1';
end
else if Panel2.ClientRect.Contains(Panel2.ScreenToClient(Mouse.CursorPos)) then
begin
Form4.Caption := 'Panel2';
end
else if Panel3.ClientRect.Contains(Panel3.ScreenToClient(Mouse.CursorPos)) then
begin
Form4.Caption := 'Panel3';
end
else if Panel4.ClientRect.Contains(Panel4.ScreenToClient(Mouse.CursorPos)) then
begin
Form4.Caption := 'Panel4';
end
else Form4.Caption := 'None';
There is probably some better solution by iterating through your forms component list or even better creating your own specific list for this.
Now the only problem is that hint is shown only for active applications. So if you want for hints to be shown even when your application isn't active you will have to make your own hint system (Creating a small form with hint text shown).
Finally it works now. I copied VCL.Forms.pas to project directory
removed there ForegroundTaskCheck like Sertac Akyuz said
var
HintInfoMsg: TCMHintInfo;
{$ENDIF}
begin
FHintActive := False;
HintInfo.ReshowTimeout := 0;
if FShowHint and (FHintControl <> nil) {and ForegroundTaskCheck(EnumAllWindowsOnActivateHint)} and
and most important thing is to add {$B-} in VCL.Forms.pas (without it many AV and crash)
unit Vcl.Forms;
{$B-}

Assign Font From TComboBox D7

Delphi v7
Let me preface my remedial question by saying that I am not a real programer. I am a Deputy Sheriff and I write an occasional project to help us do what we do.
My current project contains several TDBRichEdit controls. I have assigned various formatting processes to toolbar buttons. I would like to be able to change the RichEdit font using a ComboBox. The combobox is populated with the font list, but it does not affect the font of the TDBRichEdit control. I have been trying to figure this out for over a week and I cannot see the problem.
This is what I have done:
Form OnCreate procedure
procedure TForm1.FormCreate(Sender: TObject);
begin
PageControl1.ActivePage:= TabSheet1;
GetFontNames;
SelectionChange(Self);
CurrText.Name := DefFontData.Name;
CurrText.Size := -MulDiv(DefFontData.Height, 72, Screen.PixelsPerInch);
end;
Form Selection Change
procedure TForm1.SelectionChange(Sender: TObject);
begin
if ActiveControl is TDBRichEdit then
with ActiveControl as
TdbRichEdit do begin
try
Ctrlupdating := True;
Size.Text := IntToStr(SelAttributes.Size);
cmbFont.Text := SelAttributes.Name;
finally
Ctrlupdating := False;
end;
end;
end;
Functions (Except for the "ActiveControl part these are not my functions and I don't have enough knowledge to completely understand them.)
Function TForm1.CurrText: TTextAttributes;
begin
if ActiveControl is TDBRichEdit then
with ActiveControl as
TdbRichEdit do begin
if SelLength > 0 then Result := SelAttributes
else Result := DefAttributes;
end;
end;
function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
FontType: Integer; Data: Pointer): Integer; stdcall;
begin
TStrings(Data).Add(LogFont.lfFaceName);
Result := 1;
end;
OnDraw event of the combobox
procedure TForm1.cmbFontDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
with (Control as TComboBox).Canvas do
begin
Font.Name := Screen.Fonts.Strings[Index];
FillRect(Rect) ;
TextOut(Rect.Left, Rect.Top, PChar(Screen.Fonts.Strings[Index]));
end;
end;
OnChange event for the combobox
procedure TForm1.cmbFontChange(Sender: TObject);
begin
if Ctrlupdating then Exit;
CurrText.Name := cmbFont.Items[cmbFont.ItemIndex];
end;
Any Ideas?
In your code you try to modify the text attributes in this code:
procedure TForm1.cmbFontChange(Sender: TObject);
begin
if Ctrlupdating then Exit;
CurrText.Name := cmbFont.Items[cmbFont.ItemIndex];
end;
When this code executes, ActiveControl will be cmbFont. Now look at CurrText.
if ActiveControl is TDBRichEdit then
with ActiveControl as TdbRichEdit do
begin
if SelLength > 0 then
Result := SelAttributes
else
Result := DefAttributes;
end;
So, the first if block will not be entered.
In fact your function appears not to assign anything to Result in this case. You must always assign to Result. The compiler will tell you this when you enable warnings and hints.
Instead of using ActiveControl you should specify the rich edit instance directly. I don't know how your form is arranged, but you'll need to use some other means to work out which rich edit control the change is to be applied to. Perhaps based on the active page of the page control.
I managed to get the combobox working. My code is probably very awkward, but it works. Thank you for your help. I would not have been able to solve this problem without it.
I wrote a separate function for each of the richedit contols. With FormCreate I had to add lines for each of the functions
procedure TForm1.FormCreate(Sender: TObject);
begin
PageControl1.ActivePage:= TabSheet1;
GetFontNames;
SelectionChange(Self);
**CurrText.Name := DefFontData.Name;
CurrText.Size := -MulDiv(DefFontData.Height, 72, Screen.PixelsPerInch);**
end;
In SelectionChange I had to make a call to the PARAGRAPH attributes of the rich edit control. I was not able to do that collectively. I addressed the rich edit control “reProc” only. The others seem to work fine with that one line. I would like to understand that one.
Form Selection Change
procedure TForm1.SelectionChange(Sender: TObject);
begin
if ActiveControl is TDBRichEdit then
with reProc.Paragraph do begin
try do begin
You gave me the idea. I was not able to address all the richedit controls collectively, so I wrote a function for each of the richedit controls separately.
function TForm1.CurrText: TTextAttributes;
begin
if reProc.SelLength > 0 then Result := reProc.SelAttributes
else Result := **reProc.DefAttributes;**
For the OnChange event for the combobox I had to add lines for each of the functions
procedure TForm1.cmbFontChange(Sender: TObject);
begin
if Ctrlupdating then Exit;
**CurrText.Name := cmbFont.Items[cmbFont.ItemIndex];**
end;

How can I get the tooltips of notification-area icons?

I can enumerate the applications (handle,pid,path) with icons in the notification area, and I can control the position of the icons, but I can't get the tooltip.
How can I enumerate systray icons including the tooltips?
The shell provides no facility for inspecting notification icons that don't belong to your program. (And it provides no way of enumerating even the icons that do belong to your program; you're expected to already know about those.)
I used to use a program that hijacked some or all of the icons and optionally displayed them in its own window instead of in the area near the clock, so it must have been able to get a list of all the icons. It was TraySaver, by Mike Lin. The source is available if you wish to see how his hack worked.
You can also take a look at the answers to a previous question that asked about controlling the position of icons in the notification area.
You should take a look at the madKernal package of madshis component collection. It has some interfaces for working with trayicons. Beware, though:
With madKernel you can manage tray icons (see API "Shell_NotifyIcon") of any application. This kind of functionality is totally undocumented, but works well from win95 to winXP.
The ITrayIcon-interface has properties for hint, icon, position and more.
Here is my method tested with windows xp and delphi 2010 if you are using a version of delphi wich doesn't support unicode make shure you convert the strings read to ansi
uses CommCtrl;
function TForm1.GetIconsCount: Integer;
begin
Result := SendMessage(FindTrayToolbar, TB_BUTTONCOUNT, 0, 0);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ListTips;
end;
function TForm1.FindTrayToolbar: HWND;
begin
Result := FindWindow('Shell_TrayWND', nil);
Result := FindWindowEx(Result, 0, 'TrayNotifyWnd', nil);
Result := FindWindowEx(Result, 0, 'SysPager', nil);
Result := FindWindowEx(Result, 0, 'ToolbarWindow32', nil);
end;
procedure TForm1.ListTips;
var
dwTray: DWORD;
wndTray: HWND;
hTray: THandle;
remoteTray: Pointer;
tdata: TTBBUTTON;
i: Integer;
btsread:DWORD;
str:Pchar;
begin
wndTray := FindTrayToolbar;
GetWindowThreadProcessId(wndTray, #dwTray);
hTray := OpenProcess(PROCESS_ALL_ACCESS, false, dwTray);
if hTray <> 0 then
begin
remoteTray := VirtualAllocEx(hTray, nil, Sizeof(tdata), MEM_COMMIT,
PAGE_READWRITE);
for i := 0 to GetIconsCount - 1 do
begin
SendMessage(FindTrayToolbar,TB_GETBUTTON,wparam(i),lparam(remotetray));
ReadProcessMemory(hTray,remotetray,#tdata,sizeof(tdata),btsread);
GetMem(str,255);
ReadProcessMemory(hTray,Ptr(tdata.iString),str,255,btsread);
ListBox1.Items.Add(str);
end;
end
else ShowMessage('Could not locate tray icons');
end;
end.

Windows thumbnail/frame view

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...

Resources