Programlama yapalım ve Öğrenelim.

neoturk: ...Currency edit component ?...

unit CurrEdit;

(**************************************************************************

This is my first custom control, so please be merciful. I needed a simple

currency edit field, so below is my attempt. It has pretty good behavior

and I have posted it up to encourage others to share their code as well.

Essentially, the CurrencyEdit field is a modified memo field. I have put

in keyboard restrictions, so the user cannot enter invalid characters.

When the user leaves the field, the number is reformatted to display

appropriately. You can left-, center-, or right-justify the field, and

you can also specify its display format - see the FormatFloat command.

The field value is stored in a property called Value so you should read

and write to that in your program. This field is of type Extended.

If you like this control you can feel free to use it, however, if you

modify it, I would like you to send me whatever you did to it. If you

send me your CIS ID, I will send you copies of my custom controls that

I develop in the future. Please feel free to send me anything you are

working on as well. Perhaps we can spark ideas!

Robert Vivrette, Owner

Prime Time Programming

PO Box 5018

Walnut Creek, CA 94596-1018

Fax: (510) 939-3775

CIS: 76416,1373

Net: RobertV@ix.netcom.com

Thanks to Massimo Ottavini, Thorsten Suhr, Bob Osborn, Mark Erbaugh, Ralf

Gosch, Julian Zagorodnev, and Grant R. Boggs for their enhancements!

Please look for this and other components in the "Unofficial Newsletter of

Delphi Users" posted on the Borland Delphi forum on Compuserve (GO DELPHI)

in the "Delphi IDE" file section.

**************************************************************************)

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

Menus, Forms, Dialogs, StdCtrls;

type

TCurrencyEdit = class(TCustomMemo)

private

DispFormat: string;

FieldValue: Extended;

FDecimalPlaces : Word;

FPosColor : TColor;

FNegColor : TColor;

procedure SetFormat(A: string);

procedure SetFieldValue(A: Extended);

procedure SetDecimalPlaces(A: Word);

procedure SetPosColor(A: TColor);

procedure SetNegColor(A: TColor);

procedure CMEnter(var Message: TCMEnter); message CM_ENTER;

procedure CMExit(var Message: TCMExit); message CM_EXIT;

procedure FormatText;

procedure UnFormatText;

protected

procedure KeyPress(var Key: Char); override;

procedure CreateParams(var Params: TCreateParams); override;

public

constructor Create(AOwner: TComponent); override;

published

property Alignment default taRightJustify;

property AutoSize default True;

property BorderStyle;

property Color;

property Ctl3D;

property DecimalPlaces: Word read FDecimalPlaces write SetDecimalPlaces default 2;

property DisplayFormat: string read DispFormat write SetFormat;

property DragCursor;

property DragMode;

property Enabled;

property Font;

property HideSelection;

property MaxLength;

property NegColor: TColor read FNegColor write SetNegColor default clRed;

property ParentColor;

property ParentCtl3D;

property ParentFont;

property ParentShowHint;

property PopupMenu;

property PosColor: TColor read FPosColor write SetPosColor default clBlack;

property ReadOnly;

property ShowHint;

property TabOrder;

property Value: Extended read FieldValue write SetFieldValue;

property Visible;

property OnChange;

property OnClick;

property OnDblClick;

property OnDragDrop;

property OnDragOver;

property OnEndDrag;

property OnEnter;

property OnExit;

property OnKeyDown;

property OnKeyPress;

property OnKeyUp;

property OnMouseDown;

property OnMouseMove;

property OnMouseUp;

end;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents('Additional', [TCurrencyEdit]);

end;

constructor TCurrencyEdit.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

AutoSize := False;

Alignment := taRightJustify;

Width := 121;

Height := 25;

DispFormat := '$,0.00;($,0.00)';

FieldValue := 0.0;

FDecimalPlaces := 2;

FPosColor := Font.Color;

FNegColor := clRed;

AutoSelect := False;

{WantReturns := False;}

WordWrap := False;

FormatText;

end;

procedure TCurrencyEdit.SetFormat(A: String);

begin

if DispFormat <> A then

begin

DispFormat:= A;

FormatText;

end;

procedure TCurrencyEdit.SetFieldValue(A: Extended);

begin

if FieldValue <> A then

begin

FieldValue := A;

FormatText;

end;

procedure TCurrencyEdit.SetDecimalPlaces(A: Word);

begin

if DecimalPlaces <> A then

begin

DecimalPlaces := A;

FormatText;

end;

procedure TCurrencyEdit.SetPosColor(A: TColor);

begin

if FPosColor <> A then

begin

FPosColor := A;

FormatText;

end;

procedure TCurrencyEdit.SetNegColor(A: TColor);

begin

if FNegColor <> A then

begin

FNegColor := A;

FormatText;

end;

procedure TCurrencyEdit.UnFormatText;

var

TmpText : String;

Tmp : Byte;

IsNeg : Boolean;

begin

IsNeg := (Pos('-',Text) > 0) or (Pos('(',Text) > 0);

TmpText := '';

For Tmp := 1 to Length(Text) do

if Text[Tmp] in ['0'..'9',DecimalSeparator] then

TmpText := TmpText + Text[Tmp];

try

If TmpText='' Then TmpText := '0.00';

FieldValue := StrToFloat(TmpText);

if IsNeg then FieldValue := -FieldValue;

except

MessageBeep(mb_IconAsterisk);

end;

procedure TCurrencyEdit.FormatText;

begin

Text := FormatFloat(DispFormat,FieldValue);

if FieldValue < 0 then

Font.Color := NegColor

else

Font.Color := PosColor;

end;

procedure TCurrencyEdit.CMEnter(var Message: TCMEnter);

begin

SelectAll;

inherited;

end;

procedure TCurrencyEdit.CMExit(var Message: TCMExit);

begin

UnformatText;

FormatText;

Inherited;

end;

procedure TCurrencyEdit.KeyPress(var Key: Char);

Var

S : String;

frmParent : TForm;

btnDefault : TButton;

i : integer;

wID : Word;

LParam : LongRec;

begin

{#8 is for Del and Backspace keys.}

if Not (Key in ['0'..'9','.','-', #8, #13]) Then Key := #0;

case Key of

#13 : begin

frmParent := GetParentForm(Self);

UnformatText;

{find default button on the parent form if any}

btnDefault := nil;

for i := 0 to frmParent.ControlCount -1 do

if frmParent.Controls[i] is TButton then

if (frmParent.Controls[i] as TButton).Default then

btnDefault := (frmParent.Controls[i] as TButton);

{if there's a default button, then make the parent form think it was pressed}

if btnDefault <> nil then

begin

wID := GetWindowWord(btnDefault.Handle, GWW_ID);

LParam.Lo := btnDefault.Handle;

LParam.Hi := BN_CLICKED;

SendMessage(frmParent.Handle, WM_COMMAND, wID, longint(LParam) );

end;

Key := #0;

end;

{ allow only one dot in the number }

'.' : if ( Pos('.',Text) >0 ) then Key := #0;

{ allow only one '-' in the number and only in the first position: }

'-' : if ( Pos('-',Text) >0 ) or ( SelStart > 0 ) then Key := #0;

else

{ make sure no other character appears before the '-' }

if ( Pos('-',Text) >0 ) and ( SelStart = 0 ) and (SelLength=0) then Key := #0;

end;

if Key <> Char(vk_Back) then

begin

{S is a model of Text if we accept the keystroke. Use SelStart and

SelLength to find the cursor (insert) position.}

S := Copy(Text,1,SelStart)+Key+Copy(Text,SelStart+SelLength+1,Length(Text));

if ((Pos(DecimalSeparator, S) > 0) and

(Length(S) - Pos(DecimalSeparator, S) > FDecimalPlaces)) {too many decimal places}

or ((Key = '-') and (Pos('-', Text) <> 0)) {only one minus...}

or (Pos('-', S) > 1) {... and only at beginning}

then Key := #0;

end;

if Key <> #0 then inherited KeyPress(Key);

end;

procedure TCurrencyEdit.CreateParams(var Params: TCreateParams);

var

lStyle : longint;

begin

inherited CreateParams(Params);

case Alignment of

taLeftJustify : lStyle := ES_LEFT;

taRightJustify : lStyle := ES_RIGHT;

taCenter : lStyle := ES_CENTER;

end;

Params.Style := Params.Style or lStyle;

end;

end.

Delphi - .....................................

neoturk: ...How to match file date-time stamps ?...

Q: "How can I write a function that sets the date of one file equal to the

date of another file?"

A: No problem. Just use the following function, which takes two strings

representing full DOS path/file names. The file who's date you

wish to set is the second parameter, and the date you wish to set it to

is given by the file in the first parameter.

procedure CopyFileDate(const Source, Dest: String);

var

SourceHand, DestHand: word;

begin

SourceHand := FileOpen(Source, fmOutput); { open source file }

DestHand := FileOpen(Dest, fmInput); { open dest file }

FileSetDate(DestHand, FileGetDate(SourceHand)); { get/set date }

FileClose(SourceHand); { close source file }

FileClose(DestHand); { close dest file }

end;

Delphi - .....................................

neoturk: ...How to match file date-time stamps ?...

Q: "How can I write a function that sets the date of one file equal to the

date of another file?"

A: No problem. Just use the following function, which takes two strings

representing full DOS path/file names. The file who's date you

wish to set is the second parameter, and the date you wish to set it to

is given by the file in the first parameter.

procedure CopyFileDate(const Source, Dest: String);

var

SourceHand, DestHand: word;

begin

SourceHand := FileOpen(Source, fmOutput); { open source file }

DestHand := FileOpen(Dest, fmInput); { open dest file }

FileSetDate(DestHand, FileGetDate(SourceHand)); { get/set date }

FileClose(SourceHand); { close source file }

FileClose(DestHand); { close dest file }

end;

Delphi - .....................................

neoturk: ...How to copy files in delphi ?...

{This way uses a File stream.}

Procedure FileCopy( Const sourcefilename, targetfilename: String );

Var

S, T: TFileStream;

Begin

S := TFileStream.Create( sourcefilename, fmOpenRead );

try

T := TFileStream.Create( targetfilename,

fmOpenWrite or fmCreate );

try

T.CopyFrom(S, S.Size ) ;

finally

T.Free;

end;

finally

S.Free;

end;

End;

{This way uses memory blocks for read/write.}

procedure FileCopy(const FromFile, ToFile: string);

var

FromF, ToF: file;

NumRead, NumWritten: Word;

Buf: array[1..2048] of Char;

begin

AssignFile(FromF, FromFile);

Reset(FromF, 1); { Record size = 1 }

AssignFile(ToF, ToFile); { Open output file }

Rewrite(ToF, 1); { Record size = 1 }

repeat

BlockRead(FromF, Buf, SizeOf(Buf), NumRead);

BlockWrite(ToF, Buf, NumRead, NumWritten);

until (NumRead = 0) or (NumWritten <> NumRead);

CloseFile(FromF);

CloseFile(ToF);

end;

{This one uses LZCopy, which USES LZExpand.}

procedure CopyFile(FromFileName, ToFileName: string);

var

FromFile, ToFile: File;

begin

AssignFile(FromFile, FromFileName); { Assign FromFile to FromFileName }

AssignFile(ToFile, ToFileName); { Assign ToFile to ToFileName }

Reset(FromFile); { Open file for input }

try

Rewrite(ToFile); { Create file for output }

try

{ copy the file an if a negative value is returned }

{ raise an exception }

if LZCopy(TFileRec(FromFile).Handle, TFileRec(ToFile).Handle) < 0

then

raise EInOutError.Create('Error using LZCopy')

finally

CloseFile(ToFile); { Close ToFile }

end;

finally

CloseFile(FromFile); { Close FromFile }

end;

Delphi - .....................................

neoturk: ...How to copy files in delphi ?...

{This way uses a File stream.}

Procedure FileCopy( Const sourcefilename, targetfilename: String );

Var

S, T: TFileStream;

Begin

S := TFileStream.Create( sourcefilename, fmOpenRead );

try

T := TFileStream.Create( targetfilename,

fmOpenWrite or fmCreate );

try

T.CopyFrom(S, S.Size ) ;

finally

T.Free;

end;

finally

S.Free;

end;

End;

{This way uses memory blocks for read/write.}

procedure FileCopy(const FromFile, ToFile: string);

var

FromF, ToF: file;

NumRead, NumWritten: Word;

Buf: array[1..2048] of Char;

begin

AssignFile(FromF, FromFile);

Reset(FromF, 1); { Record size = 1 }

AssignFile(ToF, ToFile); { Open output file }

Rewrite(ToF, 1); { Record size = 1 }

repeat

BlockRead(FromF, Buf, SizeOf(Buf), NumRead);

BlockWrite(ToF, Buf, NumRead, NumWritten);

until (NumRead = 0) or (NumWritten <> NumRead);

CloseFile(FromF);

CloseFile(ToF);

end;

{This one uses LZCopy, which USES LZExpand.}

procedure CopyFile(FromFileName, ToFileName: string);

var

FromFile, ToFile: File;

begin

AssignFile(FromFile, FromFileName); { Assign FromFile to FromFileName }

AssignFile(ToFile, ToFileName); { Assign ToFile to ToFileName }

Reset(FromFile); { Open file for input }

try

Rewrite(ToFile); { Create file for output }

try

{ copy the file an if a negative value is returned }

{ raise an exception }

if LZCopy(TFileRec(FromFile).Handle, TFileRec(ToFile).Handle) < 0

then

raise EInOutError.Create('Error using LZCopy')

finally

CloseFile(ToFile); { Close ToFile }

end;

finally

CloseFile(FromFile); { Close FromFile }

end;

Delphi - .....................................

neoturk: ...Control font styles ?...

This code will change the font style of a Edit

when selected. This code could be implemented to

control font style on other objects.

With a Edit(Edit1) and a ListBox(ListBox1) on a form

Add the following Items to the ListBox:

fsBold

fsItalic

fsUnderLine

fsStrikeOut

procedure TForm1.ListBox1Click(Sender: TObject);

var

X : Integer;

type

TLookUpRec = record

Name: String;

Data: TFontStyle;

end;

const

LookUpTable: array[1..4] of TLookUpRec =

((Name: 'fsBold'; Data: fsBold),

(Name: 'fsItalic'; Data: fsItalic),

(Name: 'fsUnderline'; Data: fsUnderline),

(Name: 'fsStrikeOut'; Data: fsStrikeOut));

begin

X := ListBox1.ItemIndex;

Edit1.Text := ListBox1.Items[X];

Edit1.Font.Style := [LookUpTable[ListBox1.ItemIndex+1].Data];

end;

Delphi - .....................................

neoturk: ...Control font styles ?...

This code will change the font style of a Edit

when selected. This code could be implemented to

control font style on other objects.

With a Edit(Edit1) and a ListBox(ListBox1) on a form

Add the following Items to the ListBox:

fsBold

fsItalic

fsUnderLine

fsStrikeOut

procedure TForm1.ListBox1Click(Sender: TObject);

var

X : Integer;

type

TLookUpRec = record

Name: String;

Data: TFontStyle;

end;

const

LookUpTable: array[1..4] of TLookUpRec =

((Name: 'fsBold'; Data: fsBold),

(Name: 'fsItalic'; Data: fsItalic),

(Name: 'fsUnderline'; Data: fsUnderline),

(Name: 'fsStrikeOut'; Data: fsStrikeOut));

begin

X := ListBox1.ItemIndex;

Edit1.Text := ListBox1.Items[X];

Edit1.Font.Style := [LookUpTable[ListBox1.ItemIndex+1].Data];

end;

Delphi - .....................................

neoturk: ...What cd track am i on ?...

Here's an easy way to do it:

create a timer and put this code in the OnTimer event:

var Trk, Min, Sec: Word;

begin

with MediaPlayer1 do

begin

Trk:= MCI_TMSF_TRACK(Position);

Min:=MCI_TMSF_MINUTE(Position);

Sec:=MCI_TMSF_SECOND(Position);

Label1.Caption:=Format('%.2d',[Trk]);

Label2.Caption:=Format('%.2d:%.2d',[Min,Sec]);

end;

Add MMSystem to the uses clause in Unit1

This will show current track and time.

Hope it actually works?!?!

-------------------------------------

...Terminate running apps ?...

Q: How do I terminate all running tasks?

A: Below is some code that will help if you want to terminate ALL tasks,

no questions asked.

A word of caution, before you run this for the first time, make sure

that you save it and anything else that may have some pending data.

procedure TForm1.ButtonKillAllClick(Sender: TObject);

var

pTask : PTaskEntry;

Task : Bool;

ThisTask: THANDLE;

begin

GetMem (pTask, SizeOf (TTaskEntry));

pTask^.dwSize := SizeOf (TTaskEntry);

Task := TaskFirst (pTask);

while Task do

begin

if pTask^.hInst = hInstance then

ThisTask := pTask^.hTask

else

TerminateApp (pTask^.hTask, NO_UAE_BOX);

Task := TaskNext (pTask);

end;

TerminateApp (ThisTask, NO_UAE_BOX);

end;

Delphi - .....................................

neoturk: ...What cd track am i on ?...

Here's an easy way to do it:

create a timer and put this code in the OnTimer event:

var Trk, Min, Sec: Word;

begin

with MediaPlayer1 do

begin

Trk:= MCI_TMSF_TRACK(Position);

Min:=MCI_TMSF_MINUTE(Position);

Sec:=MCI_TMSF_SECOND(Position);

Label1.Caption:=Format('%.2d',[Trk]);

Label2.Caption:=Format('%.2d:%.2d',[Min,Sec]);

end;

Add MMSystem to the uses clause in Unit1

This will show current track and time.

Hope it actually works?!?!

-------------------------------------

...Terminate running apps ?...

Q: How do I terminate all running tasks?

A: Below is some code that will help if you want to terminate ALL tasks,

no questions asked.

A word of caution, before you run this for the first time, make sure

that you save it and anything else that may have some pending data.

procedure TForm1.ButtonKillAllClick(Sender: TObject);

var

pTask : PTaskEntry;

Task : Bool;

ThisTask: THANDLE;

begin

GetMem (pTask, SizeOf (TTaskEntry));

pTask^.dwSize := SizeOf (TTaskEntry);

Task := TaskFirst (pTask);

while Task do

begin

if pTask^.hInst = hInstance then

ThisTask := pTask^.hTask

else

TerminateApp (pTask^.hTask, NO_UAE_BOX);

Task := TaskNext (pTask);

end;

TerminateApp (ThisTask, NO_UAE_BOX);

end;

Delphi - .....................................

neoturk: ...Stop and wait for a key ?...

Maybe I've invented the wheel once again, but I couldn't find anything that did what I wanted to do so...

I was writing a program and wanted to stop execution from code, and then continue executing when pressing a key. My solution is creating a form and making it invisible by setting Width and Height to zero. When I want the program to stop, I do a ShowModal on the Form and look for the OnKeyPress-Event.

If you want the component it's here.

unit wkey;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

Forms, Dialogs, StdCtrls, FileCtrl, ComCtrls;

type

TKeyIn = (AnyKey,a,b,c,d,e,f,g,h,i,j,k,l,m,n,&l

t;/

FONT>o,p,q,r,s,t,u,v,w,x,y,z);

TWKey = class(TComponent)

private

DForm: TForm;

DLabel: TLabel;

FKey: TKeyIn;

PKey: string;

FShow: Boolean;

FPosition: TPosition;

FColor: TColor;

procedure SetKey(Value: TKeyIn);

procedure KeyPressed(Sender: TObject; var Key: char);

procedure SetShowMessage(Value: Boolean);

procedure SetMessagePosition(Value: TPosition);

procedure SetMessageColor(Value: TColor);

{ Private declarations }

protected

{ Protected declarations }

public

procedure Wait;

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

{ Public declarations }

published

property KeyToPress: TKeyIn read FKey write SetKey;

property ShowMessage: Boolean read FShow write SetShowMessage;

property MessagePosition: TPosition read FPosition write SetMessagePosition;

property MessageColor: TColor read FColor write SetMessageColor;

{ Published declarations }

end;

implementation

constructor TWKey.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

DForm:= TForm.Create(Self);

DLabel:= TLabel.Create(Self);

DLabel.Parent:= DForm;

DForm.Color:= clYellow;

DForm.Position:= poScreenCenter;

DForm.Borderstyle:= bsNone;

DLabel.Top:= 5;

DLabel.Left:= 5;

DForm.OnKeyPress:= KeyPressed;

FKey:= AnyKey;

FShow:= true;

FColor:= clYellow;

FPosition:= poMainFormCenter;

FCop:= '2000 (C), MASoft';

end;

procedure TWKey.KeyPressed(Sender: TObject; var Key: char);

var OK: Boolean;

begin

OK:= false;

case FKey of

AnyKey: OK:= true;

a: if Key = 'a' then OK:= true;

b: if Key = 'b' then OK:= true;

c: if Key = 'c' then OK:= true;

d: if Key = 'd' then OK:= true;

E: if Key = 'e' then OK:= true;

F: if Key = 'f' then OK:= true;

g: if Key = 'g' then OK:= true;

h: if Key = 'h' then OK:= true;

i: if Key = 'i' then OK:= true;

j: if Key = 'j' then OK:= true;

k: if Key = 'k' then OK:= true;

l: if Key = 'l' then OK:= true;

m: if Key = 'm' then OK:= true;

n: if Key = 'n' then OK:= true;

o: if Key = 'o' then OK:= true;

p: if Key = 'p' then OK:= true;

q: if Key = 'q' then OK:= true;

r: if Key = 'r' then OK:= true;

S: if Key = 's' then OK:= true;

t: if Key = 't' then OK:= true;

u: if Key = 'u' then OK:= true;

v: if Key = 'v' then OK:= true;

w: if Key = 'w' then OK:= true;

x: if Key = 'x' then OK:= true;

y: if Key = 'y' then OK:= true;

z: if Key = 'z' then OK:= true;

end;

if OK then DForm.ModalResult:= mrOK;

end;

destructor TWKey.Destroy;

begin

DLabel.Free;

DForm.Free;

inherited Destroy;

end;

procedure TWKey.Wait;

begin

if FShow then

begin

DForm.Width:= 125;

DForm.Height:= 24;

if FKey = AnyKey then DLabel.Caption:= 'Press a key to continue.' else

DLabel.Caption:= 'Press ' + PKey + ' to continue.';

end

else

begin

DForm.Width:= 0;

DForm.Height:= 0;

end;

if DForm.ShowModal = mrOK then

end;

procedure TWKey.SetKey(Value: TKeyIn);

begin

FKey:= Value;

case FKey of

AnyKey: PKey:= 'a key';

a: PKey:= '<a>';

b: PKey:= '';

c: PKey:= '<c>';

d: PKey:= '<d>';

E: PKey:= '<e>';

F: PKey:= '<f>';

g: PKey:= '<g>';

h: PKey:= '<h>';

i: PKey:= '';

j: PKey:= '<j>';

k: PKey:= '<k>';

l: PKey:= '<l>';

m: PKey:= '<m>';

n: PKey:= '<n>';

o: PKey:= '<o>';

p: PKey:= '';

q: PKey:= '<q>';

r: PKey:= '<r>';

S: PKey:= '<s>';

t: PKey:= '<t>';

u: PKey:= '';

v: PKey:= '<v>';

w: PKey:= '<w>';

x: PKey:= '<x>';

y: PKey:= '<y>';

z: PKey:= '<z>';

end;

procedure TWKey.SetShowMessage(Value: Boolean);

begin

FShow:= Value;

end;

procedure TWKey.SetMessagePosition(Value: TPosition);

begin

FPosition:= Value;

DForm.Position:= FPosition;

end;

procedure TWKey.SetMessageColor(Value: TColor);

begin

FColor:= Value;

DForm.Color:= FColor;

end;

end.

Delphi - .....................................

neoturk: ...Stop and wait for a key ?...

Maybe I've invented the wheel once again, but I couldn't find anything that did what I wanted to do so...

If you want the component it's here.

unit wkey;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

Forms, Dialogs, StdCtrls, FileCtrl, ComCtrls;

type

TKeyIn = (AnyKey,a,b,c,d,e,f,g,h,i,j,k,l,m,n,&l

t;/

FONT>o,p,q,r,s,t,u,v,w,x,y,z);

TWKey = class(TComponent)

private

DForm: TForm;

DLabel: TLabel;

FKey: TKeyIn;

PKey: string;

FShow: Boolean;

FPosition: TPosition;

FColor: TColor;

procedure SetKey(Value: TKeyIn);

procedure KeyPressed(Sender: TObject; var Key: char);

procedure SetShowMessage(Value: Boolean);

procedure SetMessagePosition(Value: TPosition);

procedure SetMessageColor(Value: TColor);

{ Private declarations }

protected

{ Protected declarations }

public

procedure Wait;

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

{ Public declarations }

published

property KeyToPress: TKeyIn read FKey write SetKey;

property ShowMessage: Boolean read FShow write SetShowMessage;

property MessagePosition: TPosition read FPosition write SetMessagePosition;

property MessageColor: TColor read FColor write SetMessageColor;

{ Published declarations }

end;

implementation

constructor TWKey.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

DForm:= TForm.Create(Self);

DLabel:= TLabel.Create(Self);

DLabel.Parent:= DForm;

DForm.Color:= clYellow;

DForm.Position:= poScreenCenter;

DForm.Borderstyle:= bsNone;

DLabel.Top:= 5;

DLabel.Left:= 5;

DForm.OnKeyPress:= KeyPressed;

FKey:= AnyKey;

FShow:= true;

FColor:= clYellow;

FPosition:= poMainFormCenter;

FCop:= '2000 (C), MASoft';

end;

procedure TWKey.KeyPressed(Sender: TObject; var Key: char);

var OK: Boolean;

begin

OK:= false;

case FKey of

AnyKey: OK:= true;

a: if Key = 'a' then OK:= true;

b: if Key = 'b' then OK:= true;

c: if Key = 'c' then OK:= true;

d: if Key = 'd' then OK:= true;

E: if Key = 'e' then OK:= true;

F: if Key = 'f' then OK:= true;

g: if Key = 'g' then OK:= true;

h: if Key = 'h' then OK:= true;

i: if Key = 'i' then OK:= true;

j: if Key = 'j' then OK:= true;

k: if Key = 'k' then OK:= true;

l: if Key = 'l' then OK:= true;

m: if Key = 'm' then OK:= true;

n: if Key = 'n' then OK:= true;

o: if Key = 'o' then OK:= true;

p: if Key = 'p' then OK:= true;

q: if Key = 'q' then OK:= true;

r: if Key = 'r' then OK:= true;

S: if Key = 's' then OK:= true;

t: if Key = 't' then OK:= true;

u: if Key = 'u' then OK:= true;

v: if Key = 'v' then OK:= true;

w: if Key = 'w' then OK:= true;

x: if Key = 'x' then OK:= true;

y: if Key = 'y' then OK:= true;

z: if Key = 'z' then OK:= true;

end;

if OK then DForm.ModalResult:= mrOK;

end;

destructor TWKey.Destroy;

begin

DLabel.Free;

DForm.Free;

inherited Destroy;

end;

procedure TWKey.Wait;

begin

if FShow then

begin

DForm.Width:= 125;

DForm.Height:= 24;

if FKey = AnyKey then DLabel.Caption:= 'Press a key to continue.' else

DLabel.Caption:= 'Press ' + PKey + ' to continue.';

end

else

begin

DForm.Width:= 0;

DForm.Height:= 0;

end;

if DForm.ShowModal = mrOK then

end;

procedure TWKey.SetKey(Value: TKeyIn);

begin

FKey:= Value;

case FKey of

AnyKey: PKey:= 'a key';

a: PKey:= '<a>';

b: PKey:= '';

c: PKey:= '<c>';

d: PKey:= '<d>';

E: PKey:= '<e>';

F: PKey:= '<f>';

g: PKey:= '<g>';

h: PKey:= '<h>';

i: PKey:= '';

j: PKey:= '<j>';

k: PKey:= '<k>';

l: PKey:= '<l>';

m: PKey:= '<m>';

n: PKey:= '<n>';

o: PKey:= '<o>';

p: PKey:= '';

q: PKey:= '<q>';

r: PKey:= '<r>';

S: PKey:= '<s>';

t: PKey:= '<t>';

u: PKey:= '';

v: PKey:= '<v>';

w: PKey:= '<w>';

x: PKey:= '<x>';

y: PKey:= '<y>';

z: PKey:= '<z>';

end;

procedure TWKey.SetShowMessage(Value: Boolean);

begin

FShow:= Value;

end;

procedure TWKey.SetMessagePosition(Value: TPosition);

begin

FPosition:= Value;

DForm.Position:= FPosition;

end;

procedure TWKey.SetMessageColor(Value: TColor);

begin

FColor:= Value;

DForm.Color:= FColor;

end;

end.

Delphi - .....................................

neoturk: ...Customizing the object inspector ?...

The following peace of code adds a new feature to the Object Inspector.

Whenever you create a component with a filename-property of the type TFileName,

the Inspector will let you browse to find the file you want.

unit filenameprop;

interface

uses

SysUtils, DsgnIntf;

type

TFileNameProperty = class(TStringProperty)

public

function GetAttributes: TPropertyAttributes; override;

procedure Edit; override;

end;

procedure Register;

implementation

uses

Dialogs, Forms;

function TFileNameProperty.GetAttributes: TPropertyAttributes;

begin

Result := [paDialog]

end {GetAttributes};

procedure TFileNameProperty.Edit;

begin

with TOpenDialog.Create(Application) do

try

Title := GetName; { name of property as OpenDialog caption }

FileName := GetValue;

Filter := 'All Files (*.*)|*.*';

HelpContext := 0;

Options := Options + [ofShowHelp, ofPathMustExist, ofFileMustExist];

if Execute then SetValue(FileName);

finally

Free

end

end {Edit};

procedure Register;

begin

RegisterPropertyEditor(TypeInfo(TFileName), nil, '', TFileNameProperty)

end;

end.

Delphi - .....................................

neoturk: ...Customizing the object inspector ?...

The following peace of code adds a new feature to the Object Inspector.

Whenever you create a component with a filename-property of the type TFileName,

the Inspector will let you browse to find the file you want.

unit filenameprop;

interface

uses

SysUtils, DsgnIntf;

type

TFileNameProperty = class(TStringProperty)

public

function GetAttributes: TPropertyAttributes; override;

procedure Edit; override;

end;

procedure Register;

implementation

uses

Dialogs, Forms;

function TFileNameProperty.GetAttributes: TPropertyAttributes;

begin

Result := [paDialog]

end {GetAttributes};

procedure TFileNameProperty.Edit;

begin

with TOpenDialog.Create(Application) do

try

Title := GetName; { name of property as OpenDialog caption }

FileName := GetValue;

Filter := 'All Files (*.*)|*.*';

HelpContext := 0;

Options := Options + [ofShowHelp, ofPathMustExist, ofFileMustExist];

if Execute then SetValue(FileName);

finally

Free

end

end {Edit};

procedure Register;

begin

RegisterPropertyEditor(TypeInfo(TFileName), nil, '', TFileNameProperty)

end;

end.

Delphi - .....................................

neoturk: ...How to create a screen saver ?...

A screen saver is really just a Windows program. Screen savers can be divided into two types: full-screen and effects.

The first type has a bsNone border style, the form usaully (not always, though) has a black background and is maximized. They always have the fsStayOnTop form style.

The second type is harder to create because they don't really have a visible form. They perform graphical effects on the screen. These are thougher because there's a lot more code to write.

Because screen savers are Windows applications they can freely access Ini files or the system Registry. They perform all the tasks a program can perform.

The screen saver has a .scr extension. You set this (Delphi 4+) in the project's options or using the {$e 'scr'} directive. No file type conversions are needed.

Windows controls the screen saver using parameters:

- /c - The screen saver is started. Sometimes this parameter will be sent with additional options. The format is: /c:xxxx, where x is a decimal number.

- /p - The screen saver is being installed or the Screen Saver page has been chosen.

- /s - - No commandline options - The screen saver setup should execute.

This example shows how to create a screen saver based on a maximized form with a black (usually) background.

At design time set the WindowState property to wsNormal else there may be problems maximizing it programmatically. Set the form's BorderStyle property to bsNone.

Now in the OnCreate event insert this code: ...

WindowState := wsMaximized; { You can't maximize it properly earlier } ... Don't forget to include a TTimer component (or something more precise if you want) to control the screen saver's animation. You may want to include a "Low CPU Usage" option that won't take too much of the processor's precious :) time. When this option would be set the screen saver would perform less calculations or at least the TTimer component's interval property would be multiplied by 2 or 4. You can also do this by lowering the current thread's and process'es priority level. This option is very useful for users that use screen savers but often have programs running in the background and don't like the screen saver taking 100% of the CPU's time.

Here is the code for a screensaver I've made:

You can download

my screensaver

here:

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

ExtCtrls, compound, mdp, RXCtrls, StdCtrls;

type

TInst = record

NoOfLogos: 1..10;

Interval: 1..10;

end;

TForm1 = class(TForm)

Timer1: TTimer;

MDP1: TMDP;

MDP2: TMDP;

mdp3: TMDP;

MDP4: TMDP;

MDP5: TMDP;

MDP6: TMDP;

MDP7: TMDP;

MDP8: TMDP;

MDP9: TMDP;

MDP10: TMDP;

Memo1: TMemo;

RxLabel1: TRxLabel;

Timer2: TTimer;

procedure Timer1Timer(Sender: TObject);

procedure FormClick(Sender: TObject);

procedure FormKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

procedure FormCreate(Sender: TObject);

procedure SaveFile;

procedure LoadFile;

procedure Timer2Timer(Sender: TObject);

procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

private

Start: Boolean;

F: file of TInst;

Rad: Integer;

{ Private declarations }

public

Inst: TInst;

{ Public declarations }

end;

var

Form1: TForm1;

implementation

uses Unit2;

{$R *.DFM}

{

Windows controls the screen saver using parameters:

- /c - The screen saver is started. Sometimes this parameter will be sent

with additional options. The format is: /c:xxxx, where x is a decimal number.

- /p - The screen saver is being installed or the Screen Saver page has been

chosen.

- /s - - No commandline options - The screen saver setup should execute.

}

procedure TForm1.Timer1Timer(Sender: TObject);

var n: Integer;

begin

if (ParamStr(1) = '/s') and Start then

begin

WindowState:= wsMaximized;

for n:= 1 to Inst.NoOfLogos do

begin

TMDP(FindComponent('MDP' + IntToStr(n))).Start;

TMDP(FindComponent('MDP' + IntToStr(n))).Show;

end;

for n:= Inst.NoOfLogos + 1 to 10 do

begin

TMDP(FindComponent('MDP' + IntToStr(n))).Stop;

TMDP(FindComponent('MDP' + IntToStr(n))).Hide;

end;

Timer1.Enabled:= true;

end

else

if (ParamStr(1) = '/s') and not Start then

begin

for n:= 1 to Inst.NoOfLogos do

begin

TMDP(FindComponent('MDP' + IntToStr(n))).Left:= Random(700);

TMDP(FindComponent('MDP' + IntToStr(n))).Top:= Random(450);

end;

end

else

begin

Timer1.Enabled:= false;

if MenuForm.ShowModal = mrOK then

begin

SaveFile;

Close;

end;

Start:= false;

end;

procedure TForm1.FormClick(Sender: TObject);

begin

Close;

end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

Close;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

LoadFile;

Timer1.Interval:= Inst.Interval * 1000;

Randomize;

Height:= 0;

Width:= 0;

Rad:= 0;

Timer1.Enabled:= true;

Timer2.Enabled:= true;

Start:= true;

end;

procedure TForm1.SaveFile;

begin

Inst.NoOfLogos:= MenuForm.SpinEdit1.Value;

Inst.Interval:= MenuForm.SpinEdit2.Value;

AssignFile(F, 'c:mdpscr.dat');

Rewrite(F);

Write(F, Inst);

CloseFile(F);

end;

procedure TForm1.LoadFile;

begin

try

AssignFile(F, 'c:mdpscr.dat');

Reset(F);

Read(F, Inst);

CloseFile(F);

except

Inst.Interval:= 4;

Inst.NoOfLogos:= 5;

AssignFile(F, 'c:mdpscr.dat');

Rewrite(F);

Write(F, Inst);

CloseFile(F);

end;

procedure TForm1.Timer2Timer(Sender: TObject);

begin

RxLabel1.Caption:= Memo1.Lines[Rad];

Inc(Rad);

if Rad = 25 then Rad:= 0;

end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

begin

Close;

end;

end.

unit Unit2;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

ExtCtrls, compound, mdp, StdCtrls, Buttons, passoverbtn, RXCtrls, RXSpin,

Spin;

type

TMenuForm = class(TForm)

PassOverBtn1: TPassOverBtn;

MDP1: TMDP;

RxLabel1: TRxLabel;

SpinEdit1: TSpinEdit;

RxLabel2: TRxLabel;

SpinEdit2: TSpinEdit;

procedure PassOverBtn1Click(Sender: TObject);

procedure FormActivate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

MenuForm: TMenuForm;

implementation

uses Unit1;

{$R *.DFM}

procedure TMenuForm.PassOverBtn1Click(Sender: TObject);

begin

ModalResult:= mrOK;

end;

procedure TMenuForm.FormActivate(Sender: TObject);

begin

SpinEdit1.Value:=Form1.Inst.NoOfLogos;

SpinEdit2.Value:=Form1.Inst.Interval;

end;

end.

Delphi - .....................................

neoturk: ...How to create a screen saver ?...

A screen saver is really just a Windows program. Screen savers can be divided into two types: full-screen and effects.

The first type has a bsNone border style, the form usaully (not always, though) has a black background and is maximized. They always have the fsStayOnTop form style.

The second type is harder to create because they don't really have a visible form. They perform graphical effects on the screen. These are thougher because there's a lot more code to write.

Because screen savers are Windows applications they can freely access Ini files or the system Registry. They perform all the tasks a program can perform.

The screen saver has a .scr extension. You set this (Delphi 4+) in the project's options or using the {$e 'scr'} directive. No file type conversions are needed.

Windows controls the screen saver using parameters:

- /c - The screen saver is started. Sometimes this parameter will be sent with additional options. The format is: /c:xxxx, where x is a decimal number.

- /p - The screen saver is being installed or the Screen Saver page has been chosen.

- /s - - No commandline options - The screen saver setup should execute.

This example shows how to create a screen saver based on a maximized form with a black (usually) background.

At design time set the WindowState property to wsNormal else there may be problems maximizing it programmatically. Set the form's BorderStyle property to bsNone.

Now in the OnCreate event insert this code: ...

Here is the code for a screensaver I've made:

You can download

my screensaver

here:

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

ExtCtrls, compound, mdp, RXCtrls, StdCtrls;

type

TInst = record

NoOfLogos: 1..10;

Interval: 1..10;

end;

TForm1 = class(TForm)

Timer1: TTimer;

MDP1: TMDP;

MDP2: TMDP;

mdp3: TMDP;

MDP4: TMDP;

MDP5: TMDP;

MDP6: TMDP;

MDP7: TMDP;

MDP8: TMDP;

MDP9: TMDP;

MDP10: TMDP;

Memo1: TMemo;

RxLabel1: TRxLabel;

Timer2: TTimer;

procedure Timer1Timer(Sender: TObject);

procedure FormClick(Sender: TObject);

procedure FormKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

procedure FormCreate(Sender: TObject);

procedure SaveFile;

procedure LoadFile;

procedure Timer2Timer(Sender: TObject);

procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

private

Start: Boolean;

F: file of TInst;

Rad: Integer;

{ Private declarations }

public

Inst: TInst;

{ Public declarations }

end;

var

Form1: TForm1;

implementation

uses Unit2;

{$R *.DFM}

{

Windows controls the screen saver using parameters:

- /c - The screen saver is started. Sometimes this parameter will be sent

with additional options. The format is: /c:xxxx, where x is a decimal number.

- /p - The screen saver is being installed or the Screen Saver page has been

chosen.

- /s - - No commandline options - The screen saver setup should execute.

}

procedure TForm1.Timer1Timer(Sender: TObject);

var n: Integer;

begin

if (ParamStr(1) = '/s') and Start then

begin

WindowState:= wsMaximized;

for n:= 1 to Inst.NoOfLogos do

begin

TMDP(FindComponent('MDP' + IntToStr(n))).Start;

TMDP(FindComponent('MDP' + IntToStr(n))).Show;

end;

for n:= Inst.NoOfLogos + 1 to 10 do

begin

TMDP(FindComponent('MDP' + IntToStr(n))).Stop;

TMDP(FindComponent('MDP' + IntToStr(n))).Hide;

end;

Timer1.Enabled:= true;

end

else

if (ParamStr(1) = '/s') and not Start then

begin

for n:= 1 to Inst.NoOfLogos do

begin

TMDP(FindComponent('MDP' + IntToStr(n))).Left:= Random(700);

TMDP(FindComponent('MDP' + IntToStr(n))).Top:= Random(450);

end;

end

else

begin

Timer1.Enabled:= false;

if MenuForm.ShowModal = mrOK then

begin

SaveFile;

Close;

end;

Start:= false;

end;

procedure TForm1.FormClick(Sender: TObject);

begin

Close;

end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

Close;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

LoadFile;

Timer1.Interval:= Inst.Interval * 1000;

Randomize;

Height:= 0;

Width:= 0;

Rad:= 0;

Timer1.Enabled:= true;

Timer2.Enabled:= true;

Start:= true;

end;

procedure TForm1.SaveFile;

begin

Inst.NoOfLogos:= MenuForm.SpinEdit1.Value;

Inst.Interval:= MenuForm.SpinEdit2.Value;

AssignFile(F, 'c:mdpscr.dat');

Rewrite(F);

Write(F, Inst);

CloseFile(F);

end;

procedure TForm1.LoadFile;

begin

try

AssignFile(F, 'c:mdpscr.dat');

Reset(F);

Read(F, Inst);

CloseFile(F);

except

Inst.Interval:= 4;

Inst.NoOfLogos:= 5;

AssignFile(F, 'c:mdpscr.dat');

Rewrite(F);

Write(F, Inst);

CloseFile(F);

end;

procedure TForm1.Timer2Timer(Sender: TObject);

begin

RxLabel1.Caption:= Memo1.Lines[Rad];

Inc(Rad);

if Rad = 25 then Rad:= 0;

end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

begin

Close;

end;

end.

unit Unit2;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

ExtCtrls, compound, mdp, StdCtrls, Buttons, passoverbtn, RXCtrls, RXSpin,

Spin;

type

TMenuForm = class(TForm)

PassOverBtn1: TPassOverBtn;

MDP1: TMDP;

RxLabel1: TRxLabel;

SpinEdit1: TSpinEdit;

RxLabel2: TRxLabel;

SpinEdit2: TSpinEdit;

procedure PassOverBtn1Click(Sender: TObject);

procedure FormActivate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

MenuForm: TMenuForm;

implementation

uses Unit1;

{$R *.DFM}

procedure TMenuForm.PassOverBtn1Click(Sender: TObject);

begin

ModalResult:= mrOK;

end;

procedure TMenuForm.FormActivate(Sender: TObject);

begin

SpinEdit1.Value:=Form1.Inst.NoOfLogos;

SpinEdit2.Value:=Form1.Inst.Interval;

end;

end.

Delphi - .....................................

neoturk: ...Delphi ide hidden shorcuts ?...

The Delphi IDE has a lot of useful shortcuts that are not shown in the menu and are not listed in the Help or are hard to find in it. Here is a list of the shorcuts that I have found information about.

Creating unique GUIDs (for COM) Keyboard layouts: Default, BRIEF emulation, Epsilon emulation, IDE Classic, New IDE Classic.

Ctrl+Shift+G - generates a unique GUID.

Keystroke recording (Delphi 2+) Keyboard layouts: Default, IDE Classic, Visual Studio emulation, New IDE Classic. If you write a lot of code and the code is the same code all the time, you probably have come across a situation where it would be easier to record some keystrokes and play them back a number of times. You can now do this in the Delphi IDE by pressing Ctrl+Shift+R to start recording, type in the keystrokes you want repeated, and press Ctrl+Shift+R to stop recording. To play back, press Ctrl+Shift+P. When recording the editor status bar will show: recording. The New IDE Classic keyboard layout offers keystroke macro saving. After you press Ctrl+Shift+R to stop recording a dialog window will show and prompt to save the keystroke to a file. Note: This only works in the code editor. Keystroke macros do not work in the form editor. This function is in Delphi 2 and higher.

Moving/resizing components in IDE without the mouse Keyboard layouts:

All Ctrl+Arrow Key - move visual components on a form.

Shift+Arrow Key - resize visual components on a form. Navigation in the visual designer Keyboard layouts:

All Esc - make the selection move from the currently selected control to it's parent control?

Set the selected text to upper case/lower case Keyboard layouts: Default, IDE Classic, Visual Studio emulation, New IDE Classic.

Ctrl+K O - lower case Ctrl+K N - upper case Troubleshooting the IDE (Delphi 4) Keyboard layouts: Default

Ctrl-Alt-E - Delphi 4 opens an event log window.

Delphi - .....................................

neoturk: ...Delphi ide hidden shorcuts ?...

Creating unique GUIDs (for COM) Keyboard layouts: Default, BRIEF emulation, Epsilon emulation, IDE Classic, New IDE Classic.

Ctrl+Shift+G - generates a unique GUID.

Moving/resizing components in IDE without the mouse Keyboard layouts:

All Ctrl+Arrow Key - move visual components on a form.

Shift+Arrow Key - resize visual components on a form. Navigation in the visual designer Keyboard layouts:

All Esc - make the selection move from the currently selected control to it's parent control?

Set the selected text to upper case/lower case Keyboard layouts: Default, IDE Classic, Visual Studio emulation, New IDE Classic.

Ctrl+K O - lower case Ctrl+K N - upper case Troubleshooting the IDE (Delphi 4) Keyboard layouts: Default

Ctrl-Alt-E - Delphi 4 opens an event log window.

Delphi - .....................................

neoturk: ...Hidden features of the delphi 5-6 ide ?...

Here are 2 undocumented registry settings that modify the behavior of the Delphi component palette in a manner you may like. But why are there hidden features first of all and why are they not "available" to the public? They may have been introduced too late into the product to get documented, or they may not have made it in time to be quality assured, or they may just have fallen off the documentation list because is was not said that they should be a feature that will remain in the final product. This simply means, use this information at your own risk. It is not tested or certified by Inprise, and it is not guaranteed that it will be surfaced or even remain in future versions of Delphi. These undocumented registry settings must be put in this registry location: HKEY_CURRENT_USERSoftwareBorlandDelphi5.0Extras. You will need to create the Extras registry key.

Automatically Selecting a Component Page

There are two registry values that control how the component palette reacts to the mouse. Setting the value of AutoPaletteSelect to "1" will cause a tab on the component palette to be automatically selected when the mouse is hovering over it. If the mouse is in the top two-thirds (2/3) of the tab, the palette for that tab will automatically be displayed. This is a string value. Automatically Scrolling in a Component Page If you have a lower resolution display or a component page with many components on it, you probably see arrows on the component page for scrolling left and right through the component list. Setting the value of AutoPaletteScroll to "1" will make you scroll left and right automatically whenever the mouse is positioned over the relevant arrow. This, also is a string value. I put both keys into my registry and got used to the changes very quickly. For me they're very useful tweaks for the IDE. Try them out yourself and see if you like them.

Delphi - .....................................

neoturk: ...Hidden features of the delphi 5-6 ide ?...

Automatically Selecting a Component Page

Delphi - .....................................

neoturk: ...Assigning property-values at runtime ?...

Got a question from one ot my visitors recently:

Question: How can I loop through and set properties of components without

manually setting each component separately?

Below is my solution.

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, ExtCtrls;

type

TForm1 = class(TForm)

Shape1: TShape;

Button1: TButton;

Shape2: TShape;

Shape3: TShape;

Shape4: TShape;

Shape5: TShape;

Shape6: TShape;

Shape7: TShape;

Shape8: TShape;

Shape9: TShape;

Shape10: TShape;

Button2: TButton;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

{

QUESTION:

How can I loop through and set properties of components without

manually setting each component separately?

I am writing a program which uses 10 TShapes.

Currently, I am setting the tag and color properties of these

components as follows.

}

procedure TForm1.Button1Click(Sender: TObject);

begin

Shape1.Shape:= stCircle;

Shape1.Brush.Color:= clRed;

Shape1.Tag:= 0;

Shape2.Shape:= stCircle;

Shape2.Brush.Color:= clRed;

Shape2.Tag:= 1;

Shape3.Shape:= stCircle;

Shape3.Brush.Color:= clRed;

Shape3.Tag:= 2;

Shape4.Shape:= stCircle;

Shape4.Brush.Color:= clRed;

Shape4.Tag:= 3;

Shape5.Shape:= stCircle;

Shape5.Brush.Color:= clRed;

Shape5.Tag:= 4;

Shape6.Shape:= stCircle;

Shape6.Brush.Color:= clRed;

Shape6.Tag:= 5;

Shape7.Shape:= stCircle;

Shape7.Brush.Color:= clRed;

Shape7.Tag:= 6;

Shape8.Shape:= stCircle;

Shape8.Brush.Color:= clRed;

Shape8.Tag:= 7;

Shape9.Shape:= stCircle;

Shape9.Brush.Color:= clRed;

Shape9.Tag:= 8;

Shape10.Shape:= stCircle;

Shape10.Brush.Color:= clRed;

Shape10.Tag:= 9;

end;

{

ANSWER:

Here is one way to do it. This code will do just the same, with only

6 lines of code instead of 30.

}

procedure TForm1.Button2Click(Sender: TObject);

var n: Integer;

begin

for n:= 1 to 10 do

begin

TShape(FindComponent('Shape' + IntToStr(n))).Shape:= stCircle;

TShape(FindComponent('Shape' + IntToStr(n))).Brush.Color:= clRed;

TShape(FindComponent('Shape' + IntToStr(n))).Tag:= n - 1;

end;

end.

Delphi - .....................................

neoturk: ...Assigning property-values at runtime ?...

Got a question from one ot my visitors recently:

Question: How can I loop through and set properties of components without

manually setting each component separately?

Below is my solution.

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, ExtCtrls;

type

TForm1 = class(TForm)

Shape1: TShape;

Button1: TButton;

Shape2: TShape;

Shape3: TShape;

Shape4: TShape;

Shape5: TShape;

Shape6: TShape;

Shape7: TShape;

Shape8: TShape;

Shape9: TShape;

Shape10: TShape;

Button2: TButton;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

{

QUESTION:

How can I loop through and set properties of components without

manually setting each component separately?

I am writing a program which uses 10 TShapes.

Currently, I am setting the tag and color properties of these

components as follows.

}

procedure TForm1.Button1Click(Sender: TObject);

begin

Shape1.Shape:= stCircle;

Shape1.Brush.Color:= clRed;

Shape1.Tag:= 0;

Shape2.Shape:= stCircle;

Shape2.Brush.Color:= clRed;

Shape2.Tag:= 1;

Shape3.Shape:= stCircle;

Shape3.Brush.Color:= clRed;

Shape3.Tag:= 2;

Shape4.Shape:= stCircle;

Shape4.Brush.Color:= clRed;

Shape4.Tag:= 3;

Shape5.Shape:= stCircle;

Shape5.Brush.Color:= clRed;

Shape5.Tag:= 4;

Shape6.Shape:= stCircle;

Shape6.Brush.Color:= clRed;

Shape6.Tag:= 5;

Shape7.Shape:= stCircle;

Shape7.Brush.Color:= clRed;

Shape7.Tag:= 6;

Shape8.Shape:= stCircle;

Shape8.Brush.Color:= clRed;

Shape8.Tag:= 7;

Shape9.Shape:= stCircle;

Shape9.Brush.Color:= clRed;

Shape9.Tag:= 8;

Shape10.Shape:= stCircle;

Shape10.Brush.Color:= clRed;

Shape10.Tag:= 9;

end;

{

ANSWER:

Here is one way to do it. This code will do just the same, with only

6 lines of code instead of 30.

}

procedure TForm1.Button2Click(Sender: TObject);

var n: Integer;

begin

for n:= 1 to 10 do

begin

TShape(FindComponent('Shape' + IntToStr(n))).Shape:= stCircle;

TShape(FindComponent('Shape' + IntToStr(n))).Brush.Color:= clRed;

TShape(FindComponent('Shape' + IntToStr(n))).Tag:= n - 1;

end;

end.