I Getting Started
Chapter 1 - Windows Programming in Delphi REVIEW
Delphi is a Rapid Application Development(RAD) and database development tool
Delphi is a visual, object-oriented, component-based development tool
standard version of Delphi can connect to Paradox, dBase, and ODBC tables
Delphi Client/Server comes with SQLLinks
Delphi's underlying language is Object Pascal
Delphi's object-oriented class framework is Visual Component Library (VCL)
Delphi's IDE (Integrated Development Engine) contains: Code Editor, Form Designer,
Object Inspector, and the main window
unit Unit1;A form template
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs;
type
TForm1 = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
end.
program Project1;A program template
uses
Forms,
Unit1 in 'UNIT1.PAS' {Form1};
{$R *.RES}
begin
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
8-bit signed integer ShortInt 8-bit unsigned integer Byte 16-bit signed integer Integer 16-bit unsigned integer Word 32-bit signed integer LongInt 32-bit unsigned integer Comp 4-byte floating point Single 6-byte floating point Real 8-byte floating point Double 10-byte floating point Extended 1-byte character Char Length-byte string String Null-terminated string PChar Bool (1=true / 0=false) Bool, WordBool, LongBool Boolean (true / false) BooleanPascal Strings
ex.
var
P1, P2 : PChar;
begin
GetMem(P1, 64);
StrPCopy(P1, ' Hello ');
P2 := StrNew('World');
StrCat(P1, P2);
:
FreeMem(P1, 64);
StrDispose(P2)
end;
MyRec = record
Name : string[10];
Age : integer
end;
Objects
ex.
TChildObject = class(TParentObject)
SomeVar : integer;
procedure SomeProc;
end;
Pointers
ex.
PMyRec = ^MyRec;
var
Rec : PMyRec;
begin
New(Rec);
Rec^.Name := 'Wayne';
Rec^.Age := 21;
Dispose(Rec);
end;
ex.
var
c : char;
b : byte;
begin
c := 's';
b := byte(c);
end;
if (Age < 21) then writeln ('Don''t drink');Looping Constructs
if (Age < 18) then begin
Age := Age + 3;
writeln ('Don''t try it')
end
else
writeln('Maybe');
case Grade of
'a', 'A' : writeln('good job');
'b', 'B' : writeln('better luck next time');
else writeln('try again');
while (age < 21 ) do begin
writeln('still too young');
inc(age)
end;
for loop ex.
for count := 1 to 21 do
inc(age)
repeat-until ex.
repeat
writeln('not yet');
inc(age)
until (age >= 21);
function IsPositive (nbr : integer) : Boolean;Passing Parameters
{returns true if nbr is positive, false otherwise;
note that Result is an implicit local variable}
begin
if nbr < 0 then
Result := false
else
Result := true
end;
Program NewClass;Properties
uses WinCRT;
type
TMyClass = class
ANumber : integer;
constructor Create(Num : integer);
end;
constructor TMyClass.Create(Num : integer);
begin
ANumber := Num;
end;
var
MC : TMyClass;
begin
MC := TMyClass.Create(4); { create an instance of the object }
writeln (MC.ANumber);
MC.Free
end;
TMyObject = classMethods
private
SomeValue : integer;
procedure SetSomeValue(AValue : integer);
public
property Value : integer read SomeValue write SetSomeValue;
end;
procedure TMyObject.SetSomeValue(AValue : integer);
begin
if SomeValue <> AValue then
SomeValue := AValue
end;
TFoo = class
procedure IAmAStatic;
procedure IAmAVirtual; virtual;
procedure IAmADynamic; dynamic;
procedure IAmAMessage (var M : TMessage); message wm_SomeMessage;
end;
TFooChild = class(TFoo)
procedure IAmAVirtual; override;
procedure IAmADynamic; override;
procedure IAmAMessage (var M : TMessage); message wm_SomeMessage;
end;
TObject = classPrepending Class allows function / procedure to be used without an instance of the object
constructor Create;
destructor Destroy; virtual;
procedure Free;
class function NewInstance: TObject; virtual;
procedure FreeInstance; virtual;
class procedure InitInstance(Instance: Pointer): TObject;
function ClassType: TClass;
class function ClassName: string;
class function ClassParent: TClass;
class function ClassInfo: Pointer;
class function InstanceSize: Word;
class function InheritsForm(AClass: TClass): Boolean;
procedure DefaultHandler(var Message); virtual;
procedure Dispatch(var Message);
class function MethodAddress(const Name: string): Pointer;
class function MethodName(Address: Pointer): string;
function FieldAddress(const Name: string): Pointer;
end;
Program NewIO;
uses Classes, Dialogs;
var
F : Textfile;
Str : String;
begin
AssignFile (F, 'DATA.TXT');
try
Reset(F);
try
Readln(F, Str);
finally
CloseFile(F);
end;
exception
on EInOutError do
ShowMessage('Error Accessing File!')
end
end.
Program HandleIt;
uses WinCRT;
var
Nbr1, Nbr2 : real;
begin
while true do begin
try
write('Enter two real numbers: ');
readln(Nbr1, Nbr2);
writeln('The answer is: ', (Nbr1 / Nbr2) : 5 : 2)
except
On EZeroDivide do
writeln('cannot divide by zero');
OnEInvalidInput do
writeln('not a valid number');
end
end
end.
Function Return Type ReturnsRTTI Operators
========================================================
ClassName() String name of object's class
ClassType() TClass object's type
InheritsFrom() Boolean true if class descends from given class
ClassParent() TClass object ancestor's type
InstanceSize() Word size in bytes of an instance
ClassInfo() Pointer pointer to object's in-memory RTTI
Procedure Foo(AnObject : TObject);
(Foo as TEdit).Text := 'Hello World';
if (Foo is TEdit) then
TEdit(Foo).Text := 'Hello World';
TObject
|
TPersistent
|
---------------------------------------------------------------------------------------------
| | | |
TGraphicsObject TGraphic TString TComponent
|
---------------------------------------------------------------------------------------------
| | | |
TTimer TMenu TGlobalComponent TControl
| |
TApplication ----------------------------
| |
TWinControl TGraphicControl
unit Clasinf0;
interface
uses WinTypes,WinProcs,Classes, Graphics, Forms, Controls, StdCtrls, TypInfo, Buttons, Grids,Dialogs;
type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
StringGrid1: TStringGrid;
BitBtn1: TBitBtn;
PrintDialog1: TPrintDialog;
FontDialog1: TFontDialog;
BitBtn2: TBitBtn;
ListBox1: TListBox;
procedure Edit1Enter(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
private { Private declarations }
procedure WriteClassInfo(Sender: TObject);
public { Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WriteClassInfo(Sender: TObject);
var
ParentClass: TClass;
begin
with ListBox1.Items do begin
Clear; { Clear the listbox's strings }
Add('Class Name: '+Sender.ClassName); { Add Sender's class name to Listbox1 }
Add('Ancestry:'); { Add the string, Ancestry: to Listbox1 }
ParentClass := Sender.ClassParent; { Use ParentClass as a pointer to Sender's parent }
while ParentClass <> nil do begin { Continue to point ParentClass to the parent of itself }
Add(' '+ParentClass.ClassName); { until it's value is nil, and print out the class name }
ParentClass := ParentClass.ClassParent; { When it is nil, the end of the hierarchy is found }
end;
end;
end;
procedure TForm1.Edit1Enter(Sender: TObject);
begin
WriteClassInfo(Sender); { Call the WriteClassInfo() procedure }
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
WriteClassInfo(PrintDialog1); { Call the WriteClassInfo() procedure but pass}
end; { the TPrintDialog to show its ancestry }
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
WriteClassInfo(FontDialog1); { Call the WriteClassInfo() procedure, but }
end; { pass the TFontDialog to display its class ancestry }
procedure TForm1.FormActivate(Sender: TObject);
begin
WriteClassInfo(Edit1); { Call the WriteClassInfo() procedure }
end;
end.
unit Editsho0;
interface
uses WinTypes,WinProcs,Classes,Forms,Controls,StdCtrls,TypInfo, Buttons, sysutils, Dialogs,Graphics;
type
TForm1 = class(TForm)
Edit1, Edit2, Edit3, Edit4, Edit5, Edit6, Edit7: TEdit;
Button1, Button2, Button3: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private { Private declarations }
public { Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
begin
for i := 0 to ComponentCount - 1 do begin { Look at each component on the form }
if Components[i] is TEdit then { is the component a TEdit ? }
with TEdit(Components[i]) do begin { typecast and use the with construct }
if ReadOnly = false then { if the TEdit is readonly then set its text }
Text := 'Comp Index: '+ inttostr(ComponentIndex) { to display its ComponentIndex value }
else { otherwise display its name }
Text := Name;
ReadOnly := not(ReadOnly); { reverse the TEdit's readonly flag }
end; { with }
if Components[i] is TButton then { if the component is a TButton }
with TButton(Components[i]) do { typcast it as such and use the with construct }
if Caption = 'Edit Mode' then { Check the button's caption and change it depending }
Caption := 'Read Only' { on its existing caption }
else if Caption = 'Read Only' then
Caption := 'Edit Mode';
end; { for }
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if findComponent('MyEdit') = nil then begin { if the component who's name is 'MyEdit' is not }
with TEdit.Create(self) do begin { present, create a new one }
Parent := self; { Assign the new TEdit's parent property to the form }
Left := 288; { as reference by the implicit self parameter. }
Name := 'MyEdit'; { Set MyEdit's name accordingly }
Text := 'MyEdit'; { Set MyEdit's text property to show its name }
Top := 312; { specify the coordinates. to place teh edit control }
Width := 121;
Height := 24;
Visible := true; { Set the Visible property to true so that it will display. }
end;
end;
Label1.Caption := 'ComponentCount: '+IntToStr(ComponentCount);
{ Now show the new component count }
end;
procedure TForm1.Button3Click(Sender: TObject);
begin { Free the component named 'MyEdit' }
FindComponent('MyEdit').Free; { Show the new component count }
Label1.Caption := 'ComponentCount: '+IntToStr(ComponentCount);
end;
procedure TForm1.FormShow(Sender: TObject);
begin { Show the new component count }
Label1.Caption := 'ComponentCount: '+IntToStr(ComponentCount);
end;
end.
unit Password;
interface
uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, StdCtrls, Buttons;
type
TPasswordDlg = class(TForm)
Label1: TLabel;
Password: TEdit;
OKBtn: TBitBtn;
CancelBtn: TBitBtn;
private { Private declarations }
public { Public declarations }
end;
TPasswordDialog = class(TComponent)
private
PasswordDlg: TPasswordDlg; { An instance of TPasswordDlg }
FThePassWord: string; { Place holder for the password }
public
function Execute: Boolean; { method to display the dialog }
published { A property to access FThePassWord }
property ThePassword: string read FThePassWord write FThePassword;
end;
procedure Register; { Declare a Register procedure }
implementation
{$R *.DFM}
function TPasswordDialog.Execute: Boolean;
begin
PasswordDlg := TPasswordDlg.Create(application); { Instanciate the dialog }
try { Place code into a try..finally block }
Result := false; { Set to false by default }
with PasswordDlg do begin
if ShowModal = mrOk then { Show the form }
{ Result get set to true if the password entered is correct. }
Result := PasswordDlg.Password.Text = FThePassword;
end;
finally
PasswordDlg.Free; { Free the form }
end;
end;
procedure Register;
begin
RegisterComponents('Dialogs',[TPasswordDlg]); {Register the new component }
end;
register the class in the unit's initialization block
initialization
RegisterClasses([TPasswordDlg]); { Register the TPasswordDlg class }
end.
unit Pwtestu;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Password;
type
TForm1 = class(TForm)
PasswordDialog1: TPasswordDialog;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private { Private declarations }
public { Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
if PasswordDialog1.Execute then
ShowMessage('You Got It!')
else
ShowMessage('Sorry, wrong answer!');
end;
end.
TScreen Properties Meaning
ActiveForm indicates form that has focus
Cursor indicates shate of cursor
Cursors list of available cursors
FormCount # of available forms
Forms list of available forms
Fonts list of font names
Height height of Screen device in device pixels
PixelsPerInch # of pixels / inch on the Screen device
Width width of Screen device in device pixels
{$R CRHAIR.RES}
:
procedure TForm1.Button2Click(Sender : TObject);
var
HC : HCursor;
begin
HC := LoadCursor (system.hInstance, 'CROSSHAIR');
Screen.Cursors[crCrossHair] := HC;
Screen.Cursor := crCrossHair;
end;
TStringList - descendant of TStrings
var
MyStringList : TStringList;
begin
MyStringList := TStringList.Create;
:
MyStringList.Add('Mickey');
MyStringList.Add('Mouse');
:
Memo1.Lines.Assign(MyStrings);
ListBox1.Items.Assign(MyStrings);
procedure TForm1.TabSet1Change(Sender : TObject; NewTab : Integer; var AllowChange : Boolean);
begin
NoteBook1.PageIndex := NewTab
end;
procedure TDrag.Item1DragOver(Sender, Source : TObject; X,Y : integer; State : TDragState; var Accept : Boolean);
begin
Accept := (source is TMyItem)
end;
procedure TDrag.Item1DragDrop(Sender, Source : TObject; X,Y : integer);
begin
if Source is TMyItem then
Item1.Data := TMyItem(Source).Data
end;
procedure TDrag.Item1EndDrag(Sender, Target : TObject; X,Y : integer);
begin
if Target <> nil then
MessageDlg((Target as TMyItem).Name, mtInformation, [mbok], 0);
end;
TMsg = record hwnd : HWnd; {16-bit window handle respresents window, dialog box or control} message : Word; {constant value that represents the message} wParam : Word; {16-bit constant associated with the message, handle or control} lParam : Word; {32-bit pointer to data in memory} time : LongInt; {time mesage was created} pt : Tpoint; {position of mouse cursor when message was created} end;How the Windows Message System Works
TMessage = record Msg : Word; case Integer of 0 : ( WParam : Word; LParam : LongInt; Result : Longint); 1 : ( WParamLo : Byte; WParamHI : Byte; LParamLo : Word; LParamHi : Word; ResultLo : Word; ResultHi : Word); end;
Using Pens Pen.Color := clBlue; Pen.Color := TColor(RGB(Random(255), Random(255), Random(255)); Pen.Style psClear Invisible lines psDash Series of dashes psDashDot alternating dashes & dots psDashDotDot series of dash-dot-dot psDot Series of dots psInsideFrame lines within frame of closed shape psSolid solid line Pen.Width Pen.Mode pmBlack Always black 0 pmWhite Always white 1 pmNOP Unchanged D pmNOT Inverse of destination color not D pmCopy Color specified by source S pmNotCopy Inverse of S not S pmMergePenNot Comb. of S and inverse of D S or not D pmMaskPenNot comb. of colors common to S and inverse of D S and not D pmMergeNotPen comb. of D and inverse of S not S or D pmMaskNotPen comb. of colors common to D and inverse of S not S and D pmMerge comb. of S and D S or D pmNotMerge inverse of pmMerge not (S or D) pmMask comb. of colors common to S and D S and D pmNotMask inverse of pmMask not (S and D) pmXor comb. of colors in either S or D but not both S XOR D pmNotXor inverse of pmXor not (S XOR D) Using Brushes Color Bitmap (can use to create custom patterns for background) Style (bsSolid, bsClear, bsCross, bsBDiagonal, bsFDiagonal, bsDiagCross, bsHorizontal, bsVertical) Using Fonts Color Name (e.g. ‘New Times Roman') Size Height Style (fsBold, fsItalic, fsUnderline, fsStrikeout) Using Canvas's Drawing Methods Drawing Lines Canvas.MoveTo(0, 0); {moves to a position without drawing} Canvas.LineTo(ClientWidth, ClientHeight); {draws from current position} Drawing Shapes Arc(), Chord(), Ellipse(), Pie(), Polygon(), Polyline(), Rectangle(), RoundRectange() Canvas.Ellipse(0, 0, ClientWidth, ClientHeight); Canvas.Polyline([Point(0,0), Point(120,30), Point(250,120), Point(140,200)]); Displaying Text with the Canvas TextOut(), TextRect(), Draw(), Copy(), CopyRect(), StretchDraw() Using Canvas's Pixels Canvas.Pixels[10, 10] := clBlue; Delphi's Representation of Pictures: TImage TImage component represents a graphical image that can be displayed on a form image data (bitmap file(BMP), metafile(WMF), icon file(ICO)) stored in Picture property TPicture is a container class for TGraphic ex. MyImage.Picture.LoadFromFile(‘Filename.bmp'); TBitMap encapsulates Windows HBITMAP & HPALETTE ex. MyBitMap := TBitMap.Create; MyBitMap.LoadFromFile(‘MyBMP.BMP');
var R1 : TRect; begin with R1 do begin Top := 0; Bottom := MyBitMap.Height; Left := 0; Right := MyBitMap.Width; end; Canvas.CopyRect(ClientRect, MyBitMap.Canvas, R1) end;
Using GDI Functions DrawText(DeviceContext, StrPtr, nbrBytesInString, RectPtr, Format); Canvas.Rectangle(8, 8, 82, 102); RPtr := Rect(10, 10, 80, 100); MyOutText := StrNew(‘Delphi, It'‘s going to change the way we program'); DrawText(Canvas.Handle, MyOutText, -1, RPtr, dt_WordBreak or dt_Center); StrDispose(MyOutText); Coordinate Systems and Mapping Modes Device coordinates - refer to the device on which Windows is running (printer, monitor) & is in pixels starting at top left corner (0,0) Logical coordinates - refer to coordinate system used by any area in windows that has a device context (screen, form client) and can be in any units Mapping Modes : MM_ANISOTROPIC, MM_HIENGLISH, etc. Advanced Fonts 2 types - GDI fonts (.FON for raster & vector fonts; .TOT and .TTF for true-type) device fonts (specific to particular device, i.e. printer) typeface - font's style and size Font Families Decorative, Modern, Roman(serif), Script, Swiss (san-serif) size: 1 point = 1/72 of an inch GDI Font Categories Raster Fonts - bitmaps provided for specific resolutions (aspect ratio) and font size Vector Fonts - series of lines created by GDI functions True Type Fonts - use collection of points and hints (algorithms) Creating Your Own Fonts see project FONTPROJ.DPR Message-Specific Records
TWMMouse = record Msg : TMsgParam; Keys : Word; case Integer of 0: ( XPos : integer; YPos : integer); 1 : ( Pos : TPoint; Result : integer) end;
Handling Messages message-handling procedure: must be a method of an object must take one var parameter of a TMessage or other message-specific record type must use message directive followed by the constant value of the message
private procedure WMPaint(var Msg : TWMPaint); message wm_Paint; : procedure TForm1.WMPaint(var Msg : TWMPaint); begin MessageBeep(0); inherited {passes message on to the ancestor object's handler} end;
if inherited is omitted, wm_Paint message not handled and system may crash Sending Your Own Messages function Perform(Msg, WParam : Word; LParam : Longint) : longint; Retval := objectname.Perform(MessageId, wParam, lParam); where objectname is a descendant of TControl (Perform uses object's Dispatch() method to send the message) function SendMessage() and PostMessage() are used if there is no Delphi object instance SendMessage sends the message and waits for the message to be processed, PostMessage puts message into queue Non-Standard Messages Notification Messages - sent to parent window from child window (buttons, etc.) User-Defined Messages - within own applications (must select message value>= wm_User Anatomy of a Message System: VCL
Message ----> SomeClass.WndProc | | Dispatch | --------------------------- | | Message Handler Message Handler | | Default HandlerTest with program CATCHIT.DPR (Listing 9.2 & 9.3)
Relationship Between Messages and Events
VCL Event Windows Message | |
---|---|
OnActivate | wm_Activate |
OnClick | wm_XButtonDown |
OnCreate | wm_Create |
onDblClick | wm_XButtonDblClick |
onKeyDown | wm_KeyDown |
onKeyPress | wm_Char |
onKeyUp | wm_KeyUp |
onPaint | wm_Paint |
onResize | wm_Size |
onTimer | wm_Timer |
Inherit From To Create | |
---|---|
An existing component | a modified version of a working component |
TGraphicControl | a graphical component that does not require input focus |
TWinControl | a component that rquires a window handle or to create a wrapper for an existing windows customcontrol |
TCustomControl | an original component |
TComponent | a nonvisual component |
What goes in a component? Removing dependencies properties, events, and methods graphics encapsulation registration
type TSkeletonComponent = class(TComponent) private { Private declarations } FNewProp : TPropType; {Property value for Internal data} FRunTimeProp : TPropType; {Run-time property value} FOnNewEvent : TEventType; {Internal method pointer for event} function GetNewProp : TPropType; {ACCESS METHODS} procedure SetNewProp(Value : TPropType); procedure SetRunTimeProp(Value : TPropType); protected { Protected declarations } property NewProp : TPropType read GetNewProp write SetNewProp; property Height; {redeclares property} property OnNewEvent : TEventType read FOnNewEvent write FOnNewEvent; property OnClick; {redeclares Event} public { Public declarations } constructor Create( AOwner : TComponent); override; destructor Destroy; override; procedure NewMethod; {implements behavior} procedure NewEvent; {invokes OnNewEvent Event} property RunTimeProp : TPropType read FRunTimeProp write SetRunTimeProp; published { Published declarations } end; procedure Register; implementation procedure Register; begin RegisterComponents('Samples', [TSkeletonComponent]); end; end.
ex. TRunButton TTabListbox TMarqueeLevels of object-part protection
Protection Used for
Minimize Method Interdependencies create component in a valid state never impose an order in which methods must be called avoid methods that invalidate other methods or properties Always create test project for your new components. Never try to do initial testing on a component by adding it to the Component Palette.
Using the Component choose Options | Install Components click Add button & enter full path name of the unit containing the component (COMPLIB.DCL is backed up to COMPLIB.~DC) create an icon using Image Editor in a DCR file with the bitname in all caps and the same as the file name and the component
--------------------------------------------------------------------------------- Property Purpose --------------------------------------------------------------------------------- Aborted Boolean that determines whether print job has been aborted Canvas Printing surface for current page Fonts Contains list of fonts supported by printer Handle unique number representing the printer's device context Orientation poLandscape or poPortrait PageHeight in pixels PageNumber indicates page being printed (incremented by TPrinter.NewPage) PageWidth in pixels PrinterIndex indicates selected printer Printing Boolean that determines whether print job is printing Title text appearing on Print Manager and networked pages ------------------------------------------------------------------------------------------------- ----------------------------------------------------------------------------------------- Method Purpose ----------------------------------------------------------------------------------------- Abort Terminates print job BeginDoc begins a print job EndDoc ends a prints job when printing is finished GetPrinter retrieves the current printer NewPage forces printing of a new page & increments PageNumber SetPrinter specifies a printer as the current printer ------------------------------------------------------------------------------------------
TPrinter.Canvas drawing to printer is not dynamic drawing to printer is not instantaneous (must allow abort) different printers support different resolutions printers can run out of paper printer output must be adjusted for size Simple PrintingPrinting a TMemo Component
procedure TEditForm.Print1Click(Sender : TObject); var i : integer; MemoText : TextFile; begin if PrintDialog1.Execute then AssignPrn(MemoText); try Rewrite(MemoText); Printer.Canvas.Font.Assign(Memo1.Font); for i := 0 to Memo1.Lines.Count - 1 do writeln(MemoText, Memo1.Lines[i]); finally CloseFile(MemoText) end;Printing a Bitmap
procedure TBMPForm.Print1Click(Sender : Object); var GRect : TRect; SizeRAtio : Double; begin if PrintDialog1.Execute then begin SizeRatio := Image1.Picture.Height / Image1.Picture.Width; GRect := Rect(0, 0, Printer.PageWidth, trunc(Printer.PageHeight * SizeRatio) - GetDeviceCaps(Printer.Handle, LOGPIXELSX)); with Printer do begin BeginDoc; Canvas.Rectangle( GRect.Left, Grect.Top, GRect.Right, GRect.Bottom); GRect := Rect(GRect.Left+10, Grect.Top+10, GRect.Right-10, GRect.Bottom-10); Canvas.StretchDraw(GRect, Image1.Picture.Graphic); EndDoc end; end end;Printing a Form
procedure TForm1.PrintMyForm(Sender : TOject); begin Print end;
Advanced Printing Printing a Columnar Report see PRNPAGE.DPR project Aborting the Printing Process establish an event that when activated, calls Printer.Abort, aborting the printing check if TPrinter.Aborted = true before calling any of TPrinter's print functions end printing logic by checking value of TPrinter.Aborted see ABORTBX.PAS for Abort Form code Printing Envelopes identify each element to be printed to the destination surface identify unit of measurement for destination identify unit of measurement for each element to be plotted decide common unit of measurement (usually pixels) write routine to perform units conversion write routines to calculate size for each element to be printed write routines to calculate position of each element write printing function see ENVLOPE.DPR project A Simple Print Preview
TPrintPrevPanel = class(TPanel) public property Canvas; {publicize this property} end;
Chapter 14 - Sharing Information with the ClipBoard and DDE
Using the ClipBoard with Text procedure TEditForm.Cut1Click(Sender: TObject); begin Memo1.CutToClipBoard end; procedure TEditForm.Copy1Click(Sender: TObject); begin Memo1.CopyToClipBoard end; procedure TEditForm.Paste1Click(Sender: TObject); begin Memo1.PasteFromClipBoard end; procedure TEditForm.Delete1Click(Sender: TObject); begin Memo1.ClearSelection end; procedure TEditForm.SelectAll1Click(Sender: TObject); begin Memo1.SelectAll end; Using the ClipBoard with Images procedure TBMPForm.Copy1Click(Sender: TObject); begin ClipBoard.Assign(Image1.Picture) end; procedure TBMPForm.Paste1Click(Sender: TObject); begin if ClipBoard.HasFormat(CF_BITMAP) or ClipBoard.HasFormat(CF_PICTURE) then begin Image1.Picture.Assign(ClipBoard); ClientWidth := Image1.Picture.Width; VertScrollBar.Range := Image1.Picture.Height; HorzScrollBar.Range := Image1.Picture.Width; end end; Creating Your Own Clipboard Format see lab 5 Dynamic Data Exchange (DDE) allows data to shared between applications in real-time without relying on the clipboard Communication Among Applications TDDEClientConv - establishes link with DDE server applications TDDEClientItem - establishes link to item of a DDE client application TDDEServerConv - establishes link with DDE client applications TDDEServerITem - establishes link to item of a DDE server application DDE Service - DDE server application name (executable filename minus .EXE) DDE Topics - refers to data unit containing the linked information DDE Items - actual pieces of data to be sent to a DDE client application Creating a DDE Server Project Place a TDDEServerItem component and a TEdit component on a form Place the following code in the Edit1's OnChange event handler DDEServerItem1.Text := Edit1.Text; Add a TButton and enter the following for it's OnClick event handler: DDEServerItem1.CopyToClipBoard; Creating a DDE Client Project Place a TDDEClientItem, a TDDEClientConv and a TEdit component on a form Connect TDDEClientItem to TDDEClientConv through its DDEConv property Place the following code in the DDEClientItem's event handler Edit1.Text := DDEClientITem1.Text; Establishing Links with a DDE Server Set DDEClientConv's ConnectMode property to ddeAutomatic Switch to the Server application and press the Copy to Clipboard button Switch back to the Client and select the DDEClientConv component. Set the DDEService and DDETopic properties by pressing either's ellipse button in the Object Inspector Press Paste Link and the approriate values are copied from the Clipboard into DDEService and DDETopic. Set DDEClientItem1's DDEItem property to DDEServerItem1 Run both projects and watch what happens when you change the contents of the Server's edit box. This same process can be accomplished during runtime with the following code: DDEClientConv1.SetLink(‘DDESERV', ‘Form1'); DDEClientItem1.DDEItem := ‘DdeServerItem1'; Using TDDEServerConv Component This is used if 1) the server application's caption changes. 2) the client application sends macro commands to the server Executing Macros Creating a Project Add TListbox & TDDEClientConv Add OnCreate event for form: OpenDialog1.Filter := 'Executable *.EXE|*.exe'; Add Add Item button and its event: if OpenDialog1.Execute then ListBox1.Items.Add(OpenDialog1.FileName) Add CreateGroup button and its event: with DDEClientConv1 do begin SetLink('PROGMAN', 'PROGMAN'); ExecuteMacro(DDECreateGroup, False); ExecuteMacro(DDEShowGroup, False); with ListBox1 do for i := 0 to Items.Count - 1 do AddItem(Items[i]); CloseLink end Add string constants: DDECreateGroup = '[CreateGroup(DDG)]'; DDEShowGroup = '[ShowGroup(DDG, 1)]'; DDEAddItem = '[AddItem(%s, "DDGITEM", %s)]'; Add AddItem private method: with DDEClientConv1 do begin Temp1 := Format(DDEAddItem, [ItemToAdd, ItemToAdd]); StrPCopy(Temp2, Temp1); if not ExecuteMacro(Temp2, False) then MessageDlg('Item could not be created', mtWarning, [mbok], 0) end Run the program to create a new program group with program items in it.
Chapter 15 - Object Linking and Embedding with OLE
OLE Basics OLE object - data shared between applications OLE containers - applications having the capability to contain OLE objects OLE servers - applications having the capability to their data contained within an OLE container compound document - document containing multiple OLE objects linked objects are stored in a disk file; when one app. modifies the linked object, it is reflected in all other objects with links to the object embedded objects are stored by the OLE container app. and only the container app. can modify the OLE object in OLE 1, when an object is activated, the server app. starts up, receives focus and the OLE object appears in the server app. in OLE 2, when an object is activated, the server app. becomes active "inside" the container app. (menus and SpeedBars are merged) component object model is an API spec that provides a standard interface for component objects; provided by COMPOBJ.DLL OLE 2's marshalling mechanism handles intricacies of calling functions across process boundaries OLE 2 uses structured storage for storing storage objects in a file and uses STORAGE.DLL for navigating among the storage objects uniform data transfer governs data transfer through the Clipboard, drag-and-drop, DDE and OLE; data object is aware of its important properties TOleContainer A Small Sample Application Drop a TOleContainer onto a new form. Click the ellipses next to the ObjClass in the Object Inspector 1) Selecting a server application embeds a new OLE object 2) Select the Create From File radio button and select an existing file, i.e. c:\delphi\bin\deploy.txt embeds the object and its server into the container A Bigger Sample Application see lab 6
You should know how to use the following components: TForm, TScreen, TApplication, TmainMenu, Tbutton, Tlabel, Tpanel, Tspeedbutton, Tstrings, Tcanvas, Tprinter, Dialogs, Timage, TDDEServer, TDDEClient, ToleContainer, TBitButton
Chapter 16 Writing Database Applications
The Borland Database Engine
BDE allows navigable SQL-tables and queries. [Can communicate with Paradox, dBase, ODBC, and SQL-server databases]TDataset
Chapter 17 Working with SQL and the TQuery Component
What is SQL? SQL (Structured Query Language) is an industry standard database-manipulation command set. Databases Record-oriented = tools for navigating, retrieving and saving data work directly with the table Set-oriented = tools work with a subset of the table's records SQL Statements SQL.Clear = Clears contents of SQL property SQL.Add= Adds an SQL statement to the SQL Property Static SQL Statement: SELECT * FROM PARTS Dynamic SQL Statement SELECT * FROM PARTS WHERE PARTNO = :SomeValue Sorting the Data SELECT * FROM PARTS ORDER BY VENDORNO SQL.INSERT = inserts a new record into a database INSERT INTO ADDRESS (LAST_NAME, CITY, STATE) VALUES (:NAME, :CITY, :STATE) SQL.DELETE = deletes the specified record from a database DELETE FROM ADDRESS WHERE LAST_NAME = :NAME Joining Tables = combines records from multiple tables SELECT P.PARTNO, P.DESCRIPTION, I.QTY FROM PARTS P, ITEMS I WHERE P.PARTNO = I.PARTNO Joining Tables from tables on different servers SELECT PARTS.DESCRIPTION, ITEMS.ORDERNO FROM :SOMEALIAS.PARTS, :SOMEOTHERALIAS.ITEMS Creating Tables CREATE TABLE "TESTTBL.DB" ( FIELD_1 CHAR[20], FIELD_2 NUMERIC(5,2) ) NOTES a. Use an input box as a quick prompt i. Input := InputBox('Order No', ‘Enter the Vendor #', ‘ '); b. Set the SQL property before calling Prepare i. SQL.Add.... ii. Prepare; iii. Params[0].AsInteger := IVal; Using TQuery's DataSource Property c. Place 2 TQuerys, TDataSources, PTDBGrids & TLabels d. Link the 1's and 2's together and align both sets to the bottom (Both DataNames are DBDEMOS) e. Use Query2's SQL property String List Editor SELECT * FROM CUSTOMER f. Use Query1's SQL property String List Editor SELECT * FROM ORDERS WHERE CUSTNO = :CUSTNO
1) Portability vs. Optimization: Will the application require any special server-specific SQL syntax? 2) Transactions: What kind of transaction control will the application require? 3) Server features: Will the application require the use of server features such as stored procedures? How will these be used? 4) Connectivity: What communications protocol will the application use? Does the application need to be deployed to support multiple communication protocols? 5) Deployment: What executables, libraries, and other files does the application require and how are these delivered to the end user?
FIRST_NAME LAST_NAME MIDDLEINIT ADDR1 ADDR2 CITY STATE ZIP PHONE1 PHONE2 FAX BUSINESS (L indicator) BUSNAME BUSCONTACT STATES.DB STATE_ABBR STATE_NAME
2 TTable, 2 TDataSource (with AutoEdit turned false to prevent changes to DBEdits) DBEdits, and 2 TDBLookupCombo (LupStates & LupLastName)Using the TDBLookupCombo Component displays values from a dataset
LupStates.DataSource = AddressDS LupStates.DataField = STATES LupStates.LookupDisplay = State_Name LupStates.LookupField = State_Abbr LupStates.LookupSource = StatesDS LupLastName.LookupDisplay = LAST_NAME LupLastName..LookupField = LAST_NAME LupLastName..LookupSource = AddressDS procedure TAddrForm.LupLastNameChange(Sender: TObject); begin { When the lookuplist changes (the user selected another name ), set AddressTable} { to that record. LupLastName is a lookup combo box who's LookupDataSource is } { connected to AddressTable, therefore, its normal behavior doesn't affect AddressTable's} { Current record. This is one way to have it reposition the current record for AddressTable} with AddressTable do begin SetKey; AddressTable.FieldByName('Last_Name').AsString := LupLastName.Value; GoToKey; end end;
* CREATE TABLE CUSTOMER (CUSTOMER_ID INTEGER NOT NULL, FNAME DNAME NOT NULL, LNAME DNAME NOT NULL, CREDIT_LINE DCREDITLINE NOT NULL, WORK_ADDRESS DADDRESS, ALT_ADDRESS DADDRESS, CITY DCITY, STATE DSTATE, ZIP DZIP, WORK_PHONE DPHONE, ALT_PHONE DPHONE, COMMENTS BLOB SUB_TYPE TEXT SEGMENT SIZE 80, COMPANY VARCHAR(40), CONSTRAINT PCUSTOMER_ID PRIMARY KEY (CUSTOMER_ID));
* CREATE PROCEDURE SALES_REPORT AS BEGIN EXIT; END ^ ALTER PROCEDURE SALES_REPORT (START_DATE DATE, END_DATE DATE) RETURNS (PART CHAR(10), QUANTITY INTEGER) AS BEGIN FOR SELECT PART_NUMBER, QUANTITY_SOLD FROM SALE WHERE ((SALE_DATE >= :START_DATE) AND (SALE_DATE <= :END_DATE) INTO :PART, QUANTITY DO SUSPEND; END ^
Linking to Data ---------------------------------------------------------------------------------------------- Type Name Purpose ---------------------------------------------------------------------------------------------- TTable CustomerTable Links to CUSTOMER table SaleTable Links to SALES table PartTable Links to PARTS table TQuery CustQuery Queries on CUSTOMER data RptQuery Queries used for reporting stored procedures TDataBase AutoPartsDatabase Creates a persistent link to SALES database TDataSource DataSource 1-4 Links TTables and RptQuery to data-aware controls AutoPartsDatabase.Alias = SalesDB [established for SALES.GDB] CustomerTable.DatabaseName = SalesDB
procedure TMainForm.LoginUser; {ensures that user must login before accessing the database} begin try AutoPartsDatabase.Open; CustomerTable.Open; PartTable.Open; SaleTable.Open; Notebook1.ActivePage := 'Customer'; Panel2.Caption := IntToStr(CustomerTable.RecordCount) + ' Records'; EnableMenuItems(True); except { If user not able to login, display the reason and show logged out page } on E:EDBEngineError do begin MessageDlg(E.Message, mtError, [mbOK], 0); Notebook1.ActivePage := 'Logged Out'; EnableMenuItems(False); StatusPanel.Caption := ''; Panel2.Caption := ''; Panel3.Caption := ''; end; end; end;
procedure TMainForm.AutoPartsDatabaseLogin(Database: TDatabase; LoginParams: TStrings); { Receives a user name and password to log into the Sales database. If user } { name or password are incorrect, display the logged out user screen. } begin if PasswordDlg.GetPassword then begin { Set login params from PasswordDlg } LoginParams.Values['USER NAME'] := PasswordDlg.UName.Text; LoginParams.Values['PASSWORD'] := PasswordDlg.PWord.Text; end; { If the user is SYSDBA show supervisor information. } if UpperCase(PasswordDlg.UName.Text) = 'SYSDBA' then begin Supervisor := True; Panel3.Caption := 'User: SYSDBA Supervisor'; end else begin { If user is not SYSDBA show user information. } Supervisor := False; Panel3.Caption := 'User: ' + PasswordDlg.UName.Text + ' Employee'; end; end;
procedure TMainForm.NewPartClick(Sender: TObject); { Adds a new part to the part table. } begin EnableMenuItems(False); NoteBook1.ActivePage := 'Parts'; { Place a new record into the table. } PartTable.Insert; end;
procedure TMainForm.EnableMenuItems(EnableThem: Boolean); { Receives a boolean value which determines enable / disable of menu items. } begin New1.Enabled := EnableThem; Browse1.Enabled := EnableThem; Search1.Enabled := EnableThem; Accounting1.Enabled := EnableThem; end;
procedure TMainForm.PartSaveBtnClick(Sender: TObject); { Saves a newly added or updated part. } var Mode: String; begin Mode := TableState(PartTable); PartTable.Post; PartTable.Refresh; { must Refresh because trigger modifies data } PartSaveBtn.Visible := False; PartCancelBtn.Visible := False; EnableMenuItems(True); StatusPanel.Caption := Format('%s Saved', [Mode]); PartNavigator.Enabled := True; end;
procedure TMainForm.SearchPartClick(Sender: TObject); { Search for a specific part and display part information. } var PartNumber: string; begin NoteBook1.ActivePage := 'Parts'; PartNumber := ''; { Get the part number to be searched on. } if InputQuery('Part Search', 'Please Enter a Part Number', PartNumber) then if not PartTable.FindKey([PartNumber]) then { Try to find the part. } MessageDlg('Part number not found', mtInformation, [mbOk], 0); end;
procedure TMainForm.RunRptBtnClick(Sender: TObject); var StartDate, EndDate: String; begin StatusPanel.Caption := 'Running Report'; if ComboBox1.Items.Strings[ComboBox1.ItemIndex] = 'Past Due' then begin StartDate := ''; EndDate := ''; if InputQuery('Start Date', 'Enter beginning sales date', StartDate) and InputQuery('End Date', 'Enter ending sales date', EndDate) then begin with RptQuery do begin Close; SQL.Clear; SQL.Add('Select * from SALES_REPORT(:START, :END);'); Prepare; Params[0].AsDate := StrToDate(StartDate); Params[1].AsDate := StrToDate(EndDate); Open; end; end; end else MessageDlg(Format('%s Report has not been implemented', [ComboBox1.Items.Strings[ComboBox1.ItemIndex]]), mtInformation, [mbOk], 0); StatusPanel.Caption := 'Report Done'; end;
TProgMan = class(TComponent) private FDdeClientConv: TDdeClientConv; procedure InitDDEConversation; function ExecMacroString(Macro: String): Boolean; public { Public declarations } constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure CreateGroup(GroupName: String); procedure DeleteGroup(GroupName: String); procedure DeleteItem(ItemName: String); procedure AddItem(CmdLine, ItemName: String); end;
[General] Program=Auto Inventory Manager Version=Version 1.0 Copyright=Copyright (c) 1995 - Steve Teixeira and Xavier Pacheco NumDisks=4 InstallBDE=1 InstallSQL=1 DefaultDir=c:\sales\ PMGroup=Auto Inventory Manager [SubDirs] 0=iblocal [Disk1] sales.exe=i sales.gdb=i ctl3dv2.dll=s interbas.log=0 interbas.msg=0 isc4.gdb=0 isc_lic.dat=0 [Disk2] ibmgr.exe=0 blint04.hlp=0 comdiag.hlp=0 comdiag.ini=0 comdiag.exe=0 dsql.dll=0 fileio.dll=0 [Disk3] gback.dll=0 gds.dll=0 intl.dll=0 iutls.dll=0 remote.dll=0 stack.dll=0 sqlref.hlp=0 [Disk4] jrd.dll=0 svrmgr.hlp=0 wisql.exe=0 wisql.hlp=0 [PMGroup] sales.exe=i