neoturk: ...Graphics in your listboxes ?...
The ability to place graphics inside ListBoxes and ComboBoxes
can improve the look of your application and set your user
interface apart from the others.
Q: How do I stick graphics in a Listbox or ComboBox???
Here is an step-by-step example.....
1. Create a form.
2. Place a ComboBox and Listbox component on your form.
3. Change the Style property of the ComboBox component to
csOwnerDrawVariable and the Style property of the ListBox to
lbOwnerDrawVariable.
An Owner-Draw TListBox or TComboBox allows you to display
both objects (ex. graphics) and strings as the items. For
this example, we are adding both a graphic object and a
string.
4. Create 5 variables of type TBitmap in the Form's VAR
section.
5. Create a Procedure for the Form's OnCreate event.
6. Create a Procedure for the ComboBox's OnDraw Event.
7. Create a Procedure for the ComboBox's OnMeasureItem.
8. Free the resources in the Form's OnClose Event.
{START OWNERDRW.PAS}
unit Ownerdrw;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
ComboBox1: TComboBox;
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ComboBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure ComboBox1MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure ListBox1MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
TheBitmap1, TheBitmap2, TheBitmap3, TheBitmap4,
TheBitmap5 : TBitmap;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
TheBitmap1 := TBitmap.Create;
TheBitmap1.LoadFromFile('C:delphiimagesbuttonsglobe.bmp');
TheBitmap2 := TBitmap.Create;
TheBitmap2.LoadFromFile('C:delphiimagesbuttonsvideo.bmp');
TheBitmap3 := TBitmap.Create;
TheBitmap3.LoadFromFile('C:delphiimagesbuttonsgears.bmp');
TheBitmap4 := TBitmap.Create;
TheBitmap4.LoadFromFile('C:delphiimagesbuttonskey.bmp');
TheBitmap5 := TBitmap.Create;
TheBitmap5.LoadFromFile('C:delphiimagesbuttonstools.bmp');
ComboBox1.Items.AddObject('Bitmap1: Globe', TheBitmap1);
ComboBox1.Items.AddObject('Bitmap2: Video', TheBitmap2);
ComboBox1.Items.AddObject('Bitmap3: Gears', TheBitmap3);
ComboBox1.Items.AddObject('Bitmap4: Key', TheBitmap4);
ComboBox1.Items.AddObject('Bitmap5: Tools', TheBitmap5);
ListBox1.Items.AddObject('Bitmap1: Globe', TheBitmap1);
ListBox1.Items.AddObject('Bitmap2: Video', TheBitmap2);
ListBox1.Items.AddObject('Bitmap3: Gears', TheBitmap3);
ListBox1.Items.AddObject('Bitmap4: Key', TheBitmap4);
ListBox1.Items.AddObject('Bitmap5: Tools', TheBitmap5);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
TheBitmap1.Free;
TheBitmap2.Free;
TheBitmap3.Free;
TheBitmap4.Free;
TheBitmap5.Free;
end;
procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
Bitmap: TBitmap;
Offset: Integer;
begin
with (Control as TComboBox).Canvas do
begin
FillRect(Rect);
Bitmap := TBitmap(ComboBox1.Items.Objects[Index]);
if Bitmap <> nil then
begin
BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 2, Bitmap.Width,
Bitmap.Height), Bitmap, Bounds(0, 0, Bitmap.Width,
Bitmap.Height), clRed);
Offset := Bitmap.width + 8;
end;
{ display the text }
TextOut(Rect.Left + Offset, Rect.Top, Combobox1.Items[Index])
end;
end;
procedure TForm1.ComboBox1MeasureItem(Control: TWinControl; Index:
Integer; var Height: Integer);
begin
height:= 20;
end;
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
Bitmap: TBitmap;
Offset: Integer;
begin
with (Control as TListBox).Canvas do
begin
FillRect(Rect);
Bitmap := TBitmap(ListBox1.Items.Objects[Index]);
if Bitmap <> nil then
begin
BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 2, Bitmap.Width,
Bitmap.Height), Bitmap, Bounds(0, 0, Bitmap.Width,
Bitmap.Height), clRed);
Offset := Bitmap.width + 8;
end;
{ display the text }
TextOut(Rect.Left + Offset, Rect.Top, Listbox1.Items[Index])
end;
end;
procedure TForm1.ListBox1MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
begin
height:= 20;
end;
end.
{END OWNERDRW.PAS}
{START OWNERDRW.DFM}
object Form1: TForm1
Left = 211
Top = 155
Width = 435
Height = 300
Caption = 'Form1'
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'System'
Font.Style = []
PixelsPerInch = 96
OnClose = FormClose
OnCreate = FormCreate
TextHeight = 16
object ComboBox1: TComboBox
Left = 26
Top = 30
Width = 165
Height = 22
Style = csOwnerDrawVariable
ItemHeight = 16
TabOrder = 0
OnDrawItem = ComboBox1DrawItem
OnMeasureItem = ComboBox1MeasureItem
end
object ListBox1: TListBox
Left = 216
Top = 28
Width = 151
Height = 167
ItemHeight = 16
Style = lbOwnerDrawVariable
TabOrder = 1
OnDrawItem = ListBox1DrawItem
OnMeasureItem = ListBox1MeasureItem
end
end
{END OWNERDRW.DFM}
Delphi - .....................................
neoturk: ...Add controls to ttabbednotebook ?...
I have seen the question "how do you add controls to TTabbedNotebook
or TNotebook at run-time?" several times here and elsewhere.
Well, after finally getting a few spare minutes to check into
it, I have stumbled across the solution:
TTabbedNotebook
---------------
Adding controls to a TTabbedNotebook during design time is
a pretty simple task. All you need to do is set the PageIndex
or ActivePage property to the page you want to add controls
to, and begin dropping the controls onto the TTabbedNotebook.
Adding controls to a TTabbedNotebook during run-time is also
very simple. However, there is no mention what-so-ever in
the Delphi documentation on how to do this. To make matters
worse, the TTabbedNotebook source code is not included when
you purchase the Delphi VCL source. Thus, we are left with
a mystery. Fortunately, I have stumbled across the solution.
The first step to solving this mystery was to take a look
at DELPHIDOCTABNOTBK.INT, the interface section of the
TABNOTBK.PAS unit where TTabbedNotebook is defined. A quick
examination will reveal the TTabPage class, which is described
as holding the controls for a given page of the TTabbedNotebook.
The second clue to solving this case comes from observation
that the Pages property of TTabbedNotebook has a type of TStrings.
It just so happens that Delphi's TStrings and TStringList classes
provide both Strings and Objects property pairs. In other words,
for every string in TStrings, there is a corresponding Objects
pointer. In many cases, this extra pointer is ignored, but if
you're like me, you're thinking "Ah-hah!"
After a quick little test in code, sure enough, the Objects property
points to a TTabPage instance -- the one that corresponds to the
page name in the Strings property. Bingo! Just what we were looking
for. Now see what we can do:
{ This procedure adds places a button at a random location on the }
{ current page of the given TTabbedNotebook. }
procedure AddButton(tabNotebook : TTabbedNotebook);
var
tabpage : TTabPage;
button : TButton;
begin
with tabNotebook do
tabpage := TTabPage(Pages.Objects[PageIndex]);
button := TButton.Create(tabpage);
try
with button do begin
Parent := tabpage;
Left := Random(tabpage.ClientWidth - Width);
Top := Random(tabpage.ClientHeight - Height);
end;
except
button.Free;
end;
end;
TNotebook
---------
The process of adding controls to a TNotebook is almost exactly
the same as that for TTabbedNotebook -- only the page class type
is TPage instead of TTabPage. However, if you look in
DELPHIDOCEXTCTRLS.INT for the type declaration for TPage,
you won't find it. For some reason, Borland did not include the
TPage definition in the DOC files that shipped with Delphi.
The TPage declaration *IS* in the EXTCTRLS.PAS unit that you
get when you order the VCL source, right where it should be
in the interface section of the unit. Here's the TPage information
they left out:
TPage = class(TCustomControl)
private
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
protected
procedure ReadState(Reader: TReader); override;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
published
property Caption;
property Height stored False;
property TabOrder stored False;
property Visible stored False;
property Width stored False;
end;
Now, to make the above procedure work for adding a button to
a TNotebook, all we have to do is replace "TTabbedNotebook" with
"TNotebook" and "TTabPage" with "TPage", as follows:
{ This procedure adds places a button at a random location on the }
{ current page of the given TNotebook. }
procedure AddButton(Notebook1 : TNotebook);
var
page : TPage;
button : TButton;
begin
with Notebook1 do
page := TPage(Pages.Objects[PageIndex]);
button := TButton.Create(page);
try
with button do begin
Parent := page;
Left := Random(page.ClientWidth - Width);
Top := Random(page.ClientHeight - Height);
end;
except
button.Free;
end;
end;
Delphi - .....................................
neoturk: ...Add controls to ttabbednotebook ?...
I have seen the question "how do you add controls to TTabbedNotebook
or TNotebook at run-time?" several times here and elsewhere.
Well, after finally getting a few spare minutes to check into
it, I have stumbled across the solution:
TTabbedNotebook
---------------
Adding controls to a TTabbedNotebook during design time is
a pretty simple task. All you need to do is set the PageIndex
or ActivePage property to the page you want to add controls
to, and begin dropping the controls onto the TTabbedNotebook.
Adding controls to a TTabbedNotebook during run-time is also
very simple. However, there is no mention what-so-ever in
the Delphi documentation on how to do this. To make matters
worse, the TTabbedNotebook source code is not included when
you purchase the Delphi VCL source. Thus, we are left with
a mystery. Fortunately, I have stumbled across the solution.
The first step to solving this mystery was to take a look
at DELPHIDOCTABNOTBK.INT, the interface section of the
TABNOTBK.PAS unit where TTabbedNotebook is defined. A quick
examination will reveal the TTabPage class, which is described
as holding the controls for a given page of the TTabbedNotebook.
The second clue to solving this case comes from observation
that the Pages property of TTabbedNotebook has a type of TStrings.
It just so happens that Delphi's TStrings and TStringList classes
provide both Strings and Objects property pairs. In other words,
for every string in TStrings, there is a corresponding Objects
pointer. In many cases, this extra pointer is ignored, but if
you're like me, you're thinking "Ah-hah!"
After a quick little test in code, sure enough, the Objects property
points to a TTabPage instance -- the one that corresponds to the
page name in the Strings property. Bingo! Just what we were looking
for. Now see what we can do:
{ This procedure adds places a button at a random location on the }
{ current page of the given TTabbedNotebook. }
procedure AddButton(tabNotebook : TTabbedNotebook);
var
tabpage : TTabPage;
button : TButton;
begin
with tabNotebook do
tabpage := TTabPage(Pages.Objects[PageIndex]);
button := TButton.Create(tabpage);
try
with button do begin
Parent := tabpage;
Left := Random(tabpage.ClientWidth - Width);
Top := Random(tabpage.ClientHeight - Height);
end;
except
button.Free;
end;
end;
TNotebook
---------
The process of adding controls to a TNotebook is almost exactly
the same as that for TTabbedNotebook -- only the page class type
is TPage instead of TTabPage. However, if you look in
DELPHIDOCEXTCTRLS.INT for the type declaration for TPage,
you won't find it. For some reason, Borland did not include the
TPage definition in the DOC files that shipped with Delphi.
The TPage declaration *IS* in the EXTCTRLS.PAS unit that you
get when you order the VCL source, right where it should be
in the interface section of the unit. Here's the TPage information
they left out:
TPage = class(TCustomControl)
private
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
protected
procedure ReadState(Reader: TReader); override;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
published
property Caption;
property Height stored False;
property TabOrder stored False;
property Visible stored False;
property Width stored False;
end;
Now, to make the above procedure work for adding a button to
a TNotebook, all we have to do is replace "TTabbedNotebook" with
"TNotebook" and "TTabPage" with "TPage", as follows:
{ This procedure adds places a button at a random location on the }
{ current page of the given TNotebook. }
procedure AddButton(Notebook1 : TNotebook);
var
page : TPage;
button : TButton;
begin
with Notebook1 do
page := TPage(Pages.Objects[PageIndex]);
button := TButton.Create(page);
try
with button do begin
Parent := page;
Left := Random(page.ClientWidth - Width);
Top := Random(page.ClientHeight - Height);
end;
except
button.Free;
end;
end;
Delphi - .....................................
neoturk: ...Delphi dde linking ?...
unit Netscp1;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, DdeMan;
type
TForm1 = class(TForm)
DdeClientConv1: TDdeClientConv;
Button1: TButton;
Button2: TButton;
Button3: TButton;
LinkStatus: TEdit;
Label1: TLabel;
Label2: TLabel;
URLName: TEdit;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
LinkOpened: Integer;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
If LinkOpened = 0 Then
Begin
DdeClientConv1.SetLink('Netscape', 'WWW_OpenURL');
If DdeClientConv1.OpenLink Then
begin
LinkStatus.Text := 'Netscape Link has been opened';
LinkOpened := 1;
end
else
LinkStatus.Text := 'Unable to make Netscape Link';
End;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
LinkOpened := 0;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
DdeClientConv1.CloseLink;
LinkOpened := 0;
LinkStatus.Text := 'Netscape Link has been closed';
end;
procedure TForm1.Button3Click(Sender: TObject);
var
ItemList: String;
begin
If LinkOpened <> 0 Then
begin
ItemList := URLName.Text + ',,0xFFFFFFFF,0x3,,,';
DdeClientConv1.RequestData(ItemList);
End;
end;
end.
Delphi - .....................................
neoturk: ...Delphi dde linking ?...
unit Netscp1;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, DdeMan;
type
TForm1 = class(TForm)
DdeClientConv1: TDdeClientConv;
Button1: TButton;
Button2: TButton;
Button3: TButton;
LinkStatus: TEdit;
Label1: TLabel;
Label2: TLabel;
URLName: TEdit;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
LinkOpened: Integer;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
If LinkOpened = 0 Then
Begin
DdeClientConv1.SetLink('Netscape', 'WWW_OpenURL');
If DdeClientConv1.OpenLink Then
begin
LinkStatus.Text := 'Netscape Link has been opened';
LinkOpened := 1;
end
else
LinkStatus.Text := 'Unable to make Netscape Link';
End;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
LinkOpened := 0;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
DdeClientConv1.CloseLink;
LinkOpened := 0;
LinkStatus.Text := 'Netscape Link has been closed';
end;
procedure TForm1.Button3Click(Sender: TObject);
var
ItemList: String;
begin
If LinkOpened <> 0 Then
begin
ItemList := URLName.Text + ',,0xFFFFFFFF,0x3,,,';
DdeClientConv1.RequestData(ItemList);
End;
end;
end.
Delphi - .....................................
neoturk: ...Add-delete pages - tabbed notebook ?...
procedure AddPage(nbk : TNotebook; tabset : TTabSet; const pagename : string);
{ Adds a new page to nbk and a new tab to tabset with pagename for the text, }
{ places a memo on the page, and brings the new page to the top. }
{ Assumes the tabset has exactly one tab for each notebook page in same order. }
var
memo : TMemo;
page : TPage;
begin
if nbk <> nil then begin
nbk.Pages.Add(pagename); {add a page to the TNotebook}
nbk.PageIndex := nbk.Pages.Count - 1; {make new page the current page}
if tabset <> nil then begin
tabset.Tabs.Add(pagename); {add a matching tab}
tabset.TabIndex := nbk.PageIndex; {make new tab the current tab}
end;
if nbk.PageIndex > -1 then begin {make sure a page exists}
page := TPage(nbk.Pages.Objects[nbk.PageIndex]); {get page object}
memo := TMemo.Create(page); {create memo (owned by page)}
try
memo.Parent := page; {set page as Parent}
memo.Align := alClient; {set alignment to fill client area}
except
memo.Free; {free memo if something goes wrong}
end;
page.Visible := true; {make sure the page gets displayed}
end;
end;
end;
procedure DeletePage(nbk : TNotebook; tabset : TTabSet; index : integer);
{ Deletes the page whose PageIndex = index from nbk and tabset. }
{ Assumes the tabset has exactly one tab for each notebook page in same order. }
var
switchto : integer;
begin
if nbk <> nil then begin
if (index >= 0) and (index < nbk.Pages.Count) then begin
if index = nbk.PageIndex then begin
if index < nbk.Pages.Count - 1 then begin {if page is not last in list}
switchto := nbk.PageIndex; {show page behind current after delete}
if (index = 0) and (nbk.Pages.Count > 1) then {if first page}
nbk.PageIndex := 1; {show second page now}
end else
switchto := nbk.PageIndex - 1; {else, show page before current}
end;
nbk.Pages.Delete(index); {free's the page & all controls it owns}
if tabset <> nil then begin
if index < tabset.Tabs.Count then
tabset.Tabs.Delete(index); {delete corresponding tab}
end;
nbk.PageIndex := switchto;
end;
end;
end;
Delphi - .....................................
neoturk: ...Add-delete pages - tabbed notebook ?...
procedure AddPage(nbk : TNotebook; tabset : TTabSet; const pagename : string);
{ Adds a new page to nbk and a new tab to tabset with pagename for the text, }
{ places a memo on the page, and brings the new page to the top. }
{ Assumes the tabset has exactly one tab for each notebook page in same order. }
var
memo : TMemo;
page : TPage;
begin
if nbk <> nil then begin
nbk.Pages.Add(pagename); {add a page to the TNotebook}
nbk.PageIndex := nbk.Pages.Count - 1; {make new page the current page}
if tabset <> nil then begin
tabset.Tabs.Add(pagename); {add a matching tab}
tabset.TabIndex := nbk.PageIndex; {make new tab the current tab}
end;
if nbk.PageIndex > -1 then begin {make sure a page exists}
page := TPage(nbk.Pages.Objects[nbk.PageIndex]); {get page object}
memo := TMemo.Create(page); {create memo (owned by page)}
try
memo.Parent := page; {set page as Parent}
memo.Align := alClient; {set alignment to fill client area}
except
memo.Free; {free memo if something goes wrong}
end;
page.Visible := true; {make sure the page gets displayed}
end;
end;
end;
procedure DeletePage(nbk : TNotebook; tabset : TTabSet; index : integer);
{ Deletes the page whose PageIndex = index from nbk and tabset. }
{ Assumes the tabset has exactly one tab for each notebook page in same order. }
var
switchto : integer;
begin
if nbk <> nil then begin
if (index >= 0) and (index < nbk.Pages.Count) then begin
if index = nbk.PageIndex then begin
if index < nbk.Pages.Count - 1 then begin {if page is not last in list}
switchto := nbk.PageIndex; {show page behind current after delete}
if (index = 0) and (nbk.Pages.Count > 1) then {if first page}
nbk.PageIndex := 1; {show second page now}
end else
switchto := nbk.PageIndex - 1; {else, show page before current}
end;
nbk.Pages.Delete(index); {free's the page & all controls it owns}
if tabset <> nil then begin
if index < tabset.Tabs.Count then
tabset.Tabs.Delete(index); {delete corresponding tab}
end;
nbk.PageIndex := switchto;
end;
end;
end;
Delphi - .....................................
neoturk: ...'navigating' a tmemo ?...
to determine position of cursor in edit field try this:
Lpos := SendMessage(memo1.Handle,EM_LINEFROMCHAR,Memo1.SelStart,0);
Cpos := SendMessage(memo1.Handle,EM_LINEINDEX,Lpos,0);
LineLength := SendMessage(memo1.handle, EM_LINELENGTH, Cpos, 0);
CPos := Memo1.SelStart-CPos;
Lpos=line position
Cpos=Cposition
LineLength = number of chacters in currentline
Delphi - .....................................
neoturk: ...'navigating' a tmemo ?...
to determine position of cursor in edit field try this:
Lpos := SendMessage(memo1.Handle,EM_LINEFROMCHAR,Memo1.SelStart,0);
Cpos := SendMessage(memo1.Handle,EM_LINEINDEX,Lpos,0);
LineLength := SendMessage(memo1.handle, EM_LINELENGTH, Cpos, 0);
CPos := Memo1.SelStart-CPos;
Lpos=line position
Cpos=Cposition
LineLength = number of chacters in currentline
Delphi - .....................................
neoturk: ...Is delphi running ?...
>1. Does anyone know how to determine if Delphi is running or not?
I cannot answer the VBX question, but I have done the first one. When
Delphi is running, there are several windows open, not just Delphi.
Therefore, your app should check for more than one Delphi window, making it
very difficult for another app to simulate being Delphi. For example:
function DelphiIsRunning : boolean;
var
H1, H2, H3, H4 : Hwnd;
const
A1 : array[0..12] of char = 'TApplication'#0;
A2 : array[0..15] of char = 'TAlignPalette'#0;
A3 : array[0..18] of char = 'TPropertyInspector'#0;
A4 : array[0..11] of char = 'TAppBuilder'#0;
T1 : array[0..6] of char = 'Delphi'#0;
begin
H1 := FindWindow(A1, T1);
H2 := FindWindow(A2, nil);
H3 := FindWindow(A3, nil);
H4 := FindWindow(A4, nil);
Result := (H1 <> 0) and (H2 <> 0) and
(H3 <> 0) and (H4 <> 0);
end;
initialization
if not DelphiIsRunning then
begin
AboutBox := TAboutBox.Create(nil);
AboutBox.ShowModal;
AboutBox.Free;
Halt;
end;
end.
The biggest problem with this approach that I've found is that when you
create a program using this code, it will run from within Delphi (which is
what you want), but it will also run as a standalone app as long as Delphi
is currently running. I guess that's not too big a problem 
. This is the
approach used by TurboPower Software in the Orpheus Trial-Run. I haven't
seen their code, so I don't know which window(s) they are checking for, but
programs created using the Trial-Run components exhibit the behaviour
created by this technique.
To see the windows an app creates so you can get the list of constants
above, use WinSight.
BTW, I just thought of this. If Delphi has a DDE or OLE interface (I don't
know), you could first look for an app named Delphi then try to start a
conversation with any app that matches. If it responds properly you can
run, otherwise halt. Just an idea. This could work for other apps that do
have DDE or OLE.
Delphi - .....................................
neoturk: ...Is delphi running ?...
>1. Does anyone know how to determine if Delphi is running or not?
I cannot answer the VBX question, but I have done the first one. When
Delphi is running, there are several windows open, not just Delphi.
Therefore, your app should check for more than one Delphi window, making it
very difficult for another app to simulate being Delphi. For example:
function DelphiIsRunning : boolean;
var
H1, H2, H3, H4 : Hwnd;
const
A1 : array[0..12] of char = 'TApplication'#0;
A2 : array[0..15] of char = 'TAlignPalette'#0;
A3 : array[0..18] of char = 'TPropertyInspector'#0;
A4 : array[0..11] of char = 'TAppBuilder'#0;
T1 : array[0..6] of char = 'Delphi'#0;
begin
H1 := FindWindow(A1, T1);
H2 := FindWindow(A2, nil);
H3 := FindWindow(A3, nil);
H4 := FindWindow(A4, nil);
Result := (H1 <> 0) and (H2 <> 0) and
(H3 <> 0) and (H4 <> 0);
end;
initialization
if not DelphiIsRunning then
begin
AboutBox := TAboutBox.Create(nil);
AboutBox.ShowModal;
AboutBox.Free;
Halt;
end;
end.
The biggest problem with this approach that I've found is that when you
create a program using this code, it will run from within Delphi (which is
what you want), but it will also run as a standalone app as long as Delphi
is currently running. I guess that's not too big a problem . This is the
approach used by TurboPower Software in the Orpheus Trial-Run. I haven't
seen their code, so I don't know which window(s) they are checking for, but
programs created using the Trial-Run components exhibit the behaviour
created by this technique.
To see the windows an app creates so you can get the list of constants
above, use WinSight.
BTW, I just thought of this. If Delphi has a DDE or OLE interface (I don't
know), you could first look for an app named Delphi then try to start a
conversation with any app that matches. If it responds properly you can
run, otherwise halt. Just an idea. This could work for other apps that do
have DDE or OLE.
Delphi - .....................................
neoturk: ...Bringing an icon to the front ?...
>How can you bring an icon to the front (set focus), without actually
>restoring the mainwindow?
Michael--
If the form/app is already minimized, this should do what you want:
ShowWindow(Form1.Handle, SW_MINIMIZED);
NB: I have not actually tried this, although I see no reason why it
wouldn't work.
Delphi - .....................................
neoturk: ...Bringing an icon to the front ?...
>How can you bring an icon to the front (set focus), without actually
>restoring the mainwindow?
Michael--
If the form/app is already minimized, this should do what you want:
ShowWindow(Form1.Handle, SW_MINIMIZED);
NB: I have not actually tried this, although I see no reason why it
wouldn't work.
Delphi - .....................................
neoturk: ...How to keep the app iconized ?...
iconized apps
Q: How do I keep the form in icon form when I run it?
A:
1. You must set WindowState to wsMinimized in the form's properties.
2. In the private section of the form object's declaration, put:
PROCEDURE WMQueryOpen(VAR Msg : TWMQueryOpen); message WM_QUERYOPEN;
3. In the implementation section, put this method:
PROCEDURE TForm1.WMQueryOpen(VAR Msg : TWMQueryOpen);
begin
Msg.Result := 0;
end;
That's it! The form will always remain iconic.
Delphi - .....................................
neoturk: ...How to keep the app iconized ?...
iconized apps
Q: How do I keep the form in icon form when I run it?
A:
1. You must set WindowState to wsMinimized in the form's properties.
2. In the private section of the form object's declaration, put:
PROCEDURE WMQueryOpen(VAR Msg : TWMQueryOpen); message WM_QUERYOPEN;
3. In the implementation section, put this method:
PROCEDURE TForm1.WMQueryOpen(VAR Msg : TWMQueryOpen);
begin
Msg.Result := 0;
end;
That's it! The form will always remain iconic.
Delphi - .....................................
neoturk: ...Restarting windows ?...
{
There are two documented functions in the Windows API for restarting
Windows: ExitWindows(), and ExitWindowsExec(). (See the Windows API help
for details on both.) A common misconception is that the Program Manager DDE
macro call "[Reload()]" is for restarting Windows; it is not!
The call ExitWindows( 0, EW_RESTARTWINDOWS ) is _supposed_ to shut down
Windows, then bring it back up. I've had no luck, though, from inside a
Delphi app. It just shuts down Windows and gives me a DOS prompt.
ExitWindowsExec was built so that you could shut down Windows, execute a DOS
app (to replace Windows-critical DLL's, for example), and then bring Windows
hack up. I have discovered that you simply need to pass a bad executable
name, and ExitWindowsExec performs exactly as ExitWindows was supposed to!
For example, the last few lines of an installation application may be:
if (MessageDlg( 'The installation was successful! You must now ' +
'restart Windows. Do this now?', mtInformation,
[mbYes, mbNo], 0) = mrYes) then begin
ExitWindowsExec( BOGUS_EXE, Nil );
end;
where BOGUS_EXE is declared something like
const
BOGUS_EXE = 'zyxwvuts.exe';
This should replace (or be appended to) the tip sheet entry about restarting
windows.
There is a documentation error (probably due to the bad habits of 'C'
programmers) for the ExitWindows() API call... the parameters are reversed!
This code DOES WORK... (I've tested it. 
)
procedure TForm1.Button1Click(Sender: TObject);
begin
ExitWindows(EW_RESTARTWINDOWS,0);
end;
Delphi - .....................................
neoturk: ...Restarting windows ?...
{
There are two documented functions in the Windows API for restarting
Windows: ExitWindows(), and ExitWindowsExec(). (See the Windows API help
for details on both.) A common misconception is that the Program Manager DDE
macro call "[Reload()]" is for restarting Windows; it is not!
The call ExitWindows( 0, EW_RESTARTWINDOWS ) is _supposed_ to shut down
Windows, then bring it back up. I've had no luck, though, from inside a
Delphi app. It just shuts down Windows and gives me a DOS prompt.
ExitWindowsExec was built so that you could shut down Windows, execute a DOS
app (to replace Windows-critical DLL's, for example), and then bring Windows
hack up. I have discovered that you simply need to pass a bad executable
name, and ExitWindowsExec performs exactly as ExitWindows was supposed to!
For example, the last few lines of an installation application may be:
if (MessageDlg( 'The installation was successful! You must now ' +
'restart Windows. Do this now?', mtInformation,
[mbYes, mbNo], 0) = mrYes) then begin
ExitWindowsExec( BOGUS_EXE, Nil );
end;
where BOGUS_EXE is declared something like
const
BOGUS_EXE = 'zyxwvuts.exe';
This should replace (or be appended to) the tip sheet entry about restarting
windows.
There is a documentation error (probably due to the bad habits of 'C'
programmers) for the ExitWindows() API call... the parameters are reversed!
This code DOES WORK... (I've tested it. )
procedure TForm1.Button1Click(Sender: TObject);
begin
ExitWindows(EW_RESTARTWINDOWS,0);
end;
Delphi - .....................................
neoturk: ...Making the enter key work like a tab ?...
Code to make the <Enter>key act as the tab key while inside a grid.
This code also includes the processing of the <Enter> key for the entire
application - including fields, etc. The grid part is handled in the
ELSE portion of the code. The provided code does not mimic the behavior
of the <Tab> key stepping down to the next record when it reaches the last
column in the grid - it moves back to the first column - .
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
{ This is the event handler for the FORM's OnKeyPress event! }
{ You should also set the Form's KeyPreview property to True }
begin
if Key = #13 then { if it's an enter key }
if not (ActiveControl is TDBGrid) then begin { if not on a TDBGrid }
Key := #0; { eat enter key }
Perform(WM_NEXTDLGCTL, 0, 0); { move to next control }
end
else if (ActiveControl is TDBGrid) then { if it is a TDBGrid }
with TDBGrid(ActiveControl) do
if selectedindex < (fieldcount -1) then { increment the field }
selectedindex := selectedindex +1
else
selectedindex := 0;
end;
Delphi - .....................................
neoturk: ...Making the enter key work like a tab ?...
Code to make the <Enter>key act as the tab key while inside a grid.
This code also includes the processing of the <Enter> key for the entire
application - including fields, etc. The grid part is handled in the
ELSE portion of the code. The provided code does not mimic the behavior
of the <Tab> key stepping down to the next record when it reaches the last
column in the grid - it moves back to the first column - .
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
{ This is the event handler for the FORM's OnKeyPress event! }
{ You should also set the Form's KeyPreview property to True }
begin
if Key = #13 then { if it's an enter key }
if not (ActiveControl is TDBGrid) then begin { if not on a TDBGrid }
Key := #0; { eat enter key }
Perform(WM_NEXTDLGCTL, 0, 0); { move to next control }
end
else if (ActiveControl is TDBGrid) then { if it is a TDBGrid }
with TDBGrid(ActiveControl) do
if selectedindex < (fieldcount -1) then { increment the field }
selectedindex := selectedindex +1
else
selectedindex := 0;
end;
Delphi - .....................................
neoturk: ...Resizing and dividing panels ?...
{
Here's the source code for a resizable panel. Give the panel an align
property of alClient, throw some controls on it, and watch them resize
at run time when you resize the form. There is some code that prohibits
resizing during design time, but this can be taken out. This may not be
perfect, because I threw it together in a few minutes, but it's worked
for me so far.
}
unit Elastic;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls;
type
TElasticPanel = class( TPanel )
private
FHorz, FVert: boolean;
nOldWidth, nOldHeight: integer;
bResized: boolean;
protected
procedure WMSize( var message: TWMSize ); message WM_SIZE;
public
nCount: integer;
constructor Create( AOwner: TComponent ); override;
published
property ElasticHorizontal: boolean read FHorz write FHorz default
TRUE;
property ElasticVertical: boolean read FVert write FVert default
TRUE;
end;
procedure Register;
implementation
constructor TElasticPanel.Create( AOwner: TComponent );
begin
inherited Create( AOwner );
FHorz := TRUE;
FVert := TRUE;
nOldWidth := Width;
nOldHeight := Height;
bResized := FALSE;
end;
procedure TElasticPanel.WMSize( var message: TWMSize );
var
bResize: boolean;
xRatio: real;
i: integer;
ctl: TWinControl;
begin
Inc( nCount );
if Align = alNone then
bResize := TRUE
else
bResize := bResized;
if not ( csDesigning in ComponentState ) and bResize then
begin
if FHorz then
begin
xRatio := Width / nOldWidth;
for i := 0 to ControlCount - 1 do
begin
ctl := TWinControl( Controls[i] );
ctl.Left := Round( ctl.Left * xRatio );
ctl.Width := Round( ctl.Width * xRatio );
end;
end;
if FVert then
begin
xRatio := Height / nOldHeight;
for i := 0 to ControlCount - 1 do
begin
ctl := TWinControl( Controls[i] );
ctl.Top := Round( ctl.Top * xRatio );
ctl.Height := Round( ctl.Height * xRatio );
end;
end;
end
else
begin
nOldWidth := Width;
nOldHeight := Height;
end;
bResized := TRUE;
nOldWidth := Width;
nOldHeight := Height;
end;
procedure Register;
begin
RegisterComponents('Additional', [TElasticPanel]);
end;
end.
Delphi - .....................................
neoturk: ...Resizing and dividing panels ?...
{
Here's the source code for a resizable panel. Give the panel an align
property of alClient, throw some controls on it, and watch them resize
at run time when you resize the form. There is some code that prohibits
resizing during design time, but this can be taken out. This may not be
perfect, because I threw it together in a few minutes, but it's worked
for me so far.
}
unit Elastic;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls;
type
TElasticPanel = class( TPanel )
private
FHorz, FVert: boolean;
nOldWidth, nOldHeight: integer;
bResized: boolean;
protected
procedure WMSize( var message: TWMSize ); message WM_SIZE;
public
nCount: integer;
constructor Create( AOwner: TComponent ); override;
published
property ElasticHorizontal: boolean read FHorz write FHorz default
TRUE;
property ElasticVertical: boolean read FVert write FVert default
TRUE;
end;
procedure Register;
implementation
constructor TElasticPanel.Create( AOwner: TComponent );
begin
inherited Create( AOwner );
FHorz := TRUE;
FVert := TRUE;
nOldWidth := Width;
nOldHeight := Height;
bResized := FALSE;
end;
procedure TElasticPanel.WMSize( var message: TWMSize );
var
bResize: boolean;
xRatio: real;
i: integer;
ctl: TWinControl;
begin
Inc( nCount );
if Align = alNone then
bResize := TRUE
else
bResize := bResized;
if not ( csDesigning in ComponentState ) and bResize then
begin
if FHorz then
begin
xRatio := Width / nOldWidth;
for i := 0 to ControlCount - 1 do
begin
ctl := TWinControl( Controls[i] );
ctl.Left := Round( ctl.Left * xRatio );
ctl.Width := Round( ctl.Width * xRatio );
end;
end;
if FVert then
begin
xRatio := Height / nOldHeight;
for i := 0 to ControlCount - 1 do
begin
ctl := TWinControl( Controls[i] );
ctl.Top := Round( ctl.Top * xRatio );
ctl.Height := Round( ctl.Height * xRatio );
end;
end;
end
else
begin
nOldWidth := Width;
nOldHeight := Height;
end;
bResized := TRUE;
nOldWidth := Width;
nOldHeight := Height;
end;
procedure Register;
begin
RegisterComponents('Additional', [TElasticPanel]);
end;
end.
Delphi - .....................................
neoturk: ...Drag a form ?...
{
Q: How can I make a form move by clicking and dragging in the client area
instead of on the caption bar?
A: The easiest way to do this is to "fool" Windows into thinking that
you're actually clicking on the caption bar of a form. Do this by
handling the wm_NCHitTest windows message as shown in the sample unit
below.
TIP: If you want a captioness borderless window similar to a floating
toolbar, set the Form's Caption to an empty string, disable all of the
BorderIcons, and set the BorderStyle to bsNone.
}
unit Dragmain;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);
begin
inherited; { call the inherited message handler }
if M.Result = htClient then { is the click in the client area? }
M.Result := htCaption; { if so, make Windows think it's }
{ on the caption bar. }
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Close;
end;
end.
{ The text representation of the .DFM file is below:
object Form1: TForm1
Left = 203
Top = 94
BorderIcons = []
BorderStyle = bsNone
ClientHeight = 273
ClientWidth = 427
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'System'
Font.Style = []
PixelsPerInch = 96
TextHeight = 16
object Button1: TButton
Left = 160
Top = 104
Width = 89
Height = 33
Caption = 'Close'
TabOrder = 0
OnClick = Button1Click
end
end
}
Delphi - .....................................
neoturk: ...Drag a form ?...
{
Q: How can I make a form move by clicking and dragging in the client area
instead of on the caption bar?
A: The easiest way to do this is to "fool" Windows into thinking that
you're actually clicking on the caption bar of a form. Do this by
handling the wm_NCHitTest windows message as shown in the sample unit
below.
TIP: If you want a captioness borderless window similar to a floating
toolbar, set the Form's Caption to an empty string, disable all of the
BorderIcons, and set the BorderStyle to bsNone.
}
unit Dragmain;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);
begin
inherited; { call the inherited message handler }
if M.Result = htClient then { is the click in the client area? }
M.Result := htCaption; { if so, make Windows think it's }
{ on the caption bar. }
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Close;
end;
end.
{ The text representation of the .DFM file is below:
object Form1: TForm1
Left = 203
Top = 94
BorderIcons = []
BorderStyle = bsNone
ClientHeight = 273
ClientWidth = 427
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'System'
Font.Style = []
PixelsPerInch = 96
TextHeight = 16
object Button1: TButton
Left = 160
Top = 104
Width = 89
Height = 33
Caption = 'Close'
TabOrder = 0
OnClick = Button1Click
end
end
}
Delphi - .....................................
neoturk: ...Delphi does dos ?...
Instructions for preparing DELPHI to compile a DOS EXE with DCC.EXE
Requirements:
1) BP7 Runtime library source
2) Delphi VCL source
3) TASM.EXE
4) The new DLIB.EXE (available from CompuServe DELPHI forum)
Assumptions:
1) BP7 RTL is in BPRTL
2) Delphi VCL is in DELPHISOURCE
3) DELPHIBIN is in your path as well as TASM.EXE
Copy from BPRTLSYS to DELPHISOURCERTLSYS (all are .ASM):
MAIN, PARS, LAST, HEAP, F87H, EI87, EI86, DLIB, DAPP
(* note ERRC that was in this list has been removed - it should
not be copied over or exception handling will not work *)
-- DOS Real Mode ----------------------------------------------------------
Objective: create a TURBO.TPL with units compiled under DELPHI
1) The first and main requirement is to get a SYSTEM.TPU for DOS mode.
This will take some work because Delphi VCL source does not include
MAIN.ASM which is required for compiling SYSTEM.PAS in DOS mode.
Some things need to be removed from MAIN.ASM because they now exist
in EXIT.ASM:
- remove HaltTurbo, HaltError, Terminate, PrintString from the PUBLIC
section.
- remove the procedure code for the above procedures. (HaltError
starts in around line 210 or so and HaltTurbo starts around 230
or so. PrintString ends around 395 +/- a few.)
- up at the top in Externals after "ASSUME CS:CODE,DS:DATA" add
another "EXTRN HaltError:NEAR,HaltTurbo:NEAR"
- down in "Int3FHandler" remove "SHORT" from "JMP SHORT HaltError"
- after "MOV AX,200" in Int00Handler add "JMP HaltError"
- after "MOV AX,255" in Int23Handler add "JMP HaltTurbo"
2) Create OBJ from ASM: In DELPHISOURCERTLSYS type
TASM *.ASM
3) Compile SYSTEM: In DELPHISOURCERTLSYS type
DCC -cd -$d- -oBPRTLLIB SYSTEM
4) Start your TURBO.TPL: In DELPHIBIN type
DLIB TURBO.TPL +..SOURCERTLSYSSYSTEM.TPU
Other files you may want to compile and include in TURBO.TPL:
unit source can be found
OVERLAY BPRTLOVR
CRT BPRTLCRT
DOS BPRTLDOS (need to use TASM again)
PRINTER BPRTLPRT
STRINGS DELPHISOURCERTL70 (optional)
MEMORY BPRTLTV (optional)
OBJECTS BPRTLCOMMON (optional)
Compile the above files in the specified directory using DCC with the
parameters -cd and -$d- to create "ver 8.0" .TPU files. Then add the
TPU files to TURBO.TPL as shown in step 4.
Now you're all set! Use DCC with the "undocumented" -cd switch to create
DOS EXEs with classes, exception handling, etc.
-- DOS Protected Mode -----------------------------------------------------
Objective: create a TPP.TPL with units compiled under DELPHI
1) Make sure the .OBJ files still exist from step 2 above.
2) Create OBP from ASM: In DELPHISOURCERTLSYS type
TASM -op -d_DPMI_ *.ASM *.OBP
3) Compile SYSTEM: In DELPHISOURCERTLSYS type
DCC -cp -$d- -oBPRTLLIB SYSTEM
4) Start your TURBO.TPL: In DELPHIBIN type
DLIB TPP.TPL +..SOURCERTLSYSSYSTEM.TPP
Other files you may want to compile and include in TPP.TPL:
unit source can be found
CRT BPRTLCRT
DOS BPRTLDOS (TASM -op -d_DPMI_ *.ASM *.OBP)
PRINTER BPRTLPRT
STRINGS DELPHISOURCERTL70
WINDOS DELPHISOURCERTL70
WINAPI DELPHISOURCERTLWIN
MEMORY BPRTLTV (optional)
OBJECTS BPRTLCOMMON (optional)
SYSUTILS DELPHISOURCERTLSYS (new, see below)
Compile the above files in the specified directory using DCC with the
parameters -cp and -$d- to create "ver 8.0" .TPP files. Then add the
TPP files to TPP.TPL as shown in step 4.
-- SysUtils for DOS Protected Mode ----------------------------------------
To get SYSUTILS to work properly in DOS PM you need to make a few minor
changes to the source file (comes with VCL Source). First make a backup
of the SYSUTILS.PAS file and then I suggest puting "{$IFDEF WINDOWS}..."
around all of your changes.
1) FileRead/FileWrite: RTM.EXE only supports _lread/write not _hread/write
and SysUtils needs to be updated to reflect that. I will use FileRead
as the example:
In INTERFACE
{$IFDEF WINDOWS}
function FileRead(Handle: Integer; var Buffer; Count: Longint): Longint;
{$ELSE}
function FileRead(Handle: Integer; var Buffer; Count: Word): Word;
{$ENDIF}
In IMPLEMENTATION
function FileRead(Handle: Integer; var Buffer; Count: Word): Word;
external 'KERNEL' index 82; { _lread }
FileWrite needs the same changes and it has an external index of 86.
2) Units used in the IMPLEMENTATION section:
{$IFDEF WINDOWS}
uses WinTypes, WinProcs, ToolHelp;
{$ELSE}
uses WinAPI;
{$ENDIF}
3) Remove some exception (hardware, etc) handling. Unfortunately RTM
does not support MakeProcInstance and FreeProcInstance otherwise
none of the following would have to be removed.
A) in the INTERFACE section
{$IFDEF WINDOWS}
procedure EnableExceptionHandler(Enable: Boolean);
{$ENDIF}
B) Around the procedure "GetModNameAndLogAddr" in the IMPLEMENTATION
section add {$IFDEF WINDOWS} and {$ENDIF}.
C) In the procedure "ShowException":
var
.. existing definitions
Buffer: array[0..255] of Char;
{$IFDEF WINDOWS}
GlobalEntry: TGlobalEntry;
hMod: THandle;
{$ENDIF}
begin
{$IFDEF WINDOWS}
.. existing code
{$ENDIF}
end;
D) Before the procedure "ErrorHandler":
{$IFDEF WINDOWS}
const
Flags = $10;
.. other consts
Recurse: Word = 0;
{$ENDIF}
E) In the procedure "ErrorHandler":
1: E := OutOfMemory;
{$IFDEF WINDOWS}
2,4..10: with ExceptMap[ErrorCode] do E := EClass.CreateRes(EIdent);
3,11..16:
..
end;
{$ELSE}
2..16: with ExceptMap[ErrorCode] do E := EClass.CreateRes(EIdent);
{$ENDIF}
else
F) Before the procedure "InterruptCallBack" add {$IFDEF WINDOWS} and
after the end of the procedure "EnableExceptionHandler" add {$ENDIF}.
G) In procedure "DoneExceptions" put IFDEF WINDOWS around the call to
EnableExceptionHandler.
H) In procedure "InitExceptions" put IFDEF WINDOWS around the assignment
"TaskID := GetCurrentTask;" and the call to EnableExceptionHandler.
4) Add profile support provide in RTM.EXE. After the comment
"{ Initialization file support }" add the following:
{$IFNDEF WINDOWS}
function GetProfileInt( appName, keyName : pchar;
default : integer ) : word; far; external 'KERNEL' index 57;
function GetProfileString( appName, keyName, default, returned : pchar;
size : integer ) : integer; far; external 'KERNEL' index 58;
{$ENDIF}
Compile SYSUTILS for DOS PM from the command line:
DCC -cp SYSUTILS
It is all set to add the TPP.TPL and use in your programs. I have not
been able to test every function that is provided. It would be diffucult
to get SysUtils working for DOS Real Mode because of its use of resource
files, although I am sure it is possible if someone would like to give it
a shot. You could probably remove all the exception handling and get it
to compile with BP7.
-- Classes for DOS Protected Mode -----------------------------------------
Getting the CLASSES unit to compile for DOS PM is very simple compared to
SYSUTILS.
In the INTERFACE section change the uses clause:
{$IFDEF WINDOWS}
uses SysUtils, WinTypes, WinProcs;
{$ELSE}
uses SysUtils, WinAPI;
{$ENDIF}
You need to create a unit called CONSTS that has the following:
(This information was obtained via the online browser because
Borland does not proved CONSTS.PAS - don't ask me why not!?):
========================================
unit Consts;
interface
const
SClassNotFound = 61447;
SDuplicateClass = 61457;
SRegisterError = 61498;
SResNotFound = 61449;
SLineTooLong = 61459;
SReadError = 61443;
SWriteError = 61444;
SInvalidImage = 61448;
SFCreateError = 61441;
SFOpenError = 61442;
SMemoryStreamError = 61445;
SInvalidProperty = 61538;
SUnknownProperty = 61462;
SPropertyException = 61464;
SInvalidPropertyPath = 61461;
SInvalidPropertyValue = 61460;
SReadOnlyProperty = 61463;
SCharExpected = 61534;
SSymbolExpected = 61535;
SParseError = 61530;
SDuplicateName = 61455;
SInvalidName = 61456;
SListIndexError = 61451;
SDuplicateString = 61453;
SSortedListError = 61452;
SIdentifierExpected = 61531;
SStringExpected = 61532;
SNumberExpected = 61533;
SInvalidBinary = 61539;
SInvalidString = 61537;
SAssignError = 61440;
implementation
end.
========================================
Now copy TYPINFO.INT to TYPINFO.PAS and copy the procedure/function
declarations from the INTERFACE to IMPLEMENTATION. With each procedure and
function add a "Begin End;". Have each function return NIL, 0, etc
depending on its type.
Compile:
DCC -cp CLASSES
You can now use TList, TStrings, TStringList, TStream, etc in your DOS PM
programs. Because of changes to SysUtils THandleStream.Read/Write is
limited to a buffer size of word and not longint. You won't be able to
use TReader and TWriter unless you can get Borland to give you the source
or TPP for TYPINFO.PAS.
Delphi - .....................................
neoturk: ...Delphi does dos ?...
Instructions for preparing DELPHI to compile a DOS EXE with DCC.EXE
Requirements:
1) BP7 Runtime library source
2) Delphi VCL source
3) TASM.EXE
4) The new DLIB.EXE (available from CompuServe DELPHI forum)
Assumptions:
1) BP7 RTL is in BPRTL
2) Delphi VCL is in DELPHISOURCE
3) DELPHIBIN is in your path as well as TASM.EXE
Copy from BPRTLSYS to DELPHISOURCERTLSYS (all are .ASM):
MAIN, PARS, LAST, HEAP, F87H, EI87, EI86, DLIB, DAPP
(* note ERRC that was in this list has been removed - it should
not be copied over or exception handling will not work *)
-- DOS Real Mode ----------------------------------------------------------
Objective: create a TURBO.TPL with units compiled under DELPHI
1) The first and main requirement is to get a SYSTEM.TPU for DOS mode.
This will take some work because Delphi VCL source does not include
MAIN.ASM which is required for compiling SYSTEM.PAS in DOS mode.
Some things need to be removed from MAIN.ASM because they now exist
in EXIT.ASM:
- remove HaltTurbo, HaltError, Terminate, PrintString from the PUBLIC
section.
- remove the procedure code for the above procedures. (HaltError
starts in around line 210 or so and HaltTurbo starts around 230
or so. PrintString ends around 395 +/- a few.)
- up at the top in Externals after "ASSUME CS:CODE,DS:DATA" add
another "EXTRN HaltError:NEAR,HaltTurbo:NEAR"
- down in "Int3FHandler" remove "SHORT" from "JMP SHORT HaltError"
- after "MOV AX,200" in Int00Handler add "JMP HaltError"
- after "MOV AX,255" in Int23Handler add "JMP HaltTurbo"
2) Create OBJ from ASM: In DELPHISOURCERTLSYS type
TASM *.ASM
3) Compile SYSTEM: In DELPHISOURCERTLSYS type
DCC -cd -$d- -oBPRTLLIB SYSTEM
4) Start your TURBO.TPL: In DELPHIBIN type
DLIB TURBO.TPL +..SOURCERTLSYSSYSTEM.TPU
Other files you may want to compile and include in TURBO.TPL:
unit source can be found
OVERLAY BPRTLOVR
CRT BPRTLCRT
DOS BPRTLDOS (need to use TASM again)
PRINTER BPRTLPRT
STRINGS DELPHISOURCERTL70 (optional)
MEMORY BPRTLTV (optional)
OBJECTS BPRTLCOMMON (optional)
Compile the above files in the specified directory using DCC with the
parameters -cd and -$d- to create "ver 8.0" .TPU files. Then add the
TPU files to TURBO.TPL as shown in step 4.
Now you're all set! Use DCC with the "undocumented" -cd switch to create
DOS EXEs with classes, exception handling, etc.
-- DOS Protected Mode -----------------------------------------------------
Objective: create a TPP.TPL with units compiled under DELPHI
1) Make sure the .OBJ files still exist from step 2 above.
2) Create OBP from ASM: In DELPHISOURCERTLSYS type
TASM -op -d_DPMI_ *.ASM *.OBP
3) Compile SYSTEM: In DELPHISOURCERTLSYS type
DCC -cp -$d- -oBPRTLLIB SYSTEM
4) Start your TURBO.TPL: In DELPHIBIN type
DLIB TPP.TPL +..SOURCERTLSYSSYSTEM.TPP
Other files you may want to compile and include in TPP.TPL:
unit source can be found
CRT BPRTLCRT
DOS BPRTLDOS (TASM -op -d_DPMI_ *.ASM *.OBP)
PRINTER BPRTLPRT
STRINGS DELPHISOURCERTL70
WINDOS DELPHISOURCERTL70
WINAPI DELPHISOURCERTLWIN
MEMORY BPRTLTV (optional)
OBJECTS BPRTLCOMMON (optional)
SYSUTILS DELPHISOURCERTLSYS (new, see below)
Compile the above files in the specified directory using DCC with the
parameters -cp and -$d- to create "ver 8.0" .TPP files. Then add the
TPP files to TPP.TPL as shown in step 4.
-- SysUtils for DOS Protected Mode ----------------------------------------
To get SYSUTILS to work properly in DOS PM you need to make a few minor
changes to the source file (comes with VCL Source). First make a backup
of the SYSUTILS.PAS file and then I suggest puting "{$IFDEF WINDOWS}..."
around all of your changes.
1) FileRead/FileWrite: RTM.EXE only supports _lread/write not _hread/write
and SysUtils needs to be updated to reflect that. I will use FileRead
as the example:
In INTERFACE
{$IFDEF WINDOWS}
function FileRead(Handle: Integer; var Buffer; Count: Longint): Longint;
{$ELSE}
function FileRead(Handle: Integer; var Buffer; Count: Word): Word;
{$ENDIF}
In IMPLEMENTATION
function FileRead(Handle: Integer; var Buffer; Count: Word): Word;
external 'KERNEL' index 82; { _lread }
FileWrite needs the same changes and it has an external index of 86.
2) Units used in the IMPLEMENTATION section:
{$IFDEF WINDOWS}
uses WinTypes, WinProcs, ToolHelp;
{$ELSE}
uses WinAPI;
{$ENDIF}
3) Remove some exception (hardware, etc) handling. Unfortunately RTM
does not support MakeProcInstance and FreeProcInstance otherwise
none of the following would have to be removed.
A) in the INTERFACE section
{$IFDEF WINDOWS}
procedure EnableExceptionHandler(Enable: Boolean);
{$ENDIF}
B) Around the procedure "GetModNameAndLogAddr" in the IMPLEMENTATION
section add {$IFDEF WINDOWS} and {$ENDIF}.
C) In the procedure "ShowException":
var
.. existing definitions
Buffer: array[0..255] of Char;
{$IFDEF WINDOWS}
GlobalEntry: TGlobalEntry;
hMod: THandle;
{$ENDIF}
begin
{$IFDEF WINDOWS}
.. existing code
{$ENDIF}
end;
D) Before the procedure "ErrorHandler":
{$IFDEF WINDOWS}
const
Flags = $10;
.. other consts
Recurse: Word = 0;
{$ENDIF}
E) In the procedure "ErrorHandler":
1: E := OutOfMemory;
{$IFDEF WINDOWS}
2,4..10: with ExceptMap[ErrorCode] do E := EClass.CreateRes(EIdent);
3,11..16:
..
end;
{$ELSE}
2..16: with ExceptMap[ErrorCode] do E := EClass.CreateRes(EIdent);
{$ENDIF}
else
F) Before the procedure "InterruptCallBack" add {$IFDEF WINDOWS} and
after the end of the procedure "EnableExceptionHandler" add {$ENDIF}.
G) In procedure "DoneExceptions" put IFDEF WINDOWS around the call to
EnableExceptionHandler.
H) In procedure "InitExceptions" put IFDEF WINDOWS around the assignment
"TaskID := GetCurrentTask;" and the call to EnableExceptionHandler.
4) Add profile support provide in RTM.EXE. After the comment
"{ Initialization file support }" add the following:
{$IFNDEF WINDOWS}
function GetProfileInt( appName, keyName : pchar;
default : integer ) : word; far; external 'KERNEL' index 57;
function GetProfileString( appName, keyName, default, returned : pchar;
size : integer ) : integer; far; external 'KERNEL' index 58;
{$ENDIF}
Compile SYSUTILS for DOS PM from the command line:
DCC -cp SYSUTILS
It is all set to add the TPP.TPL and use in your programs. I have not
been able to test every function that is provided. It would be diffucult
to get SysUtils working for DOS Real Mode because of its use of resource
files, although I am sure it is possible if someone would like to give it
a shot. You could probably remove all the exception handling and get it
to compile with BP7.
-- Classes for DOS Protected Mode -----------------------------------------
Getting the CLASSES unit to compile for DOS PM is very simple compared to
SYSUTILS.
In the INTERFACE section change the uses clause:
{$IFDEF WINDOWS}
uses SysUtils, WinTypes, WinProcs;
{$ELSE}
uses SysUtils, WinAPI;
{$ENDIF}
You need to create a unit called CONSTS that has the following:
(This information was obtained via the online browser because
Borland does not proved CONSTS.PAS - don't ask me why not!?):
========================================
unit Consts;
interface
const
SClassNotFound = 61447;
SDuplicateClass = 61457;
SRegisterError = 61498;
SResNotFound = 61449;
SLineTooLong = 61459;
SReadError = 61443;
SWriteError = 61444;
SInvalidImage = 61448;
SFCreateError = 61441;
SFOpenError = 61442;
SMemoryStreamError = 61445;
SInvalidProperty = 61538;
SUnknownProperty = 61462;
SPropertyException = 61464;
SInvalidPropertyPath = 61461;
SInvalidPropertyValue = 61460;
SReadOnlyProperty = 61463;
SCharExpected = 61534;
SSymbolExpected = 61535;
SParseError = 61530;
SDuplicateName = 61455;
SInvalidName = 61456;
SListIndexError = 61451;
SDuplicateString = 61453;
SSortedListError = 61452;
SIdentifierExpected = 61531;
SStringExpected = 61532;
SNumberExpected = 61533;
SInvalidBinary = 61539;
SInvalidString = 61537;
SAssignError = 61440;
implementation
end.
========================================
Now copy TYPINFO.INT to TYPINFO.PAS and copy the procedure/function
declarations from the INTERFACE to IMPLEMENTATION. With each procedure and
function add a "Begin End;". Have each function return NIL, 0, etc
depending on its type.
Compile:
DCC -cp CLASSES
You can now use TList, TStrings, TStringList, TStream, etc in your DOS PM
programs. Because of changes to SysUtils THandleStream.Read/Write is
limited to a buffer size of word and not longint. You won't be able to
use TReader and TWriter unless you can get Borland to give you the source
or TPP for TYPINFO.PAS.
.
)