I have implemented a custom title bar on an app I am working on. I have created some custom events for titlebar double click and titlebar mousedown.
procedure TAdvCustomForm.TitleBarDblClick( Sender : TObject );
begin
if( WindowState <> TWindowState.wsMaximized ) then
begin
Winapi.Windows.ReleaseCapture();
Perform( wm_SysCommand, SC_MAXIMIZE, 0 );
SizeGrip.Visible := False;
end
else
begin
Winapi.Windows.ReleaseCapture();
Perform( wm_SysCommand, SC_RESTORE, 0 );
SizeGrip.Visible := True;
end;
end;
procedure TAdvCustomForm.TitleBarMouseDown( Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer );
const
SC_DRAG = $F012; //stumbled on by accident
begin
if( Button = TMouseButton.mbLeft ) then
begin
self.DoubleBuffered := True;
Winapi.Windows.ReleaseCapture();
Perform( wm_SysCommand, SC_DRAG, 0 );
self.DoubleBuffered := False;
end;
end;
What I am am unable to find is the Windows 11 hook to show the window dock when dragging the window. As in the image.
How do I modify my mousedown event to show it?
Related
How would I be able to do a continuous action while a button is held down? For example, I have made a custom 'Numpad' for my application, which has a Delete button. As of right now, I have to click it separately, but I want it to keep deleting while it is held down.
procedure TFrame1.deleteClick(Sender: TObject);
var
MiString: string;
begin
global_gotten_mode := precheck.global_edit_mode;
precheck.Form2.input_field.SetFocus;
MiString := Copy(precheck.Form2.input_field.Text, 0, (length(precheck.Form2.input_field.Text) - 1));
precheck.Form2.input_field.Text := MiString;
Form2.input_field.SelStart := high(integer);
end;
Add a timer and activate it on the OnMouseDown event.
As long as the button is held down, the timer will kick in at a rate of your choice.
When the button is released, the OnMouseUp event disables the timer.
Something in this way:
procedure TFrame1.BtnMouseDown(Sender : TObject);
begin
global_gotten_mode := precheck.global_edit_mode;
precheck.Form2.input_field.SetFocus;
fMyBtnTimer.Interval := 500; // Initial repetition rate
fMyBtnTimer.Enabled := true;
end;
procedure TFrame1.BtnMouseUp(Sender : TObject);
begin
fMyBtnTimer.Enabled := false;
end;
procedure TFrame1.MyBtnTimerEvent(Sender : TObject);
var
MiString: string;
begin
fMyBtnTimer.Interval := 200; // Increase repetition rate
MiString := Copy( precheck.Form2.input_field.Text,
0,
length(precheck.Form2.input_field.Text) - 1);
precheck.Form2.input_field.Text := MiString;
Form2.input_field.SelStart := high(integer);
end;
I have a TScrollBox that has a RichEdit that is bigger than the scrollbox, so both side scrollbars appear in the scrollbox. Then I have a function DoTask that calls RichEdit.SetFocus.
When I scroll down to where I want to see part of the text control, and then call DoTask, the ScrollBox will automatically scroll to the top of the RichEdit. How can I avoid that?
As you wish, here are some suggestions:
Override SetFocusedControl in the form:
function TForm1.SetFocusedControl(Control: TWinControl): Boolean;
begin
if Control = RichEdit then
Result := True
else
Result := inherited SetFocusedControl(Control);
end;
Or:
type
TCustomMemoAccess = class(TCustomMemo);
function TForm1.SetFocusedControl(Control: TWinControl): Boolean;
var
Memo: TCustomMemoAccess;
Scroller: TScrollingWinControl;
Pt: TPoint;
begin
Result := inherited SetFocusedControl(Control);
if (Control is TCustomMemo) and (Control.Parent <> nil) and
(Control.Parent is TScrollingWinControl) then
begin
Memo := TCustomMemoAccess(Control);
Scroller := TScrollingWinControl(Memo.Parent);
SendMessage(Memo.Handle, EM_POSFROMCHAR, Integer(#Pt), Memo.SelStart);
Scroller.VertScrollBar.Position := Scroller.VertScrollBar.Position +
Memo.Top + Pt.Y;
end;
end;
Interpose TScrollBox:
type
TScrollBox = class(Forms.TScrollBox)
protected
procedure AutoScrollInView(AControl: TControl); override;
end;
procedure TScrollBox.AutoScrollInView(AControl: TControl);
begin
if not (AControl is TCustomMemo) then
inherited AutoScrollInView(AControl);
end;
Or:
procedure TScrollBox.AutoScrollInView(AControl: TControl);
begin
if (AControl.Top > VertScrollBar.Position + ClientHeight) xor
(AControl.Top + AControl.Height < VertScrollBar.Position) then
inherited AutoScrollInView(AControl);
end;
Or use any creative combination of all of the above. How and when you like it to be scrolled only you know.
the simpliest solution would be
var a, b : Integer;
begin
a := ScrollBox1.VertScrollBar.Position;
b := ScrollBox1.HorzScrollBar.Position;
richEdit1.SetFocus;
ScrollBox1.VertScrollBar.Position:=a ;
ScrollBox1.HorzScrollBar.Position:=b ;
end;
Without hacking into VCL/deriving custom components there's only one solution - TForm.SetFocusedControl override + re-setting the positions of scrollbars as said above. One thing I added is disabling/enabling window redraw to avoid ugly jumps.
Here's my final snippet:
sbContainer is TScrollBox and NoScrCtrl is a control laying inside it which gets focus but we don't want it to be scrolled-in-view.
function TForm1.SetFocusedControl(Control: TWinControl): Boolean;
var hpos, vpos: integer;
begin
if Control = NoScrCtrl then
begin
sbContainer.Perform(WM_SETREDRAW, WPARAM(False), 0);
hpos := sbContainer.HorzScrollBar.Position;
vpos := sbContainer.VertScrollBar.Position;
Result := inherited SetFocusedControl(Control);
sbContainer.HorzScrollBar.Position := hpos;
sbContainer.VertScrollBar.Position := vpos;
sbContainer.Perform(WM_SETREDRAW, WPARAM(True), 0);
sbContainer.Refresh;
end
else
Result := inherited SetFocusedControl(Control);
end;
To disable scroll-into-view behavior from my main form, I used this solution: (C++Builder)
bool __fastcall TMainForm::SetFocusedControl(TWinControl *Control) {
LockWindowUpdate(Handle);
int vpos = VertScrollBar->Position;
int hpos = HorzScrollBar->Position;
bool result = TForm::SetFocusedControl(Control);
if (VertScrollBar->Position != vpos) {
VertScrollBar->Position = vpos;
}
if (HorzScrollBar->Position != hpos) {
HorzScrollBar->Position = hpos;
}
LockWindowUpdate(0);
return result;
}
I want to limit a TCheckListBox.
I desire only 2 items should be checked, and all unchecked items will be disabled and grayed.
Since the checked / unchecked items are dynamic, i can not use a static itemIndex.
Here is what i tried, but i got "Out of chip bounds" error.
On click event of my CheckListBox ;
var
NumberOfCheckedItems, I: Integer;
begin
NumberOfCheckedItems := 0;
for I := 0 to CkLst1.Count - 1 do
begin
if CkLst1.Checked[I] then
NumberOfCheckedItems := NumberOfCheckedItems + 1;
end;
if NumberOfCheckedItems > 1 then
begin
CkLst1.Checked[I] := Enabled;
CkLst1.Enabled := FALSE;
CkLst1.AllowGrayed := TRUE;
end
else
begin
//no idea
end;
end;
This method should do the job
procedure DoCheckListBox( AChkLb : TCheckListBox; AMaxCheck : Integer );
var
LIdx : Integer;
LCheckCount : Integer;
begin
// counting
LCheckCount := 0;
for LIdx := 0 to AChkLb.Count - 1 do
begin
if AChkLb.Checked[LIdx] then
if LCheckCount = AMaxCheck then
AChkLb.Checked[LIdx] := False
else
Inc( LCheckCount );
end;
// enable/disable
for LIdx := 0 to AChkLb.Count - 1 do
AChkLb.ItemEnabled[LIdx] := AChkLb.Checked[LIdx] or ( LCheckCount < AMaxCheck );
end;
UPDATE
You better call this inside TCheckListBox.OnClickCheck event instead of OnClick event.
A double-click can affect the check-state but OnClick is not called.
OnClickCheck is called whenever the check-state changes.
I am using a Tabbed Listbox component that was written by Fredric Rylander back in 1999 and it has been serving me well since then. :) Can't seem to find him anymore.
I now have an application that needs both Tabbed Data and alternating colored lines in the Listbox.
I can include the Component here for perusal if desired.
I tried coloring the lines from here
http://delphi.about.com/cs/adptips2002/a/bltip0602_4.htm
But then it eats the Tabs, but I do get the alternating colored lines.
Can someone please show me how to incorporate the two.
Thanks
Here's the Component
unit myListBoxTabbed;
{
Copyright © 1999 Fredric Rylander
You can easily add a header control to this list box: drop a header
control onto the form (it's default align property is set to alTop, if
it's not--set it); then set the myTabbedListBox's aligned property
to alClient; now, add the following two events and their code.
1) HeaderControl's OnSectionResize event:
var
i, last: integer;
begin
last := 0;
for i:=0 to HeaderControl1.Sections.Count-1 do begin
last := last + HeaderControl1.Sections[i].Width;
myTabbedListBox1.TabStops[i] := last;
end;
end;
2) Main form's OnCreate event:
var
i, last: integer;
begin
last := 0;
for i:=0 to HeaderControl1.Sections.Count-1 do begin
last := last + HeaderControl1.Sections[i].Width;
myTabbedListBox1.TabStops[i] := last;
end;
for i:=HeaderControl1.Sections.Count to MaxNumSections do
myTabbedListBox1.TabStops[i] := 2000;
end;
To get tab characters into the list box items either use the
string list property editor in the Delphi GUI and press
Ctrl + Tab or add tab characters (#9) in strings as so:
myTabbedListBox1.Items.Add( Edit1.Text + #9 + Edit2.Text );
I hope you find this tutorial helpful! :^)
(!) This is not a retail product, it's a tutorial and don't claim to
meet a potential user's demands.
If you find anything that seems odd (or incorrect even) don't hesitate to
write me a line. You can communicate with me at fredric#rylander.nu.
The source is available for you to use, abuse, modify and/or improve.
Happy trails!
/ Fredric
___________________________________F_r_e_d_r_i_c__R_y_l_a_n_d_e_r__
fredric#rylander.nu : www.rylander.nu : 6429296#pager.mirabilis.com
"power to the source sharing community"
}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TTabsArray = array[0..9] of integer;
type
TmyTabbedListBox = class( TListBox )
private
{ Private declarations }
fTabStops: TTabsArray;
function GetTabStops( iIndex: integer ): integer;
procedure SetTabStops( iIndex, iValue: integer);
function GetTabsString: string;
procedure SetTabsString( const sValue: string );
protected
{ Protected declarations }
procedure UpdateTabStops;
public
{ Public declarations }
procedure CreateParams( var cParams: TCreateParams ); override;
procedure CreateWnd; override;
property TabStops[ iIndex: integer ]: integer
read GetTabStops write SetTabStops;
published
{ Published declarations }
property TabsString: string
read GetTabsString write SetTabsString;
end;
procedure Register;
resourcestring
STR_ALPHA_UPPERLOWER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
CHAR_SEMICOLON = ';';
implementation
procedure Register;
begin
RegisterComponents('Additional', [TmyTabbedListBox]);
end;
{ myTabbedListBox }
procedure TmyTabbedListBox.CreateParams(var cParams: TCreateParams);
begin
inherited CreateParams( cParams );
// add the window style LBS_USETABSTOPS to accept tabs
cParams.Style := cParams.Style or LBS_USETABSTOPS;
end;
procedure TmyTabbedListBox.CreateWnd;
var
i: integer;
begin
inherited CreateWnd;
// set all the tabs into the box
for i := Low( fTabStops ) to High( fTabStops ) do
fTabStops[i] := i * 100;
// show the real tab positions
UpdateTabStops;
end;
function TmyTabbedListBox.GetTabsString: string;
var
sBuffer: string;
i: integer;
begin
// init var
sBuffer := SysUtils.EmptyStr;
// set all tabstops to the string (separated by ';'-char)
for i := Low( fTabStops ) to High( fTabStops ) do
sBuffer := sBuffer + IntToStr( fTabStops[i] ) + CHAR_SEMICOLON;
// and here we have the results
Result := sBuffer;
end;
function TmyTabbedListBox.GetTabStops( iIndex: integer ): integer;
begin
// nothing funny here
Result := fTabStops[iIndex];
end;
procedure TmyTabbedListBox.SetTabsString( const sValue: string );
var
sBuffer: string;
i, len: integer;
begin
// copy value into buffer
sBuffer := sValue;
// set the tabstops as specified
for i := Low( fTabStops ) to High( fTabStops ) do begin
len := Pos( sBuffer, CHAR_SEMICOLON );
fTabStops[i] := StrToIntDef( Copy( sBuffer, 1, len ), 0 );
Delete( sBuffer, 1, len );
end;
// show/redraw the results
UpdateTabStops;
Invalidate;
end;
procedure TmyTabbedListBox.SetTabStops( iIndex, iValue: integer );
begin
// do we really need to update?
if fTabStops[iIndex] <> iValue then begin
// oki, let's then
fTabStops[iIndex] := iValue;
// show/redraw the results
UpdateTabStops;
Invalidate;
end;
end;
procedure TmyTabbedListBox.UpdateTabStops;
var
i, iHUnits: integer;
arrConvertedTabs: TTabsArray;
begin
// convert dialog box units to pixels.
// dialog box unit = average character width/height div 4/8
// determine the horizontal dialog box units used by the
// list box (which depend on its current font)
Canvas.Font := Font;
iHUnits := Canvas.TextWidth( STR_ALPHA_UPPERLOWER ) div 52;
// convert the array of tab values
for i := Low( arrConvertedTabs ) to High( arrConvertedTabs ) do
arrConvertedTabs[i] := ( fTabStops[i] * 4 ) div iHUnits;
// activate the tabs stops in the list box,
// sending a Windows list box message
SendMessage( Handle, LB_SETTABSTOPS,
1 + High( arrConvertedTabs ) - Low( arrConvertedTabs ),
LongInt( #arrConvertedTabs ) );
end;
end.
Here's an example using a standard TListBox and it's OnDrawItem event, based on the code from the link you provided and tested in Delphi 2007. Note you need to set the ListBox.Style to lbOwnerDrawFixed. You can perhaps use this as a base for modifying the component (or just abandon it altogether).
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
LB: TListBox;
NewColor: TColor;
NewBrush: TBrush;
R: TRect;
Fmt: Cardinal;
ItemText: string;
begin
NewBrush := TBrush.Create;
LB := (Control as TListBox);
if (odSelected in State) then
begin
NewColor := LB.Canvas.Brush.Color;
end
else
begin
if not Odd(Index) then
NewColor := clSilver
else
NewColor := clYellow;
end;
NewBrush.Style := bsSolid;
NewBrush.Color := NewColor;
// This is the ListBox.Canvas brush itself, not to be
// confused with the NewBrush we've created above
LB.Canvas.Brush.Style := bsClear;
R := Rect;
ItemText := LB.Items[Index];
Fmt := DT_EXPANDTABS or DT_CALCRECT or DT_NOCLIP;
DrawText(LB.Canvas.Handle, PChar(ItemText), Length(ItemText),
R, Fmt);
// Note we need to FillRect on the original Rect and not
// the one we're using in the call to DrawText
Windows.FillRect(LB.Canvas.Handle, Rect, NewBrush.Handle) ;
DrawText(LB.Canvas.Handle, PChar(ItemText), Length(ItemText),
R, DT_EXPANDTABS);
NewBrush.Free;
end;
Here's the output of the above code:
In my project there is a TADOQuery tdm_Company that gets filled with a set of fields, provided with proper labels and fields set to visible=false where appropriate.The query returns a single result.
I have a detail screen that needs a bunch of labels and edit textboxes for these fields.
Is it possible to auto generate these in the editor? What if I need those controls to be controls from the DevExpress components (TcxDBTextEdit and TcxLabel for example)?
I have never tried this, but there is (or was? - sorry, can't check) a Database Form Wizard. If you want to have other controls than those the wizard generates, there are possibilities to change these afterwards, e.g. GExperts' Replace Components.
In a very similar case (a query to return a single record showing contact data from an entity - company, customer etc.) we use DevExpress's TcxDBVerticalGrid. It scales much better and is more flexible (especially when resizing the form) when it comes to display a bunch of data which represents a single object.
Of course, you are not tied to the above component, you can obtain good results with (almost) any vertical grid / DBIspector but since you asked about a DevExpress component I gave you the above solution.
HTH
A long time ago I actually created my own Wizard for this, based on an actual Custom Form I wrote for a FrameWork of mine. When the Dialog for the wizard was shown, it would display all fields in a grid and allow the user to indicate which component should be used to display that field.
In my case depending on the Type of field it was prefilled with specific components (eg a TcxDateEdit for a TDateTime field, ...). The user could still change that though, and indicate which fields he wanted to add to the form. Once the user closes the form it was just matter of itterating over all the fields and creating the corresponding control.
Searched through my code and found this back :
{ Custom Devia Development Framework RecordView Module which adds functionality to
create the DB Aware Controls for the RecordView }
TDevFrameWorkRecordViewModule = class( TCustomModule )
protected
procedure CreateDBAwareComponents( aParent : TComponent; aDataSource : TDataSource; aFields : TFields; aFieldDefs : TFieldDefs ); virtual;
function DefaultWizardClass : TDBAwareControlWizardClass; virtual;
function DefaultLabelClass : TComponentClass; virtual;
function MaxFieldCaptionLength ( aFields : TFields ) : Integer; virtual;
protected
function GetSelectedComponents : IDesignerSelections;
function GetSelectedControl : TControl;
property SelectedControl : TControl read GetSelectedControl;
property SelectedComponents : IDesignerSelections read GetSelectedComponents;
public
procedure DevAddDBAwareComponentsWizard( aParent : TControl ); virtual;
procedure ExecuteVerb(Index: Integer); override;
function GetVerb(Index: Integer): string; override;
function GetVerbCount: Integer; override;
end;
...
procedure TDevFrameWorkRecordViewModule.CreateDBAwareComponents(
aParent : TComponent; aDataSource : TDataSource; aFields : TFields; aFieldDefs : TFieldDefs );
var
lcv : Integer;
aLabel : TControl;
aEdit : TWinControl;
aDataBinding : TcxDBEditDataBinding;
aTop , aLeft : Integer;
aWidth : Integer;
aMaxCaptionWidth: Integer;
aDBLeft : Integer;
aRecordView : IDevFrameWorkRecordView;
aDBAwareClass : TComponentClass;
aDBAwareVisible : Boolean;
aWizardForm : TfrmDevFrameWorkAddDataAwareControlsWizard;
begin
{ First make sure the procedure was triggered on a FrameWorkRecordView }
if ( Supports( Root, IDevFrameWorkRecordView, aRecordView ) ) then
begin
{ Now Create and Show the wizard so the user can specify all the options }
aWizardForm := DefaultWizardClass.Create( Nil );
try
aWizardForm.RecordDataSet := aRecordView.DataSource.DataSet;
aWizardForm.InitialiseSettings;
{ If the user closed the Wizard using the OK button, we can continue the
process }
if ( aWizardForm.ShowModal = mrOK ) then
begin
{ By default the label components should start at 8,8 in the Parent Container }
aTop := 8;
aLeft := 8;
aWidth:= 121;
aMaxCaptionWidth := MaxFieldCaptionLength( aFields );
{ Now set the intial Left Position for our DBAware controls according
to the MaxCaptionWidth }
aDBLeft := 24 + ( ( ( aMaxCaptionWidth div 8 ) + 1 ) * 8 );
{ Loop over all fields to create the Label and DBAwareComponent }
for lcv := 0 to Pred( aFields.Count ) do
begin
{ Get some settings from the Wizard form }
aDBAwareClass := aWizardForm.GetDBAwareComponentClass( aFields[ lcv ] );
aDBAwareVisible := aWizardForm.GetDBAwareComponentVisible( aFields[ lcv ] );
{ Only create the components if the user indicated he wants to see them }
if aDBAwareVisible then
begin
{ Now create the Label and the DBAware Control }
aLabel := TControl ( Designer.CreateComponent( DefaultLabelClass, aParent, aLeft , aTop, aMaxCaptionWidth, 17 ) );
aEdit := TWinControl( Designer.CreateComponent( aDBAwareClass, aParent, aDBLeft, aTop, aWidth, 21 ) );
{ Now Set the Label Properties }
aLabel.Name := Designer.UniqueName( 'cxlbl' + aFields[ lcv ].FieldName );
aLabel.HelpType := htKeyWord;
aLabel.HelpKeyword := Root.Name + '.' + aFields[ lcv ].FieldName;
{ Set the additional properties using RTTI }
if ( IsPublishedProp( aLabel, 'FocusControl' ) ) then
begin
SetObjectProp( aLabel, 'FocusControl', aEdit );
end;
if ( IsPublishedProp( aLabel, 'Caption' ) ) then
begin
SetStrProp( aLabel, 'Caption', aFields[ lcv ].DisplayLabel );
end;
{ Now set the Edit Properites }
aEdit.Name := Designer.UniqueName( {'cxlbl' +} aFields[ lcv ].FieldName );
aEdit.HelpType := htKeyWord;
aEdit.HelpKeyword := Root.Name + '.' + aFields[ lcv ].FieldName;
{ Set the additional properties using RTTI }
if ( IsPublishedProp( aEdit, 'DataBinding' ) ) then
begin
aDataBinding := TcxDBEditDataBinding( GetObjectProp( aEdit, 'DataBinding' ) );
SetObjectProp( aDataBinding, 'DataSource', aDataSource );
SetStrProp ( aDataBinding, 'DataField' , aFields[ lcv ].FieldName );
end;
if ( aEdit is TcxCustomDropDownEdit ) then
begin
aEdit.Width := aWidth + 16;
end;
{ Now increment the Top position for the next control }
inc( aTop, ( ( ( aEdit.Height div 8 ) + 1 ) * 8 ) );
end;
end;
end;
finally
FreeAndNil( aWizardForm );
end;
end;
end;
function TDevFrameWorkRecordViewModule.DefaultLabelClass: TComponentClass;
begin
Result := TLabel;
end;
function TDevFrameWorkRecordViewModule.DefaultWizardClass: TDBAwareControlWizardClass;
begin
Result := TfrmDevFrameWorkAddDataAwareControlsWizard;
end;
procedure TDevFrameWorkRecordViewModule.ExecuteVerb(Index: Integer);
var
aSelections : IDesignerSelections;
lcv : Integer;
begin
aSelections := TDesignerSelections.Create;
Designer.GetSelections( aSelections );
for lcv := 0 to Pred( aSelections.Count ) do
begin
{$IFDEF CODESITE}
csFWRecordView.Send( 'aSelection.Items[ lcv ]', aSelections.Items[ lcv ] );
{$ENDIF}
end;
Case Index of
0 : DevAddDBAwareComponentsWizard( SelectedControl );
else Inherited ExecuteVerb( Index );
end;
end;
{*****************************************************************************
This function will be used to return a list of selected components on the
current designer.
#Name TDevFrameWorkRecordViewModule.GetSelectedComponents
#author Devia - Stefaan Lesage
#param None
#return None
#Exception None
#See None
******************************************************************************}
function TDevFrameWorkRecordViewModule.GetSelectedComponents: IDesignerSelections;
begin
Result := TDesignerSelections.Create;
Designer.GetSelections( Result );
end;
function TDevFrameWorkRecordViewModule.GetSelectedControl: TControl;
var
lcv : Integer;
begin
Result := Nil;
if ( Assigned( SelectedComponents ) ) then
begin
if ( SelectedComponents.Count <> 0 ) then
begin
for lcv := 0 to Pred( SelectedComponents.Count ) do
begin
if ( SelectedComponents.Items[ lcv ] is TControl ) then
begin
Result := TControl( SelectedComponents.Items[ lcv ] );
Break;
end;
end;
end;
end;
end;
function TDevFrameWorkRecordViewModule.GetVerb(Index: Integer): string;
begin
Case Index of
0 : Result := 'Dev.AddDataAwareComponents';
end;
end;
function TDevFrameWorkRecordViewModule.GetVerbCount: Integer;
begin
Result := 1;
end;
{*****************************************************************************
This function will determine the length of the Longest field's caption.
#Name TDevFrameWorkRecordViewModule.MaxFieldCaptionLength
#author Devia - Stefaan Lesage
#param None
#return Returns the length of the longest field's catpion.
#Exception None
#See None
******************************************************************************}
function TDevFrameWorkRecordViewModule.MaxFieldCaptionLength(
aFields: TFields): Integer;
var
aMaxCaptionWidth : Integer;
aCanvas : TCanvas;
lcv : Integer;
aCaption : String;
begin
aMaxCaptionWidth := 0;
{ First Determine how long the largest caption will be }
aCanvas := TDevFrameWorkRecordView( Root ).Canvas;
{ Loop over each field to dertermin which caption is the longest one }
for lcv := 0 to Pred( aFields.Count ) do
begin
if ( aFields[ lcv ].DisplayLabel <> '' ) then
begin
aCaption := aFields[ lcv ].DisplayLabel;
end
else
begin
aCaption := aFields[ lcv ].FieldName;
end;
if ( aCanvas.TextWidth( aCaption ) >
aMaxCaptionWidth ) then
begin
aMaxCaptionWidth := aCanvas.TextWidth( aCaption );
end;
end;
{ Return the Length of the Longest Caption }
Result := aMaxCaptionWidth;
end;
procedure TDevFrameWorkRecordViewModule.DevAddDBAwareComponentsWizard( aParent : TControl );
var
aRecordView : IDevFrameWorkRecordView;
aDataSource : TDataSource;
begin
{$IFDEF CODESITE}
csFWRecordView.EnterMethod( Self, 'DevAddDBAwareComponentsWizard' );
{$ENDIF}
if ( Supports( Root, IDevFrameWorkRecordView, aRecordView ) ) then
begin
{$IFDEF CODESITE}
csFWRecordView.SendMsg( csmInfo, 'Root supports I®FrameWorkRecordView' );
{$ENDIF}
aDataSource := TDataSource( Designer.GetComponent( 'srcMain' ) );
if ( Assigned( aDataSource ) ) and
( Assigned( aDataSource.DataSet ) ) then
begin
{$IFDEF CODESITE}
csFWRecordView.SendMsg( csmInfo, 'aRecordView.DataSource Assigned' );
csFWRecordView.SendMsg( csmInfo, 'aRecordView.DataSource.DataSet Assigned' );
{$ENDIF}
CreateDBAwareComponents( aParent, aDataSource, aDataSource.DataSet.Fields, aDataSource.DataSet.FieldDefs );
end;
end;
{$IFDEF CODESITE}
csFWRecordView.ExitMethod( Self, 'DevAddDBAwareComponentsWizard' );
{$ENDIF}
end;
Of course this won't compile for you. It is something I wrote for a development framework in Delphi 7 a few years ago. It should give you an idea though on how you could actually do it.
Regards,
Stefaan