Programlama yapalım ve Öğrenelim.

Thread Örneği

Don't freeze your program.

If your main thread goes in a loop, your application will be frozen.

What if the user want to cancel the running activity?

So make it a thread and make the termination of the loop depend on the value of a variable (FCanceled in this tip) which can be modified by the user (with Button2 in this tip).

When the user click on Button2, FCanceled becomes False and the thread's loop ends.

During the loop, you can right click the title bar to show the system menu, you can drag the form, and all other things without pausing the loop.

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

unit Unit1;

interface

uses

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

Dialogs, StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

Edit1: TEdit;

Button2: TButton;

procedure FormCreate(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

{ Private declarations }

FCanceled: Boolean;

public

{ Public declarations }

end;

TThread1 = class(TThread)

protected

constructor Create;

procedure Execute; override;

procedure IncreaseNumber;

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

Self.Caption := 'You May Cancel a Loop';

Edit1.Text := '1';

Edit1.ReadOnly := True;

Button1.Caption := 'Start';

Button2.Caption := 'Stop';

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

FCanceled := False; TThread1.Create;

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

FCanceled := True;

end;

constructor TThread1.Create;

begin

inherited Create(false);

end;

procedure TThread1.Execute;

var success: Boolean;

begin

Self.Priority := tpLowest;

with Form1 do

begin

while not FCanceled do

begin

// call Synchronize so that you can create more threads by clicking

// the Start button and all created threads can run synchronously

Synchronize(IncreaseNumber);

end;

procedure TThread1.IncreaseNumber;

begin

with Form1 do

Edit1.Text := IntToStr(Succ(StrToInt(Edit1.Text)));

end;

end.

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

hızlı ve temiz programlar

procedure showform;

Implemention

procedure showform;

with TFormName.Create(Application) do

try

ShowModal;

finally

Free;

end;

Call Form :

Unit1.ShowForm; //Use unit name.

Cause of this, less memory is used ,because the

form is stored in the application and having them#

pre-created takes the form into primary memory.

So just remove it from the dpr file.

Compress it with upx or somthing.

Because the smaller the file, the less space it use's

on primary memory which allows you cpu to process apps faster.

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

hızlı ve temiz programlar

procedure showform;

Implemention

procedure showform;

with TFormName.Create(Application) do

try

ShowModal;

finally

Free;

end;

Call Form :

Unit1.ShowForm; //Use unit name.

Cause of this, less memory is used ,because the

form is stored in the application and having them#

pre-created takes the form into primary memory.

So just remove it from the dpr file.

Compress it with upx or somthing.

Because the smaller the file, the less space it use's

on primary memory which allows you cpu to process apps faster.

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

System Tray cleaning

This tip was posted to Borland newsgroups

by Erik Turner.

procedure RemoveDeadIcons;

var

TrayWindow : HWnd;

WindowRect : TRect;

SmallIconWidth : Integer;

SmallIconHeight : Integer;

CursorPos : TPoint;

Row : Integer;

Col : Integer;

begin

{ Get tray window handle and bounding rectangle }

TrayWindow := FindWindowEx(FindWindow('Shell_TrayWnd',NIL),0,'TrayNotifyWnd',NIL);

if not GetWindowRect(TrayWindow,WindowRect) then

Exit;

{ Get small icon metrics }

SmallIconWidth := GetSystemMetrics(SM_CXSMICON);

SmallIconHeight := GetSystemMetrics(SM_CYSMICON);

{ Save current mouse position }

GetCursorPos(CursorPos);

{ Sweep the mouse cursor over each icon in the tray in both dimensions }

with WindowRect do

begin

for Row := 0 to (Bottom - Top) DIV SmallIconHeight do

begin

for Col := 0 to (Right - Left) DIV SmallIconWidth do

begin

SetCursorPos(Left + Col * SmallIconWidth, Top + Row * SmallIconHeight);

Sleep(0);

end;

{ Restore mouse position }

SetCursorPos(CursorPos.X,CursorPos.Y);

{ Redraw tray window (to fix bug in multi-line tray area) }

RedrawWindow(TrayWindow,NIL,0,RDW_INVALIDATE OR RDW_ERASE OR RDW_UPDATENOW);

end;

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

System Tray cleaning

This tip was posted to Borland newsgroups

by Erik Turner.

procedure RemoveDeadIcons;

var

TrayWindow : HWnd;

WindowRect : TRect;

SmallIconWidth : Integer;

SmallIconHeight : Integer;

CursorPos : TPoint;

Row : Integer;

Col : Integer;

begin

{ Get tray window handle and bounding rectangle }

TrayWindow := FindWindowEx(FindWindow('Shell_TrayWnd',NIL),0,'TrayNotifyWnd',NIL);

if not GetWindowRect(TrayWindow,WindowRect) then

Exit;

{ Get small icon metrics }

SmallIconWidth := GetSystemMetrics(SM_CXSMICON);

SmallIconHeight := GetSystemMetrics(SM_CYSMICON);

{ Save current mouse position }

GetCursorPos(CursorPos);

{ Sweep the mouse cursor over each icon in the tray in both dimensions }

with WindowRect do

begin

for Row := 0 to (Bottom - Top) DIV SmallIconHeight do

begin

for Col := 0 to (Right - Left) DIV SmallIconWidth do

begin

SetCursorPos(Left + Col * SmallIconWidth, Top + Row * SmallIconHeight);

Sleep(0);

end;

{ Restore mouse position }

SetCursorPos(CursorPos.X,CursorPos.Y);

{ Redraw tray window (to fix bug in multi-line tray area) }

RedrawWindow(TrayWindow,NIL,0,RDW_INVALIDATE OR RDW_ERASE OR RDW_UPDATENOW);

end;

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

Mouse to RBG

http://www.dancemammal.com/

Description: How to get the RGB value of a pixel under the mouse cursor

Author: Delphi Pool

Function Style: Graphics

Source Code:

procedure TForm1.ImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

begin

ColNumb := Image.Canvas.Pixels[X, Y]; {The image can't be a JPG}

GetRGB(ColNumb, R, G, B);

{Here are the RGB values you need}

end;

The GetRGB procedure:

procedure GetRGB(Col: TColor; var R, G, B: Byte);

var

Color: $0..$FFFFFFFF;

begin

Color := ColorToRGB(Col);

R := ($000000FF and Color);

G := ($0000FF00 and Color) Shr 8;

B := ($00FF0000 and Color) Shr 16;

end;

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

Mouse to RBG

http://www.dancemammal.com/

Description: How to get the RGB value of a pixel under the mouse cursor

Author: Delphi Pool

Function Style: Graphics

Source Code:

procedure TForm1.ImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

begin

ColNumb := Image.Canvas.Pixels[X, Y]; {The image can't be a JPG}

GetRGB(ColNumb, R, G, B);

{Here are the RGB values you need}

end;

The GetRGB procedure:

procedure GetRGB(Col: TColor; var R, G, B: Byte);

var

Color: $0..$FFFFFFFF;

begin

Color := ColorToRGB(Col);

R := ($000000FF and Color);

G := ($0000FF00 and Color) Shr 8;

B := ($00FF0000 and Color) Shr 16;

end;

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

Meta Join

http://www.dancemammal.com/

Description: How to join two TMetaFile

Author: Delphi Pool

Function Style: Graphics

Source Code:

{ ... }

MetaFile1 := TMetaFile.Create;

MetaFile2 := TMetaFile.Create;

DestMetaFile := TMetaFile.Create;

try

MetaFile1.LoadFromFile('A0000259.WMF');

MetaFile2.LoadFromFile('A0000260.WMF');

DestMetaFile.Width := Max(MetaFile1.Width, MetaFile2.Width);

DestMetaFile.Height := MetaFile1.Height + MetaFile2.Height;

MetaFileCanvas := TMetaFileCanvas.Create (DestMetaFile, 0);

try

MetaFileCanvas.Draw (0, 0, MetaFile1);

MetaFileCanvas.Draw (0, MetaFile1.Height, MetaFile2);

finally

MetaFileCanvas.Free;

end;

DestMetaFile.SaveToFile('new.wmf');

finally

MetaFile1.Free;

MetaFile2.Free;

DestMetaFile.Free;

end;

{ ... }

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

Meta Join

http://www.dancemammal.com/

Description: How to join two TMetaFile

Author: Delphi Pool

Function Style: Graphics

Source Code:

{ ... }

MetaFile1 := TMetaFile.Create;

MetaFile2 := TMetaFile.Create;

DestMetaFile := TMetaFile.Create;

try

MetaFile1.LoadFromFile('A0000259.WMF');

MetaFile2.LoadFromFile('A0000260.WMF');

DestMetaFile.Width := Max(MetaFile1.Width, MetaFile2.Width);

DestMetaFile.Height := MetaFile1.Height + MetaFile2.Height;

MetaFileCanvas := TMetaFileCanvas.Create (DestMetaFile, 0);

try

MetaFileCanvas.Draw (0, 0, MetaFile1);

MetaFileCanvas.Draw (0, MetaFile1.Height, MetaFile2);

finally

MetaFileCanvas.Free;

end;

DestMetaFile.SaveToFile('new.wmf');

finally

MetaFile1.Free;

MetaFile2.Free;

DestMetaFile.Free;

end;

{ ... }

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

Spray

http://www.dancemammal.com/

Description: Draw spray effect on canvas

Author: Tokter

Function Style: Graphics

Source Code:

procedure Spray(Canvas: TCanvas; x, y, r: Integer; Color: TColor);

var

rad, a: Single;

i: Integer;

begin

for i := 0 to 100 do

begin

a := Random * 2 * pi;

rad := Random * r;

Canvas.Pixels[x + Round(rad * Cos(a)), y + Round(rad * Sin(a))] := Color;

end;

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

Y: Integer);

begin

if ssLeft in Shift then Spray(Image1.Canvas, x, y, 40, clRed);

end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

if ssLeft in Shift then Spray(Image1.Canvas, x, y, 40, clRed);

end;

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

Spray

http://www.dancemammal.com/

Description: Draw spray effect on canvas

Author: Tokter

Function Style: Graphics

Source Code:

procedure Spray(Canvas: TCanvas; x, y, r: Integer; Color: TColor);

var

rad, a: Single;

i: Integer;

begin

for i := 0 to 100 do

begin

a := Random * 2 * pi;

rad := Random * r;

Canvas.Pixels[x + Round(rad * Cos(a)), y + Round(rad * Sin(a))] := Color;

end;

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

Y: Integer);

begin

if ssLeft in Shift then Spray(Image1.Canvas, x, y, 40, clRed);

end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

if ssLeft in Shift then Spray(Image1.Canvas, x, y, 40, clRed);

end;

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

_-**-_YARDIM_-**-_CEVAP

slm arkadslar acil yardımınıza ihtiyacım var

delphide yaptıgım program başka pc de çalışmıyor acaba nede data db yaptım parodox galibaa

DATA YOLUNU YANLIŞ OLARAK TANIMLAMIŞSINDIR BİRDE

PROGRAMLARI KUR HALİNE GETİRMEN GEREK. VEYA GETİRMEZ İSEN

ÇALIŞMASIN İSTEDİĞİN BİLGİSAYARDA DELPHİ PROGRAMLAMA DİLİNİN KURULU OLMASI GEREKİYOR.

KOLAY GELSİN BİR ARA BENDE YAŞADIM ANNI SORUNU .. SORULARINI VE YARDIM İSTEKLERİNİ DELPHİ FORMA YAZARSAN DAHA FAZLA BİLGİ ALIRSIN.

FİKRET_SA@YAHOO.COM

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

_-**-_YARDIM_-**-_CEVAP

slm arkadslar acil yardımınıza ihtiyacım var

delphide yaptıgım program başka pc de çalışmıyor acaba nede data db yaptım parodox galibaa

DATA YOLUNU YANLIŞ OLARAK TANIMLAMIŞSINDIR BİRDE

PROGRAMLARI KUR HALİNE GETİRMEN GEREK. VEYA GETİRMEZ İSEN

ÇALIŞMASIN İSTEDİĞİN BİLGİSAYARDA DELPHİ PROGRAMLAMA DİLİNİN KURULU OLMASI GEREKİYOR.

KOLAY GELSİN BİR ARA BENDE YAŞADIM ANNI SORUNU .. SORULARINI VE YARDIM İSTEKLERİNİ DELPHİ FORMA YAZARSAN DAHA FAZLA BİLGİ ALIRSIN.

FİKRET_SA@YAHOO.COM

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

_-**-_YARDIM_-**-_CEVAP

slm arkadslar acil yardımınıza ihtiyacım var

delphide yaptıgım program başka pc de çalışmıyor acaba nede data db yaptım parodox galibaa

DATA YOLUNU YANLIŞ OLARAK TANIMLAMIŞSINDIR BİRDE

PROGRAMLARI KUR HALİNE GETİRMEN GEREK. VEYA GETİRMEZ İSEN

ÇALIŞMASIN İSTEDİĞİN BİLGİSAYARDA DELPHİ PROGRAMLAMA DİLİNİN KURULU OLMASI GEREKİYOR.

KOLAY GELSİN BİR ARA BENDE YAŞADIM ANNI SORUNU .. SORULARINI VE YARDIM İSTEKLERİNİ DELPHİ FORMA YAZARSAN DAHA FAZLA BİLGİ ALIRSIN.

FİKRET_SA@YAHOO.COM

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

_-**-_YARDIM_-**-_CEVAP

slm arkadslar acil yardımınıza ihtiyacım var

delphide yaptıgım program başka pc de çalışmıyor acaba nede data db yaptım parodox galibaa

DATA YOLUNU YANLIŞ OLARAK TANIMLAMIŞSINDIR BİRDE

PROGRAMLARI KUR HALİNE GETİRMEN GEREK. VEYA GETİRMEZ İSEN

ÇALIŞMASIN İSTEDİĞİN BİLGİSAYARDA DELPHİ PROGRAMLAMA DİLİNİN KURULU OLMASI GEREKİYOR.

KOLAY GELSİN BİR ARA BENDE YAŞADIM ANNI SORUNU .. SORULARINI VE YARDIM İSTEKLERİNİ DELPHİ FORMA YAZARSAN DAHA FAZLA BİLGİ ALIRSIN.

FİKRET_SA@YAHOO.COM

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

_-**-_YARDIM_-**-_

slm arkadslar acil yardımınıza ihtiyacım var

delphide yaptıgım program başka pc de çalışmıyor acaba nede data db yaptım parodox galibaa

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

_-**-_YARDIM_-**-_

slm arkadslar acil yardımınıza ihtiyacım var

delphide yaptıgım program başka pc de çalışmıyor acaba nede data db yaptım parodox galibaa

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

txt dosyasına yazma

#include <stdio.h>

FILE *d_i;

AnsiString SATIR;

if((d_i=fopen("C:deneme.TXT","w"))==NULL) return ;

SATIR="YAZDIRILACAK METİN";

fprintf(d_i,"%sn",SATIR.c_str());

fclose(d_i);

C++ Builder - .....................................

txt dosyasına yazma

#include <stdio.h>

FILE *d_i;

AnsiString SATIR;

if((d_i=fopen("C:deneme.TXT","w"))==NULL) return ;

SATIR="YAZDIRILACAK METİN";

fprintf(d_i,"%sn",SATIR.c_str());

fclose(d_i);

C++ Builder - .....................................

DBGrid to Excel

procedure gy_DBGrid_to_excel(pdbgrid:TDBGrid; pFile:string;pQu:TQuery);

var vlst1,vlst : TStringList;

vPath,s : string;

i : integer;

begin

vlst1 := TStringList.Create;

vlst := TStringList.Create;

s := ";

for i:=0 to pdbgrid.Columns.Count -1 do begin

vlst.Add(IntToStr(pQu.FieldByName(pdbgrid.Columns[i].FieldName).index));

if s <>" then s := s + ';';

s := s+pdbgrid.Columns[i].Title.Caption;

end;

vLst1.Add(s);

pQu.First;

s := ";

while not pQu.Eof do begin

s := ";

for i:=0 to vlst.count -1 do begin

if s <>" then s := s + ';';

s := s +pQu.Fields[StrToInt(vlst.Strings[i])].AsString;

end;

vLst1.Add(s);

pQu.Next;

end;

vPath := 'c:koalatemp';

gy_Create_Dir(vPath);

vLst1.SaveToFile(vPath+'koala.csv');

gy_uyari_mesaji('Uyari', vPath+'koala.csv dosyasi yaratildi.'+chr(13)+' Sütün Ayiraci ; kullanildi',MB_OK);

s := gy_register_oku(false,'softwareclassesapplicationsexcel.exeshellopencommand',");

if s=" then

s := gy_register_oku(false,'softwareclassesexcel.csvshellopencommand',");

gy_calistir(1,s+' '+vPath+'koala.csv');

end;

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

DBGrid to Excel

procedure gy_DBGrid_to_excel(pdbgrid:TDBGrid; pFile:string;pQu:TQuery);

var vlst1,vlst : TStringList;

vPath,s : string;

i : integer;

begin

vlst1 := TStringList.Create;

vlst := TStringList.Create;

s := ";

for i:=0 to pdbgrid.Columns.Count -1 do begin

vlst.Add(IntToStr(pQu.FieldByName(pdbgrid.Columns[i].FieldName).index));

if s <>" then s := s + ';';

s := s+pdbgrid.Columns[i].Title.Caption;

end;

vLst1.Add(s);

pQu.First;

s := ";

while not pQu.Eof do begin

s := ";

for i:=0 to vlst.count -1 do begin

if s <>" then s := s + ';';

s := s +pQu.Fields[StrToInt(vlst.Strings[i])].AsString;

end;

vLst1.Add(s);

pQu.Next;

end;

vPath := 'c:koalatemp';

gy_Create_Dir(vPath);

vLst1.SaveToFile(vPath+'koala.csv');

gy_uyari_mesaji('Uyari', vPath+'koala.csv dosyasi yaratildi.'+chr(13)+' Sütün Ayiraci ; kullanildi',MB_OK);

s := gy_register_oku(false,'softwareclassesapplicationsexcel.exeshellopencommand',");

if s=" then

s := gy_register_oku(false,'softwareclassesexcel.csvshellopencommand',");

gy_calistir(1,s+' '+vPath+'koala.csv');

end;