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...
Related
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.
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 need to capture screen shot without background picture (wallpaper). I can try to disable wallpaper, take screen shot and then enable it back, but:
At moment i don't know how to disable/restore wallpaper (in simple case it is picture file assigned as desktop with some tiling options, but can it be in modern versions of Windows something different?).
If user kills application before i switch wallpaper back, then wallpaper remain disabled and it is not good.
Does anyone know solution or ideas where to search for solution ?
Maybe it is possible to disable wallpaper temporarily ?
Update: Screen shot is part of registering bug procedure, so i need all potentially usefull information (visible forms, taskbar, ...) and it is highly desired to keep screen shot in lossless format (more readable, faster compression). One of the options is capturing of shots to store them as AVI, so processing time is also important. Background makes images much larger, that is the only reason why i am trying to remove it. I can use some algorithms for decreasing of used colors, it highly improves compression ratio, but it is time consuming procedures. So best of all it would be to remove background picture at all.
Update 2: For generating of AVI from sequence of shots i use unit from François PIETTE (based on this article):
Avi := TAviFromBitmaps.CreateAviFile(
nil,
AviFilename,
MKFOURCC('S', 'C', 'L', 'S'), // msu-sc-codec
2, 1); // 2 frames per second
// called by timer
procedure TfrmSnapshot.RecordFrame;
begin
TakeSnapshot; // get snap shot to BMP:TBitmap
Avi.AppendNewFrame(Bmp.Handle);
end;
So if i will able to delete background from snap shot, AVI compression will be improved also.
The part of final code i use:
TAppRects = class
protected
FMonitor: TMonitor;
FRects: TList<TRect>;
function GetRegion(AArea: TRect): HRGN;
public
constructor Create(AMonitor: TMonitor);
destructor Destroy; override;
// fill all Area which is not covered by Rects (application forms)
procedure FillBackground(ABmp: TBitmap; AArea: TRect);
property Rects: TList<TRect> read FRects;
property Monitor: TMonitor read FMonitor;
end;
// Check for WS_EX_APPWINDOW will hide start button menu/popup menus outside of
// the forms etc, but it makes final AVI much smaller (and usually it is anough
// to have main forms recorded).
function EnumWindowsProc(hwnd: HWND; lParam: LPARAM): BOOL; stdcall;
var
r: TRect;
begin
Result := True;
if IsWindowVisible(hwnd) and
(GetWindow(hwnd, GW_OWNER)=0) and // is not owned by another window
(GetWindowLongPtr(hwnd, GWL_STYLE) and WS_EX_APPWINDOW<>0) and // is app
GetWindowRect(hwnd, r) and
(r.Width>0) and (r.Height>0)
then
with TAppRects(lParam) do
if (FMonitor=nil) or
(FMonitor.Handle=0) or
(FMonitor.Handle=MonitorFromWindow(hwnd, MONITOR_DEFAULTTONEAREST))
then
FRects.Add(r);
end;
{ TAppRects }
constructor TAppRects.Create(AMonitor: TMonitor);
begin
FMonitor := AMonitor;
FRects := TList<TRect>.Create;
EnumWindows(#EnumWindowsProc, NativeInt(self));
end;
destructor TAppRects.Destroy;
begin
FreeAndNil(FRects);
end;
function TAppRects.GetRegion(AArea: TRect): HRGN;
var
c: array of integer;
p: array of TPoint;
i: Integer;
begin
setlength(c, FRects.Count);
setlength(p, FRects.Count*4);
for i := 0 to FRects.Count-1 do
begin
c[i] := 4;
with FRects[i] do
begin
p[i*4 ] := Point(Left,Top);
p[i*4+1] := Point(Right,Top);
p[i*4+2] := Point(Right,Bottom);
p[i*4+3] := Point(Left,Bottom);
end;
end;
result := CreatePolyPolygonRgn(p[0], c[0], length(c), WINDING);
end;
procedure TAppRects.FillBackground(ABmp: TBitmap; AArea: TRect);
var
h1,h2,h3: HRGN;
begin
h1 := 0;
h2 := 0;
h3 := 0;
try
h1 := GetRegion(AArea);
if h1=0 then
exit;
h2 := CreateRectRgn(AArea.Left,AArea.Top,AArea.Right,AArea.Bottom);
h3 := CreateRectRgn(AArea.Left,AArea.Top,AArea.Right,AArea.Bottom);
if (h2<>0) and (h3<>0) and
not (CombineRgn(h3, h2,h1, RGN_DIFF) in [NULLREGION,RGN_ERROR])
then
FillRgn(ABmp.Canvas.Handle, h3, ABmp.Canvas.Brush.Handle);
finally
if h1<>0 then DeleteObject(h1);
if h2<>0 then DeleteObject(h2);
if h3<>0 then DeleteObject(h3);
end;
end;
procedure RemoveBackground(ASnapshot: TBitmap; AMonitor: TMonitor);
var
e: TAppRects;
c: TColor;
begin
e := nil;
try
e := TAppRects.Create(AMonitor);
c := ASnapshot.Canvas.Brush.Color;
ASnapshot.Canvas.Brush.Color := $FEA249; // kind of blue (~default for win8)
e.FillBackground(ASnapshot, e.Monitor.WorkareaRect);
ASnapshot.Canvas.Brush.Color := c;
finally
e.free;
end;
end;
Disabling the wallpaper is going to cause an annoying flicker/redraw. I expect, anyway.
It would be cleaner to enumerate all of the windows on the desktop that are visible, find their dimensions/position, and then determine the area outside of all of those rectangles. Make that area invisible. i.e. white, to save paper when printing, or another color to suit your purpose. This answer is just to describe the general approach, but I think it's the way to go, unless some magic "silver bullet" appears.
There is an easy way to do this:
Take a copy of the current background picture and put this into a 2d array*.
Take a screen shot and put it in a 2d array*.
XOR the contents of both arrays.
*) or manipulate the bitmaps as if they're arrays.
Make sure both bitmaps are the same color depth.
All pixels that are the same will show as black.
Now put the outcome of your manipulation into a mask; mask the screenshot, compress it with PNG and send.
Will produce code when I'm away from the iPad.
I want to allow a form to be sized by the user with its controls proportionaly resized. ScaleBy( N,M ) works fine for me but there are of course cumulative rounding errors if it is repeated. To counter this I simply wish to precede ScaleBy() with a call to recreate the form in its default appearance and size and then call ScaleBy with various values. I know I can do this by hosting my form within a panel (and disposing / recreating it) but is there a call that will reset the form after use of ScaleBy()?
Edit - I am using Delphi XE2 and would also be interested in anyone's success with a component or other code (paid or free) to scale a form neatly - my own downloads have not produced a working solution.
Try EasySize (TFormResizer) component.
The TFormResizer component resizes all of the controls on a form (or panel) when the form size changes.
I used it successfully years ago - works with D5/7. You might need to make small adjustments for XE2 (I do not have XE2, so I cant test it).
Usage:
uses
..., Easysize;
type
TForm1 = class(TForm)
...
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
private
FR: TFormResizer;
end;
...
procedure TForm1.FormCreate(Sender: TObject);
begin
FR := TFormResizer.Create(Self);
FR.ResizeFonts := True;
FR.InitializeForm;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
FR.ResizeAll;
end;
end.
One solution would be to use the Components property of the form interate over all the child controls of a form and reset them back to their original value.
The following article has example code: http://delphi.about.com/od/adptips2005/qt/storecontrolpos.htm
This is for a slightly different purpose, but it shouldn't be to hard to modify the code to your needs.
First, adjust the scale to the original scale, then scale to new scale. For example, to scale a form in a OnResize event:
...
private
FDesignHeight: Integer;
FDesignWidth: Integer;
FPrevWidth: Integer;
end;
...
procedure TForm1.FormShow(Sender: TObject);
begin
FDesignHeight := Height;
FDesignWidth := Width;
FPrevWidth := Width;
Scaled := True;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
if Scaled then
begin
DisableAlign;
ScaleBy(FDesignWidth, FPrevWidth);
ScaleBy(Width, FDesignWidth);
EnableAlign;
end;
FPrevWidth := Width;
end;
procedure TForm1.FormCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
begin
NewHeight := Round(NewWidth * FDesignHeight / FDesignWidth);
end;
This works fine for me. To solve rounding problems, I start with a base value of 100000;
Using a TSpinEdit with default value of '100' and steps of 10(%):
OnShow: OldScaleValue := 100000;
procedure TLogForm.SpinEdit1Change(Sender: TObject);
begin
DisableAlign;
try
Log('Org Width='+Width.ToString);
Scaleby(100000, OldScaleValue);
OldScaleValue := SpinEdit1.Value*1000;
Scaleby(OldScaleValue, 100000);
Log('NEW Width='+Width.ToString);
finally
EnableAlign;
end;
end;
This steps forward and backward with 10% increase / decrease without rounding issues.
I have a form without caption, using on double click to maximize : Code looks like this:
procedure xxxxxx;
begin
if Form1.WindowState=wsNormal then
begin
Form1.WindowState:=wsMaximized;
Form1.SetBounds(0,0,screen.Width,screen.Height-getHeightOfTaskBar);
end
else
begin
Form1.WindowState:=wsNormal;
end;
ShowTrayWindow;
end;
function getHeightOfTaskBar : integer;
var hTaskBar:HWND;
rect : TRect;
begin
hTaskbar := FindWindow('Shell_TrayWnd', Nil );
if hTaskBar<>0 then
GetWindowRect(hTaskBar, rect);
Result:=rect.bottom - rect.top;
end;
This works good, except that I have to figure out where is task bar to reset SetBounds ...
What is the correct way to do this?
Thanks.
Sounds okay but like Drejc pointed out, the taskbar can appear anywhere, so too could additional docked sidebars like Google Desktop, Winamp, etc.
Instead perhaps use something like Screen.WorkAreaRect to get the client area of the screen. E.g.
with Screen.WorkAreaRect do
Form1.SetBounds(Left, Top, Right - Left, Bottom - Top);
One additional hint. The task bar can also be located on the right or the left of the screen (not only top and bottom). So you must additionally figure out where the task bar is.
I would suggest you look into the Delphi implementation of SetWidnowState. In Delphi7 it is this part of the code:
procedure TCustomForm.SetWindowState(Value: TWindowState);
const
ShowCommands: array[TWindowState] of Integer =
(SW_SHOWNORMAL, SW_MINIMIZE, SW_SHOWMAXIMIZED);
begin
if FWindowState <> Value then
begin
FWindowState := Value;
if not (csDesigning in ComponentState) and Showing then
ShowWindow(Handle, ShowCommands[Value]);
end;
end;
The ShowWindow is a Win32 library call:
function ShowWindow; external user32 name 'ShowWindow';
where user32 = 'user32.dll'; if I'm not mistaking.
So dig into this library, maybe there is some info of TaskBar somewhere.