Well I have an issue with DBGrid vertical scrolling. When I scroll it vertically with mousewheel or vertical scrollbar it moves selected row up and down. I want to make it scroll not selected row but entire grid. Just like it works in Microsoft Excel for example (just to let you know what I mean). Any suggestions?
Well, almost what I'd like to see. Found the post of hanuleye on swissdelhicenter.ch. This code let's you freely scroll DBGrid with mouse wheel.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, DBGrids, DB, DBTables;
type
TForm1 = class(TForm)
DataSource1: TDataSource;
Table1: TTable;
DBGrid1: TDBGrid;
procedure FormCreate(Sender: TObject);
procedure DBGridMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
TWheelDBGrid = class(TDBGrid)
public
property OnMouseWheel;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
TWheelDBGrid(DBGrid1).OnMouseWheel := DBGridMouseWheel;
end;
function GetNumScrollLines: Integer;
begin
SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, #Result, 0);
end;
procedure TForm1.DBGridMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
Direction: Shortint;
begin
Direction := 1;
if WheelDelta = 0 then
Exit
else if WheelDelta > 0 then
Direction := -1;
with TDBGrid(Sender) do
begin
if Assigned(DataSource) and Assigned(DataSource.DataSet) then
DataSource.DataSet.MoveBy(Direction * GetNumScrollLines);
Invalidate;
end;
end;
end.
I don't think that's possible, since to me it seems that scrollbar on DBGrids are more like a progress indicator rather than a scroll. It behaves differently from the scrolls in ListViews where you scroll "pages", in the db controls even if you move up or down a single row the scrollbar changes to reflect the "current row"/"total rows" fraction
Related
I need to disable scrolling of items with mouse wheel for all combo components on the form.
Best of all is to have more or less general solution, because design of the form may change, it would be nice if new combo components will be ignored without any additional work with sourcecode.
I have two types of combo: TComboBox and TcxComboBox (from DevExpress ExpressBars Suit).
I tried to go this way:
procedure TSomeForm.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
var Handled: Boolean);
begin
if (Screen.ActiveControl is TComboBox) or (Screen.ActiveControl is TcxComboBox) then
Handled := True;
end;
It works fine for TComboBox, but this event handler never triggered when TcxComboBox has focus.
I tried to catch corresponding messages on the level of the form like this:
procedure TSomeForm.WndProc(var m: TMessage);
begin
if (m.Msg = WM_VSCROLL) or (m.Msg = WM_HSCROLL) or (m.msg = WM_Mousewheel) then
m.Msg := 0;
inherited;
end;
But such messages never come to this handler.
I tried to directly disable mouse wheel handling for TcxComboBox, because it has such property:
procedure TSomeForm.FormCreate(Sender: TObject);
begin
cxComboBox1.Properties.UseMouseWheel := False;
end;
But it doesn't work, it is still possible to scroll items with mouse wheel. I posted support ticket for this issue, but even if they fix it in next release i need some solution now.
Any ideas, maybe someone solved it somehow ?
Instead of hooking on the form you might inherit own components or use interposer classes overriding DoMouseWheel. You might bind the handling on an additional property.
type
TcxComboBox = Class(cxDropDownEdit.TcxComboBox)
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
private
FUseMouseWheel: Boolean;
public
Property UseMouseWheel: Boolean Read FUseMouseWheel Write FUseMouseWheel;
End;
TComboBox = Class(Vcl.StdCtrls.TComboBox)
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
private
FUseMouseWheel: Boolean;
public
Property UseMouseWheel: Boolean Read FUseMouseWheel Write FUseMouseWheel;
End;
TForm3 = class(TForm)
ComboBox1: TComboBox;
cxComboBox1: TcxComboBox;
cxComboBox2: TcxComboBox;
procedure FormCreate(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form3: TForm3;
implementation
{$R *.dfm}
{ TComboBox }
function TComboBox.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean;
begin
if FUseMouseWheel then inherited
else Result := true;
end;
{ TcxComboBox }
function TcxComboBox.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean;
begin
if FUseMouseWheel then inherited
else Result := true;
end;
procedure TForm3.FormCreate(Sender: TObject);
begin
cxComboBox2.UseMouseWheel := true;
end;
How to write a custom event that fires when DBGrid.SelectedRows.Count changes?
I need this events to conditionally show/hide a panel when the selected rows in a DBGrid are [zero | one] or more than one.
Since now I'm using the following code, but IMO coding a custom event is more appropriate here:
TForm3.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; Field: TField; State: DBGridDrawState);
begin
Panel1.Visible := TDBGrid(Sender).SelectedRows.Count > 1;
end;
To catch all events changing the internal Bookmarklist yoe will have to override
LinkActive
KeyDown
MouseDown
above example just as interposer class, could be changed to a new component.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids, DBGrids, DB, ADODB;
type
TDBGrid=Class(DBGrids.TDBGrid)
private
FOnSelectionChanged: TNotifyEvent;
procedure LinkActive(Value: Boolean); override;
procedure KeyDown(var Key: Word; Shift: TShiftState);override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
published
published
property OnSelectionChanged:TNotifyEvent read FOnSelectionChanged write FOnSelectionChanged;
End;
TForm1 = class(TForm)
ADODataSet1: TADODataSet;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
Button1: TButton;
procedure MyOnSelectionChanged(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
uses unit3;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
AdoDataset1.Active := Not AdoDataset1.Active;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
DBGrid1.OnSelectionChanged := MyOnSelectionChanged;
end;
procedure TForm1.MyOnSelectionChanged(Sender: TObject);
begin
Caption := IntToStr(TDBGrid(Sender).SelectedRows.Count);
end;
{ TDBGrid }
procedure TDBGrid.KeyDown(var Key: Word; Shift: TShiftState);
begin
inherited;
if Assigned(FOnSelectionChanged) then FOnSelectionChanged(self);
end;
procedure TDBGrid.LinkActive(Value: Boolean);
begin
inherited;
if Assigned(FOnSelectionChanged) then FOnSelectionChanged(self);
end;
procedure TDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited;
if Assigned(FOnSelectionChanged) then FOnSelectionChanged(self);
end;
end.
I would like to get some hints on working with TeeChart TAreaSeries, and specifically on creating NOT overlapping series.
When I create two Area series on the same plot, related to the same BottomAxis and LeftAxis I get something like this:
https://skydrive.live.com/redir?resid=9966BBBE2447AA89!116&authkey=!AKm6DMvrxleX5ps
And if I scroll the plot vertically I will see these two series expanding downwards endlessly to the negative infinity (Y coordinate).
But I wonder if it is possible to 'cut' the lower part of the series at some Y point?
So that I could retrieve something like this:
https://skydrive.live.com/redir?resid=9966BBBE2447AA89!115&authkey=!AGaejDREPKnPYMY
(Excuse me for the links instead of images, I don't have permission to post them due to the reputation restrictions)
Yes, you can do something as in the All Features\Welcome!\Axes\Opaque zones example at the new features demo, available at TeeChart's program group, for example:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, TeeGDIPlus, TeEngine, Series, ExtCtrls, TeeProcs, Chart;
type
TForm1 = class(TForm)
Chart1: TChart;
Series1: TAreaSeries;
Series2: TAreaSeries;
procedure FormCreate(Sender: TObject);
procedure Series1Click(Sender: TChartSeries; ValueIndex: Integer;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure Chart1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
ClipRect: TRect;
procedure SeriesBeforeDraw(Sender: TObject);
procedure SeriesAfterDraw(Sender: TObject);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses TeCanvas;
procedure TForm1.FormCreate(Sender: TObject);
begin
Series1.BeforeDrawValues:=SeriesBeforeDraw;
Series1.AfterDrawValues:=SeriesAfterDraw;
end;
procedure TForm1.SeriesBeforeDraw(Sender: TObject);
Function SeriesRect(Series:TChartSeries):TRect;
begin
With result do
begin
Left:=Series.GetHorizAxis.IStartPos;
Right:=Series.GetHorizAxis.IEndPos;
Top:=Series.GetVertAxis.IStartPos;
Bottom:=Series.GetVertAxis.CalcYPosValue(700);
end;
end;
begin
ClipRect:=SeriesRect( Sender as TChartSeries );
{ make opaque }
With Chart1 do
if CanClip then
Canvas.ClipRectangle(ClipRect);
end;
procedure TForm1.SeriesAfterDraw(Sender: TObject);
begin
Chart1.Canvas.UnClipRectangle;
end;
procedure TForm1.Series1Click(Sender: TChartSeries; ValueIndex: Integer;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Caption:=IntToStr(ValueIndex);
end;
procedure TForm1.Chart1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (Series1.Clicked(X,Y)<>-1) then
Chart1.CancelMouse:=not PointInRect(ClipRect,X,Y);
end;
end.
which produces this chart:
Trying to learn how to make server-client apps and stuff like. I trying to draw circles(on mouse click) in all clients so this is how i trying to do that. But it's not working - no errors but form is empty. What i need to fix?
Client code
unit Client;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, {Figure, Ball,} IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, ScktComp;
type
TForm1 = class(TForm)
Timer1: TTimer;
Button1: TButton;
ClientSocket: TClientSocket;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
public
{ Public declarations }
end;
var
Form1: TForm1;
f:boolean;
p:MyPoint;
s:MyPoint;
z:TCanvas;
obj: MyFigure;
pX, pY:Integer;
myBuf: array[1..32] of Integer;
dataBuf: array[1..32] of Integer;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
Timer1.Enabled:=false;
Timer1.Interval:=5;
z:=Form1.Canvas;//TCanvas.Create;
Button1.Caption:='Пуск';
f:=false;
ClientSocket.Port:=1234;
ClientSocket.Active:= False;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if not f then
begin
Timer1.Enabled:=true;
Button1.Caption:='Стоп';
f:=not f;
end
else
begin
Timer1.Enabled:=false;
Button1.Caption:='Пуск';
ClientSocket.Active:= True;
f:=not f;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
//z.Lock;
//z.Brush.Color:=ClWhite;
//z.FillRect(Canvas.ClipRect);
//obj.Draw(z);
if ClientSocket.Active then
ClientSocket.Socket.ReceiveBuf(dataBuf, 32);
z.Brush.Color:=ClRed;
z.Ellipse(dataBuf[1] + 10, dataBuf[2] + 10,dataBuf[1] - 10, dataBuf[2] - 10);
//z.Unlock;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ClientSocket.Active := false;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
myBuf[1]:=X;
myBuf[2]:=Y;
if ClientSocket.Active then
ClientSocket.Socket.SendBuf(myBuf, 32);
end;
end.
Server
unit ServerProject;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ScktComp;
type
TForm1 = class(TForm)
ServerSocket1: TServerSocket;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientWrite(Sender: TObject;
Socket: TCustomWinSocket);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
sBufer : array [1..32] of Integer;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
ServerSocket1.Port:=1234;
ServerSocket1.Active := True;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ServerSocket1.Active := false;
end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
i:integer;
begin
for i := 0 to ServerSocket1.Socket.ActiveConnections-1 do
begin
with ServerSocket1.Socket.Connections[i] do
begin
ReceiveBuf(sBufer, 32);
end;
end;
end;
procedure TForm1.ServerSocket1ClientWrite(Sender: TObject;
Socket: TCustomWinSocket);
var
i:integer;
begin
for i := 0 to ServerSocket1.Socket.ActiveConnections-1 do
begin
with ServerSocket1.Socket.Connections[i] do
begin
SendBuf(sBufer, 32);
end;
end;
end;
end.
Your painting code is in the wrong place and is painting to the wrong thing. In Windows programs you are meant to paint in response to a WM_PAINT message. You are not doing so. What's more, you have to paint on a device context that is provided by a call to BeginPaint.
The VCL wraps all those details up for you, but you still need to follow the rules. In your case I recommend that you add a TPaintBox component to your form. Then implement an OnPaint event handler for the paint box. Finally, whenever you wish to repaint the paint box, for example on a timer, call the Invalidate method of the paint box.
I suspect that you want your each new ellipse to be drawn in addition to the earlier drawn ellipses. In which case you are probably best served by drawing them to an off-screen bitmap first and then, when you come to paint to the paint box, draw that bitmap on the paint box. The point is that a window needs to be able to re-paint itself in its entirety. When you paint to a screen device, what you painted is lost the next time that window needs to be painted. So it's the responsibility of the application to be able to paint its entire self at any point, if it is asked.
More generally I urge you to stop using global variables. They will cause you no end of trouble. Prefer local variables wherever possible. If you need state to persist between different method calls, use member variables. The guiding principle is to use the narrowest scope possible.
Your current design uses a timer to poll for new data. That's a very poor approach. The most efficient and effective approach is to use synchronous blocking communication. Indy takes that approach. Windows sockets components instead tend to be used in an asynchronous mode. Irrespective of the relative merits of these two approaches, you should not be polling on a timer. If you do use asynchronous communication, then respond to new data by handling an event rather than polling.
Your program is currently trying to mix together GDI painting, and network communication. I suggest that you attempt to get on top of these concepts one at a time. Learn how to paint without the distraction of communication. Then when you have cracked painting, try to bring in the communication aspect.
I have a TFrame descendent that has on it a sizable panel which is a third-party component (TLMDSimplePanel)). The sizing on that panel works great, but I want the frame it is contained in to resize dynamically when the user changes the size of the panel. (The panel has a little sizing thumb grip on it that the user can just click and drag with the mouse).
The code for this frame is below:
unit SizeableFrame;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, TcmBaseFrameFrame, LMDCustomControl, LMDCustomPanel, LMDCustomBevelPanel,
LMDSimplePanel, StdCtrls;
type
TcmSizeableFrame = class(TcmBaseFrame)
LMDSimplePanel1: TLMDSimplePanel;
Memo1: TMemo;
Memo2: TMemo;
procedure LMDSimplePanel1Resize(Sender: TObject);
procedure FrameCanResize(Sender: TObject; var NewWidth, NewHeight: Integer;
var Resize: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
var
cmSizeableFrame: TcmSizeableFrame;
implementation
{$R *.dfm}
procedure TcmSizeableFrame.FrameCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
begin
inherited;
Resize := True;
end;
procedure TcmSizeableFrame.LMDSimplePanel1Resize(Sender: TObject);
const
ExpandByPixels = 60;
var
MyFrame : TFrame;
begin
inherited;
Self.Height := LMDSimplePanel1.Height + ExpandByPixels;
Self.Width := LMDSimplePanel1.Width + ExpandByPixels;
end;
end.
It works wonderfully, if the user is shrinking the the size of the frame, but if they try to stretch it larger than its original bounds, they can only expand it to what appears to be its original size + ExpandByPixels, after which the user cannot continue to fluidly drag it to a larger size.
If they stop, and then click and drag the size grip again, they can then drag it out to a larger size, but again this is constrained in the same way (current size + ExpandByPixels = the outer bound). They can repeat this cycle endlessly, expanding the frame to any size, but not fluidly in one mouse movement, which is what I want.
I have tested this same problem against TForm descendents as well, and get the same symptoms.
What am I missing here?
Thanks in advance for any and all help. :-)
Have you tried to set the Frame.Autosize to true?
Or you would need to resize the frame when the mouse moves. So that the contained object could expand while staying within the boundaries of the container.
Update: some simple code that works with a regular TPanel to resize horizontally...
type
TFrame5 = class(TFrame)
Panel1: TPanel;
procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure Panel1Resize(Sender: TObject);
end;
implementation
{$R *.dfm}
procedure TFrame5.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
with Sender as TPanel do
if ssLeft in Shift then
begin
Width := X;
end;
end;
procedure TFrame5.Panel1Resize(Sender: TObject);
begin
with Sender as TPanel do
begin
(Parent as TFrame).Width := Width + 2*Left;
end;
end;