Programlama yapalım ve Öğrenelim.

neoturk: ...Making the enter key act like tab ?...

{

This code gives the key the same habbit as the key to

change focus between Controls.

Mit diesem Code kann man sich mit der Enter Taste zwischen mehreren

Textfeldern bewegen.(anstatt nur mit der Tabulatortaste)

}

// Form1.KeyPreview := True !

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);

begin

if Key = #13 then

begin

Key := #0;

{ check if SHIFT - Key is pressed }

if GetKeyState(VK_Shift) and $8000 <> 0 then

PostMessage(Handle, WM_NEXTDLGCTL, 1, 0)

else

PostMessage(Handle, WM_NEXTDLGCTL, 0, 0);

end;

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

neoturk: ...Making the enter key act like tab ?...

{

This code gives the key the same habbit as the key to

change focus between Controls.

Mit diesem Code kann man sich mit der Enter Taste zwischen mehreren

Textfeldern bewegen.(anstatt nur mit der Tabulatortaste)

}

// Form1.KeyPreview := True !

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);

begin

if Key = #13 then

begin

Key := #0;

{ check if SHIFT - Key is pressed }

if GetKeyState(VK_Shift) and $8000 <> 0 then

PostMessage(Handle, WM_NEXTDLGCTL, 1, 0)

else

PostMessage(Handle, WM_NEXTDLGCTL, 0, 0);

end;

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

neoturk: ...Reduce a form by right-clicking on the titlebar ?...

type

TForm1 = class(TForm)

private

{ Private-Deklarationen }

FOldHeight: Integer;

procedure WMNCRButtonDown(var Msg: TWMNCRButtonDown); message WM_NCRBUTTONDOWN;

public

{ Public-Deklarationen }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMNCRButtonDown(var Msg: TWMNCRButtonDown);

begin

if (Msg.HitTest = HTCAPTION) then

if (ClientHeight = 0) then

begin

ClientHeight := FOldHeight;

Application.ProcessMessages;

end

else

begin

FOldHeight := ClientHeight;

ClientHeight := 0;

Application.ProcessMessages;

end

end;

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

neoturk: ...Reduce a form by right-clicking on the titlebar ?...

type

TForm1 = class(TForm)

private

{ Private-Deklarationen }

FOldHeight: Integer;

procedure WMNCRButtonDown(var Msg: TWMNCRButtonDown); message WM_NCRBUTTONDOWN;

public

{ Public-Deklarationen }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMNCRButtonDown(var Msg: TWMNCRButtonDown);

begin

if (Msg.HitTest = HTCAPTION) then

if (ClientHeight = 0) then

begin

ClientHeight := FOldHeight;

Application.ProcessMessages;

end

else

begin

FOldHeight := ClientHeight;

ClientHeight := 0;

Application.ProcessMessages;

end

end;

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

neoturk: ...Position an inputquery centered over a form ?...

// I borrowed the code from InputQuery and

// added the stuff to center the InputQuery

// form on top of another form instead of

// positioning it in the middle of the screen.

// Dieser Code positioniert die Input Box in die

// Mitte der Form und nicht in die Mitte des

// Bildschirms.

function GetAveCharSize(Canvas: TCanvas): TPoint;

var

I: Integer;

Buffer: array[0..51] of Char;

begin

for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));

for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));

GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));

Result.X := Result.X div 52;

end;

function MyInputQuery(const ACaption, APrompt: string;

var Value: string): Boolean; overload;

const

SMsgDlgOK = 'OK';

SMsgDlgCancel = 'Cancel';

var

x, y, w, h: Integer;

Form: TForm;

Prompt: TLabel;

Edit: TEdit;

DialogUnits: TPoint;

ButtonTop, ButtonWidth, ButtonHeight: Integer;

begin

Result := False;

Form := TForm.Create(Application);

with Form do

try

Canvas.Font := Font;

DialogUnits := GetAveCharSize(Canvas);

BorderStyle := bsDialog;

Caption := ACaption;

ClientWidth := MulDiv(180, DialogUnits.X, 4);

ClientHeight := MulDiv(63, DialogUnits.Y, 8);

// center Horzontally

w := (Form1.Width - Form.Width) div 2;

X := Form1.Left + W;

if x < 0 then

x := 0

else if x + w > Screen.Width then x := Screen.Width - Form.Width;

Form.Left := X;

// center vertically

h := (Form1.Height - Form.Height) div 2;

y := Form1.Top + h;

if y < 0 then

y := 0

else if y + h > Screen.Height then y := Screen.Height - Form.Height;

Form.Left := X;

Form.Top := Y;

Prompt := TLabel.Create(Form);

with Prompt do

begin

Parent := Form;

AutoSize := True;

Left := MulDiv(8, DialogUnits.X, 4);

Top := MulDiv(8, DialogUnits.Y, 8);

Caption := APrompt;

end;

Edit := TEdit.Create(Form);

with Edit do

begin

Parent := Form;

Left := Prompt.Left;

Top := MulDiv(19, DialogUnits.Y, 8);

Width := MulDiv(164, DialogUnits.X, 4);

MaxLength := 255;

Text := Value;

SelectAll;

end;

ButtonTop := MulDiv(41, DialogUnits.Y, 8);

ButtonWidth := MulDiv(50, DialogUnits.X, 4);

ButtonHeight := MulDiv(14, DialogUnits.Y, 8);

with TButton.Create(Form) do

begin

Parent := Form;

Caption := SMsgDlgOK;

ModalResult := mrOk;

default := True;

SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth,

ButtonHeight);

end;

with TButton.Create(Form) do

begin

Parent := Form;

Caption := SMsgDlgCancel;

ModalResult := mrCancel;

Cancel := True;

SetBounds(MulDiv(92, DialogUnits.X, 4), ButtonTop, ButtonWidth,

ButtonHeight);

end;

if ShowModal = mrOk then

begin

Value := Edit.Text;

Result := True;

end;

finally

Form.Free;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

str: string;

begin

if MyInputQuery('Question', 'Whats your name ?', str) then

label1.Caption := str;

end;

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

neoturk: ...Position an inputquery centered over a form ?...

// I borrowed the code from InputQuery and

// added the stuff to center the InputQuery

// form on top of another form instead of

// positioning it in the middle of the screen.

// Dieser Code positioniert die Input Box in die

// Mitte der Form und nicht in die Mitte des

// Bildschirms.

function GetAveCharSize(Canvas: TCanvas): TPoint;

var

I: Integer;

Buffer: array[0..51] of Char;

begin

for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));

for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));

GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));

Result.X := Result.X div 52;

end;

function MyInputQuery(const ACaption, APrompt: string;

var Value: string): Boolean; overload;

const

SMsgDlgOK = 'OK';

SMsgDlgCancel = 'Cancel';

var

x, y, w, h: Integer;

Form: TForm;

Prompt: TLabel;

Edit: TEdit;

DialogUnits: TPoint;

ButtonTop, ButtonWidth, ButtonHeight: Integer;

begin

Result := False;

Form := TForm.Create(Application);

with Form do

try

Canvas.Font := Font;

DialogUnits := GetAveCharSize(Canvas);

BorderStyle := bsDialog;

Caption := ACaption;

ClientWidth := MulDiv(180, DialogUnits.X, 4);

ClientHeight := MulDiv(63, DialogUnits.Y, 8);

// center Horzontally

w := (Form1.Width - Form.Width) div 2;

X := Form1.Left + W;

if x < 0 then

x := 0

else if x + w > Screen.Width then x := Screen.Width - Form.Width;

Form.Left := X;

// center vertically

h := (Form1.Height - Form.Height) div 2;

y := Form1.Top + h;

if y < 0 then

y := 0

else if y + h > Screen.Height then y := Screen.Height - Form.Height;

Form.Left := X;

Form.Top := Y;

Prompt := TLabel.Create(Form);

with Prompt do

begin

Parent := Form;

AutoSize := True;

Left := MulDiv(8, DialogUnits.X, 4);

Top := MulDiv(8, DialogUnits.Y, 8);

Caption := APrompt;

end;

Edit := TEdit.Create(Form);

with Edit do

begin

Parent := Form;

Left := Prompt.Left;

Top := MulDiv(19, DialogUnits.Y, 8);

Width := MulDiv(164, DialogUnits.X, 4);

MaxLength := 255;

Text := Value;

SelectAll;

end;

ButtonTop := MulDiv(41, DialogUnits.Y, 8);

ButtonWidth := MulDiv(50, DialogUnits.X, 4);

ButtonHeight := MulDiv(14, DialogUnits.Y, 8);

with TButton.Create(Form) do

begin

Parent := Form;

Caption := SMsgDlgOK;

ModalResult := mrOk;

default := True;

SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth,

ButtonHeight);

end;

with TButton.Create(Form) do

begin

Parent := Form;

Caption := SMsgDlgCancel;

ModalResult := mrCancel;

Cancel := True;

SetBounds(MulDiv(92, DialogUnits.X, 4), ButtonTop, ButtonWidth,

ButtonHeight);

end;

if ShowModal = mrOk then

begin

Value := Edit.Text;

Result := True;

end;

finally

Form.Free;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

str: string;

begin

if MyInputQuery('Question', 'Whats your name ?', str) then

label1.Caption := str;

end;

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

neoturk: ...Close a form animated ?...

var

tutup: Boolean;

i: Integer;

procedure TForm1.Timer1Timer(Sender: TObject);

var

reg1, reg2: hrgn;

begin

if tutup = True then

begin

i := i + 10;

reg1 := CreateRoundRectRgn(0 + i, 0 + i, Width - i, Height - i, 20, 20);

SetWindowRgn(Handle, reg1, True);

end;

if i >= Width then

begin

tutup := False;

i := 1;

end;

if tutup = False then

begin

i := i + 10;

reg1 := CreateRectRgn(0, 0, (Width div 2) - i, Height);

reg2 := CreateRectRgn((Width div 2) + i, 0, Width, Height);

CombineRgn(reg1, reg1, reg2, rgn_or);

SetWindowRgn(Handle, reg1, True);

if i >= Width div 2 then

begin

tutup := True;

i := 1;

end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

var

reg1: hrgn;

begin

i := 1;

timer1.Enabled := True;

if MessageDlg('Exit now ?',

mtConfirmation, [mbYes, mbNo], 0) = mrYes then

CanClose := True

else

begin

CanClose := False;

timer1.Enabled := False;

reg1 := CreateRoundRectRgn(0, 0, Width, Height, 0, 0);

SetWindowRgn(Handle, reg1, True);

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

tutup := True;

timer1.Enabled := False;

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

neoturk: ...Close a form animated ?...

var

tutup: Boolean;

i: Integer;

procedure TForm1.Timer1Timer(Sender: TObject);

var

reg1, reg2: hrgn;

begin

if tutup = True then

begin

i := i + 10;

reg1 := CreateRoundRectRgn(0 + i, 0 + i, Width - i, Height - i, 20, 20);

SetWindowRgn(Handle, reg1, True);

end;

if i >= Width then

begin

tutup := False;

i := 1;

end;

if tutup = False then

begin

i := i + 10;

reg1 := CreateRectRgn(0, 0, (Width div 2) - i, Height);

reg2 := CreateRectRgn((Width div 2) + i, 0, Width, Height);

CombineRgn(reg1, reg1, reg2, rgn_or);

SetWindowRgn(Handle, reg1, True);

if i >= Width div 2 then

begin

tutup := True;

i := 1;

end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

var

reg1: hrgn;

begin

i := 1;

timer1.Enabled := True;

if MessageDlg('Exit now ?',

mtConfirmation, [mbYes, mbNo], 0) = mrYes then

CanClose := True

else

begin

CanClose := False;

timer1.Enabled := False;

reg1 := CreateRoundRectRgn(0, 0, Width, Height, 0, 0);

SetWindowRgn(Handle, reg1, True);

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

tutup := True;

timer1.Enabled := False;

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

neoturk: ...Change the mainform at runtime ?...

procedure SetAsMainForm(aForm:TForm);

var

P:Pointer;

begin

P := @Application.Mainform;

Pointer(P^) := aForm;

end;

{************************************}

// Example of Usage:

{

Question:

If my application is main.exe and the main form is form1, form1 displays

when it runs. I would like to display other forms based on the parameter

passed.

main.exe param1 will display form2 as the first form

main.exe param2 with display form3 as the first form

Answer:

}

program Project1;

uses

Forms,

Unit1 in 'Unit1.pas' {Form1},

Unit2 in 'Unit2.pas' {Form2},

Unit3 in 'Unit3.pas' {Form3};

{$R *.res}

procedure SetAsMainForm(aForm:TForm);

var

P:Pointer;

begin

P := @Application.Mainform;

Pointer(P^) := aForm;

end;

begin

Application.Initialize;

Application.CreateForm(TForm1, Form1);

Application.CreateForm(TForm2, Form2);

Application.CreateForm(TForm3, Form3);

if Paramstr(1) = 'Param1' then

SetAsMainForm(Form2);

if Paramstr(1) = 'Param2' then

SetAsMainForm(Form3);

Application.Run;

end.

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

neoturk: ...Change the mainform at runtime ?...

procedure SetAsMainForm(aForm:TForm);

var

P:Pointer;

begin

P := @Application.Mainform;

Pointer(P^) := aForm;

end;

{************************************}

// Example of Usage:

{

Question:

If my application is main.exe and the main form is form1, form1 displays

when it runs. I would like to display other forms based on the parameter

passed.

main.exe param1 will display form2 as the first form

main.exe param2 with display form3 as the first form

Answer:

}

program Project1;

uses

Forms,

Unit1 in 'Unit1.pas' {Form1},

Unit2 in 'Unit2.pas' {Form2},

Unit3 in 'Unit3.pas' {Form3};

{$R *.res}

procedure SetAsMainForm(aForm:TForm);

var

P:Pointer;

begin

P := @Application.Mainform;

Pointer(P^) := aForm;

end;

begin

Application.Initialize;

Application.CreateForm(TForm1, Form1);

Application.CreateForm(TForm2, Form2);

Application.CreateForm(TForm3, Form3);

if Paramstr(1) = 'Param1' then

SetAsMainForm(Form2);

if Paramstr(1) = 'Param2' then

SetAsMainForm(Form3);

Application.Run;

end.

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

neoturk: ...Export a tlistview to a tstringgrid ?...

procedure ListView2StringGrid(Listview: TListView; StringGrid: TStringGrid);

const

MAX_SUBITEMS = 5;

var

i, j: Integer;

begin

with ListView do

for i := 0 to Items.Count - 1 do

begin

{Get Item of First Column}

StringGrid.Cells[1, i + 1] := Items[i].Caption;

{loop through SubItems}

for j := 0 to MAX_SUBITEMS do

begin

if Items[i].SubItems.Count > j then

StringGrid.Cells[j + 2, i + 1] := Items[i].SubItems.Strings[j]

else

break;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

i: Integer;

begin

// Clear the StringGrid if necessary

// Falls nötig, zuerst das StringGrid löschen

i := 0;

while i < StringGrid1.RowCount do

begin

StringGrid1.Rows[i].Clear;

Inc(i);

end;

// Copy ListView1 to StringGrid1

ListView2StringGrid(ListView1, StringGrid1);

end;

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

neoturk: ...Export a tlistview to a tstringgrid ?...

procedure ListView2StringGrid(Listview: TListView; StringGrid: TStringGrid);

const

MAX_SUBITEMS = 5;

var

i, j: Integer;

begin

with ListView do

for i := 0 to Items.Count - 1 do

begin

{Get Item of First Column}

StringGrid.Cells[1, i + 1] := Items[i].Caption;

{loop through SubItems}

for j := 0 to MAX_SUBITEMS do

begin

if Items[i].SubItems.Count > j then

StringGrid.Cells[j + 2, i + 1] := Items[i].SubItems.Strings[j]

else

break;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

i: Integer;

begin

// Clear the StringGrid if necessary

// Falls nötig, zuerst das StringGrid löschen

i := 0;

while i < StringGrid1.RowCount do

begin

StringGrid1.Rows[i].Clear;

Inc(i);

end;

// Copy ListView1 to StringGrid1

ListView2StringGrid(ListView1, StringGrid1);

end;

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

neoturk: ...Prevent windows from minimizing a form ?...

The Windows Taskbar function "Minimize all Windows" minimizes all Windows even if they don't have a minimize button.

The following code will prevent a form from minimizing through windows.

Die Funktion "Alle Fenster minimieren" aus der Windows Taskbar minimiert alle Fenster, auch solche die eigentlich keine Minimieren-Schaltfläche besitzen. Der folgende Code verhindert das Minimieren eines Fensters.

implementation

procedure TForm1.WMShowWindow(var Msg: TWMShowWindow);

begin

if not Msg.Show then

Msg.Result := 0

else

inherited;

end;

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

neoturk: ...Prevent windows from minimizing a form ?...

The Windows Taskbar function "Minimize all Windows" minimizes all Windows even if they don't have a minimize button.

The following code will prevent a form from minimizing through windows.

implementation

procedure TForm1.WMShowWindow(var Msg: TWMShowWindow);

begin

if not Msg.Show then

Msg.Result := 0

else

inherited;

end;

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

neoturk: ...Shape a form to a bitmap ?...

unit Unit1;

interface

uses

Windows, Classes, SysUtils, Graphics, Forms;

type

TRGBArray = array[0..32767] of TRGBTriple;

PRGBArray = ^TRGBArray;

type

TForm1 = class(TForm)

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

private

{ Private declarations }

FRegion: THandle;

function CreateRegion(Bmp: TBitmap): THandle;

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.CreateRegion(Bmp: TBitmap): THandle;

var

X, Y, StartX: Integer;

Excl: THandle;

Row: PRGBArray;

TransparentColor: TRGBTriple;

begin

Bmp.PixelFormat := pf24Bit;

Result := CreateRectRGN(0, 0, Bmp.Width, Bmp.Height);

for Y := 0 to Bmp.Height - 1 do

begin

Row := Bmp.Scanline[Y];

StartX := -1;

if Y = 0 then

TransparentColor := Row[0];

for X := 0 to Bmp.Width - 1 do

begin

if (Row[X].rgbtRed = TransparentColor.rgbtRed) and

(Row[X].rgbtGreen = TransparentColor.rgbtGreen) and

(Row[X].rgbtBlue = TransparentColor.rgbtBlue) then

begin

if StartX = -1 then StartX := X;

end

else

begin

if StartX > -1 then

begin

Excl := CreateRectRGN(StartX, Y, X + 1, Y + 1);

try

CombineRGN(Result, Result, Excl, RGN_DIFF);

StartX := -1;

finally

DeleteObject(Excl);

end;

if StartX > -1 then

begin

Excl := CreateRectRGN(StartX, Y, Bmp.Width, Y + 1);

try

CombineRGN(Result, Result, Excl, RGN_DIFF);

finally

DeleteObject(Excl);

end;

procedure TForm1.FormCreate(Sender: TObject);

var

Bmp: TBitmap;

begin

Bmp := TBitmap.Create;

try

Bmp.LoadFromFile('C:YourBitmap.bmp');

FRegion := CreateRegion(Bmp);

SetWindowRGN(Handle, FRegion, True);

finally

Bmp.Free;

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

DeleteObject(FRegion);

end;

end.