Programlama yapalım ve Öğrenelim.

Stringgrid yazıcıdan alma

Selam arkadaşlar aşağıdaki kodu internette buldum.

Denedim çalışıyor.

****************************************************

uses Printers;

procedure PrintGrid(sGrid: TStringGrid; sTitle: string);

var

X1, X2: Integer;

Y1, Y2: Integer;

TmpI: Integer;

F: Integer;

TR: TRect;

begin

Printer.Title := sTitle;

Printer.BeginDoc;

Printer.Canvas.Pen.Color := 0;

Printer.Canvas.Font.Name := 'Times New Roman';

Printer.Canvas.Font.Size := 12;

Printer.Canvas.Font.Style := [fsBold, fsUnderline];

Printer.Canvas.TextOut(0, 100, Printer.Title);

for F := 1 to sGrid.ColCount - 1 do

begin

X1 := 0;

for TmpI := 1 to (F - 1) do

X1 := X1 + 5 * (sGrid.ColWidths[TmpI]);

Y1 := 300;

X2 := 0;

for TmpI := 1 to F do

X2 := X2 + 5 * (sGrid.ColWidths[TmpI]);

Y2 := 450;

TR := Rect(X1, Y1, X2 - 30, Y2);

Printer.Canvas.Font.Style := [fsBold];

Printer.Canvas.Font.Size := 7;

Printer.Canvas.TextRect(TR, X1 + 50, 350, sGrid.Cells[F, 0]);

Printer.Canvas.Font.Style := [];

for TmpI := 1 to sGrid.RowCount - 1 do

begin

Y1 := 150 * TmpI + 300;

Y2 := 150 * (TmpI + 1) + 300;

TR := Rect(X1, Y1, X2 - 30, Y2);

Printer.Canvas.TextRect(TR, X1 + 50, Y1 + 50, sGrid.Cells[F, TmpI]);

end;

Printer.EndDoc;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

PrintGrid(StringGrid1, 'Print Stringgrid');

end;

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

sistem vista'mı

uses

Windows;

//------------------------------------------------------------------------------

function IsVista: boolean;

var

hKernel32: HMODULE;

begin

hKernel32 := GetModuleHandle('kernel32');

if (hKernel32 > 0) then

begin

Result := GetProcAddress(hKernel32, 'GetLocaleInfoEx') <> nil;

end

else

Result := false;

end;

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

Delphi 2007 ile ana formu taskbardan gizlemek

Nedenini anlamadığım bir şekilde D2007'de standart yöntemlerle formunuzu taskbardan(görev çubuğu)

gizlemeniz imkansız ancak tabiiki bununda bir yöntemi var..

Application.MainFormOnTaskbar := False;

//Bu satırı programın kaynak koduna (View->Source Code) herhangi bir formu create etmeden öncesine

//yazınız.

ShowWindow(Application.Handle, SW_HIDE) ;

//Bu satırı ise ana formunuzun OnActivate veya OnShow olayına (OnCreate'e değil) yazın...

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

Listview'de Gruplandırma

// Bana çok lazım olmuştu. GençTürk arkadaşımız yardımcı olmuştu

//tekrar teşekkür ediyorum GençTürk

uses commctrl;

type

TLVGROUP = record

cbSize: UINT;

mask: UINT;

pszHeader: LPWSTR;

cchHeader: Integer;

pszFooter: LPWSTR;

cchFooter: Integer;

iGroupIdL: Integer;

stateMask: UINT;

state: UINT;

uAlign: UINT;

end;

tagLVITEMA = packed record

mask: UINT;

iItem: Integer;

iSubItem: Integer;

state: UINT;

stateMask: UINT;

pszText: PAnsiChar;

cchTextMax: Integer;

iImage: Integer;

lParam: lParam;

iIndent: Integer;

iGroupId: Integer;

cColumns: UINT;

puColumns: PUINT;

end;

TLVITEMA = tagLVITEMA;

const

LVM_ENABLEGROUPVIEW = LVM_FIRST + 157;

LVM_MOVEITEMTOGROUP = LVM_FIRST + 154;

LVM_INSERTGROUP = LVM_FIRST + 145;

LVIF_GROUPID = $0100;

LVGF_HEADER = $00000001;

LVGF_ALIGN = $00000008;

LVGF_GROUPID = $00000010;

LVGA_HEADER_LEFT = $00000001;

LVGA_HEADER_CENTER = $00000002;

LVGA_HEADER_RIGHT = $00000004;

procedure TForm1.Button1Click(Sender: TObject);

var

LvGroup: TLVGROUP;

LvItemA: TLVITEMA;

ListItem: TListItem;

I: Byte;

begin

Randomize;

for i := 1 to 10 do

begin

ListItem := ListView1.Items.Add;

ListItem.Caption := IntToStr(Random(100));

end;

SendMessage(ListView1.Handle, LVM_ENABLEGROUPVIEW, 1, 0);

FillChar(LvGroup, SizeOf(TLVGROUP), 0);

with LvGroup do

begin

cbSize := SizeOf(TLVGROUP);

mask := LVGF_HEADER or LVGF_ALIGN or LVGF_GROUPID;

pszHeader := 'Group 1';

cchHeader := Length(LvGroup.pszHeader);

iGroupIdL := 0;

uAlign := LVGA_HEADER_CENTER;

end;

SendMessage(ListView1.Handle, LVM_INSERTGROUP, 0, Longint(@LvGroup));

FillChar(LvGroup, SizeOf(LvGroup), 0);

with LvGroup do

begin

cbSize := SizeOf(TLVGROUP);

mask := LVGF_HEADER or LVGF_ALIGN or LVGF_GROUPID;

pszHeader := 'Group 2';

cchHeader := Length(LvGroup.pszHeader);

iGroupIdL := 1;

uAlign := LVGA_HEADER_LEFT

end;

SendMessage(ListView1.Handle, LVM_INSERTGROUP, 1, Longint(@LvGroup));

for I := 0 to ListView1.Items.Count - 1 do

begin

with LvItemA do

begin

FillChar(LvItemA, SizeOf(TLvItemA), 0);

mask := LVIF_GROUPID;

iItem := I;

iGroupId := Random(2);

end;

SendMessage(ListView1.Handle, LVM_SETITEM, 0, Longint(@LvItemA))

end;

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

delphi'de minik exe 960 byte {by themrigi ilhan}

960 byte exe boyutu

delphi ile bir messagebox uygulaması

delphi ile yapılabilecek "minik" uygulamalardan örnektir

"derle-build.bat" dosyasını çalıştırın, "a1.exe" oluşacaktır.

çalıştırın, bir de boyutuna bakın :)

herkese iyi çalışmalar.

(tabiki derleyebilmeniz için gerekli dosyalarda var zipli dosyanın boyutu bundan dolayı büyük.)

themrigi (ilhan)

link:

http://...................................../DownloadFile.aspx?PostId=33479&Destination=UserPosts%2f11153.960bytelikDelphiEXE.zip

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

Fiyat Taksitlendirme Programı Örneği

unit Unit1;

interface

uses

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

Dialogs, StdCtrls, ExtCtrls;

type

TForm1 = class(TForm)

Edit1: TEdit;

Edit2: TEdit;

Edit3: TEdit;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Button1: TButton;

Panel1: TPanel;

ComboBox1: TComboBox;

Label4: TLabel;

Label5: TLabel;

Label6: TLabel;

Edit4: TEdit;

RadioGroup1: TRadioGroup;

procedure FormCreate(Sender: TObject);

procedure RadioButton2Click(Sender: TObject);

procedure RadioButton1Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure RadioGroup1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

uses Math;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

//ComboBox1.Visible:=false;

//label4.Visible:=false;

//label5.Visible:=false;

//label6.Visible:=false;

//edit4.Visible:=false;

panel1.Visible:=false;

end;

procedure TForm1.RadioButton2Click(Sender: TObject);

begin

panel1.Visible:=true;

{ComboBox1.Visible:=true;

label4.Visible:=true;

label5.Visible:=true;

label6.Visible:=true;

edit4.Visible:=true;}

end;

procedure TForm1.RadioButton1Click(Sender: TObject);

begin

panel1.Visible:=false;

{

ComboBox1.Visible:=false;

label4.Visible:=false;

label5.Visible:=false;

label6.Visible:=false;

edit4.Visible:=false;}

end;

procedure TForm1.Button1Click(Sender: TObject);

var

x:integer;

begin

x:=strtointdef(edit1.Text,1)*strtointdef(edit2.Text,1);

If RadioGroup1.ItemIndex=0 then

edit3.Text:=floattostr(x*0.9);

If RadioGroup1.ItemIndex=1 then

begin

edit3.Text:=floattostr((x*1.10)/strtoint(ComboBox1.Text));

edit4.Text:=floattostr(x*1.10);

label5.Caption:=ComboBox1.Text;

end;

procedure TForm1.RadioGroup1Click(Sender: TObject);

begin

if RadioGroup1.ItemIndex=0 then panel1.Visible:=false

else panel1.Visible:=true;

end;

end.

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

Sanal Klayve İle Şifreli Giriş Örneği

unit Unit1;

interface

uses

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

Dialogs, StdCtrls, Buttons;

type

TForm1 = class(TForm)

Edit1: TEdit;

SpeedButton1: TSpeedButton;

SpeedButton2: TSpeedButton;

SpeedButton3: TSpeedButton;

SpeedButton4: TSpeedButton;

SpeedButton5: TSpeedButton;

SpeedButton6: TSpeedButton;

SpeedButton7: TSpeedButton;

SpeedButton8: TSpeedButton;

SpeedButton9: TSpeedButton;

SpeedButton10: TSpeedButton;

SpeedButton11: TSpeedButton;

SpeedButton12: TSpeedButton;

Button1: TButton;

procedure Button1Click(Sender: TObject);

procedure SpeedButton7Click(Sender: TObject);

procedure SpeedButton11Click(Sender: TObject);

procedure SpeedButton10Click(Sender: TObject);

procedure SpeedButton8Click(Sender: TObject);

procedure SpeedButton9Click(Sender: TObject);

procedure SpeedButton4Click(Sender: TObject);

procedure SpeedButton5Click(Sender: TObject);

procedure SpeedButton6Click(Sender: TObject);

procedure SpeedButton1Click(Sender: TObject);

procedure SpeedButton2Click(Sender: TObject);

procedure SpeedButton3Click(Sender: TObject);

procedure SpeedButton12Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

bizimString:string;

implementation

uses Unit2;

{$R *.dfm}

function RandomDizi(uzunluk:Integer):string;

var

str:string;

i:byte;

temp_random:integer;

begin

Randomize;

for i:=0 to 9 do

random(10);

str:='0123456789';

Result:='';

repeat

temp_random:=Random(Length(str))+1;

if str[temp_random]<>'x' then

begin

Result:=Result+str[temp_random];

str[temp_random]:='x'

end;

until(Length(Result)=uzunluk)

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

if edit1.text='1234' then

showmessage('işleminiz gerçekleşiyor.Bekleyiniz');

if edit1.text='1234' then form2.Show ;

if edit1.text='1234' then form1.hide;

if edit1.text='' then

showmessage('Şifrenizi giriniz');

if edit1.text<>'1234' then

if edit1.text<>'' then form1.Close;

end;

procedure TForm1.SpeedButton7Click(Sender: TObject);

var

a:string;

begin

a:=copy(edit1.text,1,length(edit1.text)-1);

edit1.text:=a;

end;

procedure TForm1.SpeedButton11Click(Sender: TObject);

begin

edit1.text:='';

end;

procedure TForm1.SpeedButton10Click(Sender: TObject);

begin

edit1.Text:=edit1.Text+(sender as tspeedbutton).caption;

edit1.PasswordChar:='*';

bizimstring:=randomdizi(10);

speedbutton10.Caption:=copy(bizimstring,1,1);

speedbutton8.Caption:=copy(bizimstring,2,1);

speedbutton9.Caption:=copy(bizimstring,3,1);

speedbutton3.Caption:=copy(bizimstring,4,1);

speedbutton2.Caption:=copy(bizimstring,5,1);

speedbutton1.Caption:=copy(bizimstring,6,1);

speedbutton6.Caption:=copy(bizimstring,7,1);

speedbutton5.Caption:=copy(bizimstring,8,1);

speedbutton4.Caption:=copy(bizimstring,9,1);

speedbutton12.Caption:=copy(bizimstring,10,1);

end;

procedure TForm1.SpeedButton8Click(Sender: TObject);

begin

edit1.Text:=edit1.Text+(sender as tspeedbutton).caption;

edit1.PasswordChar:='*';

bizimstring:=randomdizi(10);

speedbutton10.Caption:=copy(bizimstring,1,1);

speedbutton8.Caption:=copy(bizimstring,2,1);

speedbutton9.Caption:=copy(bizimstring,3,1);

speedbutton3.Caption:=copy(bizimstring,4,1);

speedbutton2.Caption:=copy(bizimstring,5,1);

speedbutton1.Caption:=copy(bizimstring,6,1);

speedbutton6.Caption:=copy(bizimstring,7,1);

speedbutton5.Caption:=copy(bizimstring,8,1);

speedbutton4.Caption:=copy(bizimstring,9,1);

speedbutton12.Caption:=copy(bizimstring,10,1);

end;

procedure TForm1.SpeedButton9Click(Sender: TObject);

begin

edit1.Text:=edit1.Text+(sender as tspeedbutton).caption;

edit1.PasswordChar:='*';

bizimstring:=randomdizi(10);

speedbutton10.Caption:=copy(bizimstring,1,1);

speedbutton8.Caption:=copy(bizimstring,2,1);

speedbutton9.Caption:=copy(bizimstring,3,1);

speedbutton3.Caption:=copy(bizimstring,4,1);

speedbutton2.Caption:=copy(bizimstring,5,1);

speedbutton1.Caption:=copy(bizimstring,6,1);

speedbutton6.Caption:=copy(bizimstring,7,1);

speedbutton5.Caption:=copy(bizimstring,8,1);

speedbutton4.Caption:=copy(bizimstring,9,1);

speedbutton12.Caption:=copy(bizimstring,10,1);

end;

procedure TForm1.SpeedButton4Click(Sender: TObject);

begin

edit1.Text:=edit1.Text+(sender as tspeedbutton).caption;

edit1.PasswordChar:='*';

bizimstring:=randomdizi(10);

speedbutton10.Caption:=copy(bizimstring,1,1);

speedbutton8.Caption:=copy(bizimstring,2,1);

speedbutton9.Caption:=copy(bizimstring,3,1);

speedbutton3.Caption:=copy(bizimstring,4,1);

speedbutton2.Caption:=copy(bizimstring,5,1);

speedbutton1.Caption:=copy(bizimstring,6,1);

speedbutton6.Caption:=copy(bizimstring,7,1);

speedbutton5.Caption:=copy(bizimstring,8,1);

speedbutton4.Caption:=copy(bizimstring,9,1);

speedbutton12.Caption:=copy(bizimstring,10,1);

end;

procedure TForm1.SpeedButton5Click(Sender: TObject);

begin

edit1.Text:=edit1.Text+(sender as tspeedbutton).caption;

edit1.PasswordChar:='*';

bizimstring:=randomdizi(10);

speedbutton10.Caption:=copy(bizimstring,1,1);

speedbutton8.Caption:=copy(bizimstring,2,1);

speedbutton9.Caption:=copy(bizimstring,3,1);

speedbutton3.Caption:=copy(bizimstring,4,1);

speedbutton2.Caption:=copy(bizimstring,5,1);

speedbutton1.Caption:=copy(bizimstring,6,1);

speedbutton6.Caption:=copy(bizimstring,7,1);

speedbutton5.Caption:=copy(bizimstring,8,1);

speedbutton4.Caption:=copy(bizimstring,9,1);

speedbutton12.Caption:=copy(bizimstring,10,1);

end;

procedure TForm1.SpeedButton6Click(Sender: TObject);

begin

edit1.Text:=edit1.Text+(sender as tspeedbutton).caption;

edit1.PasswordChar:='*';

bizimstring:=randomdizi(10);

speedbutton10.Caption:=copy(bizimstring,1,1);

speedbutton8.Caption:=copy(bizimstring,2,1);

speedbutton9.Caption:=copy(bizimstring,3,1);

speedbutton3.Caption:=copy(bizimstring,4,1);

speedbutton2.Caption:=copy(bizimstring,5,1);

speedbutton1.Caption:=copy(bizimstring,6,1);

speedbutton6.Caption:=copy(bizimstring,7,1);

speedbutton5.Caption:=copy(bizimstring,8,1);

speedbutton4.Caption:=copy(bizimstring,9,1);

speedbutton12.Caption:=copy(bizimstring,10,1);

end;

procedure TForm1.SpeedButton1Click(Sender: TObject);

begin

edit1.Text:=edit1.Text+(sender as tspeedbutton).caption;

edit1.PasswordChar:='*';

bizimstring:=randomdizi(10);

speedbutton10.Caption:=copy(bizimstring,1,1);

speedbutton8.Caption:=copy(bizimstring,2,1);

speedbutton9.Caption:=copy(bizimstring,3,1);

speedbutton3.Caption:=copy(bizimstring,4,1);

speedbutton2.Caption:=copy(bizimstring,5,1);

speedbutton1.Caption:=copy(bizimstring,6,1);

speedbutton6.Caption:=copy(bizimstring,7,1);

speedbutton5.Caption:=copy(bizimstring,8,1);

speedbutton4.Caption:=copy(bizimstring,9,1);

speedbutton12.Caption:=copy(bizimstring,10,1);

end;

procedure TForm1.SpeedButton2Click(Sender: TObject);

begin

edit1.Text:=edit1.Text+(sender as tspeedbutton).caption;

edit1.PasswordChar:='*';

bizimstring:=randomdizi(10);

speedbutton10.Caption:=copy(bizimstring,1,1);

speedbutton8.Caption:=copy(bizimstring,2,1);

speedbutton9.Caption:=copy(bizimstring,3,1);

speedbutton3.Caption:=copy(bizimstring,4,1);

speedbutton2.Caption:=copy(bizimstring,5,1);

speedbutton1.Caption:=copy(bizimstring,6,1);

speedbutton6.Caption:=copy(bizimstring,7,1);

speedbutton5.Caption:=copy(bizimstring,8,1);

speedbutton4.Caption:=copy(bizimstring,9,1);

speedbutton12.Caption:=copy(bizimstring,10,1);

end;

procedure TForm1.SpeedButton3Click(Sender: TObject);

begin

edit1.Text:=edit1.Text+(sender as tspeedbutton).caption;

edit1.PasswordChar:='*';

bizimstring:=randomdizi(10);

speedbutton10.Caption:=copy(bizimstring,1,1);

speedbutton8.Caption:=copy(bizimstring,2,1);

speedbutton9.Caption:=copy(bizimstring,3,1);

speedbutton3.Caption:=copy(bizimstring,4,1);

speedbutton2.Caption:=copy(bizimstring,5,1);

speedbutton1.Caption:=copy(bizimstring,6,1);

speedbutton6.Caption:=copy(bizimstring,7,1);

speedbutton5.Caption:=copy(bizimstring,8,1);

speedbutton4.Caption:=copy(bizimstring,9,1);

speedbutton12.Caption:=copy(bizimstring,10,1);

end;

procedure TForm1.SpeedButton12Click(Sender: TObject);

begin

edit1.Text:=edit1.Text+(sender as tspeedbutton).caption;

edit1.PasswordChar:='*';

bizimstring:=randomdizi(10);

speedbutton10.Caption:=copy(bizimstring,1,1);

speedbutton8.Caption:=copy(bizimstring,2,1);

speedbutton9.Caption:=copy(bizimstring,3,1);

speedbutton3.Caption:=copy(bizimstring,4,1);

speedbutton2.Caption:=copy(bizimstring,5,1);

speedbutton1.Caption:=copy(bizimstring,6,1);

speedbutton6.Caption:=copy(bizimstring,7,1);

speedbutton5.Caption:=copy(bizimstring,8,1);

speedbutton4.Caption:=copy(bizimstring,9,1);

speedbutton12.Caption:=copy(bizimstring,10,1);

end;

end.

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

Dbgrid nesnesinde Next veya prior ile seçilli şekilde ilerleme

procedure TUrunRaporForm.DBGrid1DrawColumnCell(Sender: TObject;

const Rect: TRect; DataCol: Integer; Column: TColumn;

State: TGridDrawState);

begin

DBGrid1.SelectedField.FocusControl;

end;

// Fuat Kılınç //Altun iş Bilgisayar ve yazılım

// fuatkilinc80@hotmail.com

//Butonlarla ileri geri tuşlarında yarayışlı bi kod

// bu arada DBGrid nesnesinin options ayarlarından dgrowselect ayarını true yapmayı unutmayın

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

Form'a alt-üst mıknatıs (magnet) özelliği eklemek

öncelikle Kodbank'a vagrant6600 isimli arkadaşın eklediği ve Windows'un taskbar'ının yüksekliğini

bulan fonksiyonu ekliyoruz. (Bu sayede form taskbarın arkasında yada önünde kalmayacak - eğer istemezseniz

eklemezsiniz..)

function TaskBarHeight: integer;

var

hTB: HWND; // taskbar handle

TBRect: TRect; // taskbar rectangle

begin

hTB:= FindWindow('Shell_TrayWnd', '');

if hTB = 0 then

Result := 0

else begin

GetWindowRect(hTB, TBRect);

Result := TBRect.Bottom - TBRect.Top;

end;

daha sonra formun taşınmasını algılayan bir prosedür aracılığı ile (kodbank'tan örneklere ulaşabilirsiziz)

gerkli kontrolü yaparak bitiriyoruz... (Bu örnekte bir image nesnesi ile form taşınabilmektedir

o yüzden de kod bu image'in MouseDown yordamına eklenmiştir..)

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

Shift: TShiftState; X, Y: Integer);

begin

ReleaseCapture; // BU İKİ SATIR FORMUN İMAGE NESNESİ

Form1.perform(WM_SYSCOMMAND, $F012, 0); // İLE TAŞINABİLMESİNİ SAĞLAR

//---------------------------------------------------------------------------------------------------------

if Form1.Top<Screen.Height-(Form1.Top+Form1.Height) then //BU İKİ SATIR İSE FORMUMUZA

Form1.Top:=0 else Form1.Top:=Screen.Height-Form1.Height-TaskBarHeight; //EKRANDA MAGNET ÖZELLİĞİ KAZANDIRIR

end;

ÖNEMLİ NOT: Burada programın top değerinin ekranın üstüne, ve Top+Height(Alt diyebiliriz) değerinin ise

ekranın altına (Taskbarın yüksekliği hariç) olan uzaklıklarını aldık ve eğer formumuz ekranın üstüne yakın

ise yukarı altına yakın ise aşağı magnet ile gitmesini sağladık. Artık siz sağ-sol, magnet uzaklığı

veya uzaklıklar eşit ise şunu yap gibi eklemeleri halledersiniz.. Biliyorum basit ama bana lazım olmuştu

ve işimide görmüştü bende paylaşayım dedim ;) İyi kodlamalar....

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

Form Resmin Şeklini Alsın

Bu kod sayesinde formunuz istediğiniz bir resmin şeklini alabilir, yalnız unutmamanız gereken konu

şudur: Bu kod belirlediğiniz resmin sadece şeklini forma yansıtır, formu o resim ile kaplamaz...

//----------------------------------------------------

ilk önce type bloğunuzu aşağıdaki gibi düzenleyin

type

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

PRGBArray = ^TRGBArray;

TForm1 = class(TForm)

daha sonra prive alanına 1 tane tanımlama 1 fonsiyon birde prosedür ekliyoruz..

private

FRegion: THandle;

procedure kaplama;

function CreateRegion(Bmp: TBitmap): THandle;

{ Private declarations }

son olarakta "kaplama" ve "CreateRegion" prosedür ve fonksiyonlarını ekliyoruz..

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

var

X, Y, StartX:Integer;

Excl: THandle;

Row: PRGBArray;

TransparentColor: TRGBTriple;

begin

// Change the format so we know how to compare

// the colors

Bmp.PixelFormat := pf24Bit;

// Create a region of the whole bitmap

// later we will take the transparent

// bits away

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

// Loop down the bitmap

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

begin

// Get the current row of pixels

Row := Bmp.Scanline[Y];

// If its the first get the transparent

// color, it must be the top left pixel

if Y = 0 then

begin

TransparentColor := Row[0];

end;

// Reset StartX (-1) to indicate we have

// not found a transparent area yet

StartX := -1;

// Loop across the row

for X := 0 to Bmp.Width do

begin

// Check for transparency by comparing the color

if(X <> Bmp.Width) and

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

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

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

begin

// We have (X <> Bmp.Width) in the clause so that

// when we go past the end of the row we we can

// exclude the remaining transparent area (if any)

// If its transparent and the previous wasn't

// remember were the transparency started

if StartX = -1 then

begin

StartX := X;

end;

end

else

begin

// Its not transparent

if StartX > -1 then

begin

// If previous pixels were transparent we

// can now exclude the from the region

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

try

// Remove the exclusion from our original region

CombineRGN(Result, Result, Excl, RGN_DIFF);

// Reset StartX so we can start searching

// for the next transparent area

StartX := -1;

finally

DeleteObject(Excl);

end;

procedure TForm1.kaplama;

var

Bmp: TBitmap;

Xp: Variant;

begin

Bmp := TBitmap.Create;

try

Bmp.LoadFromFile('C:resim.bmp'); // eğer burayı bmp.picture:=Image1.picture yaparsanız image1'in

FRegion := CreateRegion(Bmp); // resmini de kullanabilirsiniz....

SetWindowRGN(Handle, FRegion, True);

// xp := findwindow('self_burned','modulates');

// setwindowrgn(xp,fregion,true);

application.ProcessMessages;

finally

Bmp.Free;

end;

kullanmaya başlamak içinse:

Formun create yordamına kaplama prosedürünü ekliyoruz..

procedure TForm1.FormCreate(Sender: TObject);

begin

kaplama;

end;

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

Program içinde program

Bu kodlar sayesinde bir exe programı diğer bir exe program içerisinde MDI Child olarak çalıştırabilirsiniz..

// Kodla bir siteden alıntıdır örnek'te Notepad kullanılmış, ve birçok windows uyguaması için denenmiştir..

// Başka programlar içinse 'Adsız - Not Defteri' kısımı istediğiniz programın Başlık bilgisini yazmanız

//yeterli

procedure TForm1.Button1Click(Sender: TObject);

var

hNotePad, Style: Cardinal;

begin

// button click event

hNotePad := FindWindow(nil, 'Adsız - Not Defteri');

if hNotePad = 0 then

begin

ShowMessage('NotePad Çalışmıyor');

Exit;

end;

ShowWindow(hNotePad, SW_HIDE);

Style := GetWindowLong(hNotePad, GWL_STYLE);

if Style = 0 then

begin

ShowMessage('Sistem Stil verisine ulaşamadı');

Exit;

end;

Style := Style or WS_CHILD; // to be attatched to another window I think u need a ws_child

SetWindowLong(hNotePad, GWL_STYLE, Style);

windows.SetParent(hNotePad, Handle);

MoveWindow(hNotePad, 2,2, Width-10, Height - 56, True);

ShowWindow(hNotePad, SW_SHOW);

end;

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

Küme Tipli Değerin String Karşılığı

{Küme tipli değişkende bulunan rakamların string olarak karşılığını veren kod}

type TSetOfByte=set of Byte;

function SetOfByteToStr(const B:TSetOfByte):String;

var i,Son:Integer; Varmi:Boolean;

begin

Result:='';

Varmi:=False;

Son:=0;

for i:=0 to 255 do begin

if (i in B) then begin

if not Varmi then begin

if (Result<>'') then Result:=Result+',';

Result:=Result+IntToStr(i);

Son:=i;

end else if (i=255) then Result:=Format('%s..%d',[Result,i]);

Varmi:=True;

end else begin

if ((Varmi) and (Son<>i-1)) then begin

Son:=i-1;

Result:=Format('%s..%d',[Result,Son]);

end;

Varmi:=False;

end;

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

GDI+ ile çizim

Bu konuda açıkçası kaynak sayısı çok az ve varolanda anlaşılması oldukça zor. Bende HavaCiva isimli

programın hazırlayıcısı A.Şentürk'e bir e-posta gönderdim konu ile ilgili ve kendisi sağolsun bana aşağıdaki

kodları yolladı, kendisinin izni ile bende bu kodları sizlerle paylaşayım dedim. Ve birde müjdeli

haber vereyim sizlere, kendisi Delphi'de GDI+ teklnikler ile ilgili bir makale yayınlamayı düşünüyormuş...

Bu kodlar basit bir saat uygulamasının GDI+ teknikleri kullanarak arayüz ile hazırlanmış halidir..

Aşağıdaki kodlarla ilgili Sayın ŞENTÜRK'ün notu :

Programın tamamen "Generic" olarak tasarlandı. Birçok yönden eksiklikler

içerir. Örneğin renklendirme gibi. Bunu belirtirseniz sevinirim.

Kolay gelsin...

Sayın ŞENTÜRK'e teşekkürler...

//--------------------------------------------------------------------------------

Öncelikle internette GDIPLUS şeklinde aratıp GDIPlus kütüphanesini Delphi ye ekleyin ve..

NOT: Bu eğitim amaçlı programın tüm dosyalarını ve derlenmiş halini

http://rapidshare.com/files/170827754/Generic_Clock.rar

adresinden indirebilirsiniz...

unit Main;

interface

uses

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

Dialogs, StdCtrls, GdipApi, GdipObj, ExtCtrls;

type

TForm1 = class(TForm)

CloseBtn: TButton;

TimeStaticText: TStaticText;

Timer1: TTimer;

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure FormMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure CloseBtnClick(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

private

{ Private declarations }

FGraphics: TGPGraphics;

FBitmap: TGPBitmap;

FBackground: TGPBitmap;

FCloseButton: TGPBitmap;

FOverlay: TGPBitmap;

FOpacity: Byte;

public

{ Public declarations }

procedure UpdateLayeredForm;

procedure RepaintForm;

procedure PaintBackground;

procedure PaintOverlay;

procedure PaintCloseButton;

procedure PaintTimeStaticText;

procedure ClearGraphics;

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

const

SC_DRAGMOVE = $F012;

{ MakeRectF }

function MakeRectF(const Rect: TRect): TGPRectF;

begin

Result.X := Rect.Left;

Result.Y := Rect.Top;

Result.Width := Rect.Right - Rect.Left;

Result.Height := Rect.Bottom - Rect.Top;

end;

{ GdiPlusDrawText }

{ Kotu bir tekniktir. Ama ogreticidir. }

procedure GdiPlusDrawText(Graphics: TGPGraphics; StaticText: TStaticText;

FontStyle: FontStyle = FontStyleRegular;

Alignment: StringAlignment = StringAlignmentNear;

GPColor: TGPColor = aclBlack);

var

GPBrush: TGPSolidBrush;

GPFont: TGPFont;

GPFormat: TGPStringFormat;

GPRect: TGPRectF;

begin

GPBrush := TGPSolidBrush.Create(GPColor);

try

GPFont := TGPFont.Create(StaticText.Font.Name, StaticText.Font.Size, FontStyle);

try

GPFormat := TGPStringFormat.Create;

try

Graphics.SetTextRenderingHint(TextRenderingHintAntiAlias);

GPFormat.SetAlignment(Alignment);

GPRect := MakeRectF(StaticText.BoundsRect);

Graphics.DrawString(StaticText.Caption, Length(StaticText.Caption), GPFont, GPRect, GPFormat, GPBrush);

finally

GPFormat.Free;

end;

finally

GPFont.Free;

end;

finally

GPBrush.Free;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

{ Zemin resmini yukle }

FBackground := TGPBitmap.Create('.Base.png');

{ Kaplama icin resmi yukle. Kaplama programa ayri bir gorsellik katiyor. Sadece onun icin. }

FOverlay := TGPBitmap.Create('.Overlay.png');

FCloseButton := TGPBitmap.Create('.Close.png');

{ Ana formun genislik ve yuksekligini Background resmi ile ayni yap ki tasma veya kirpilma olmasin. }

Width := FBackground.GetWidth;

Height := FBackground.GetHeight;

{ Programin can damari burada. Ana formu "Katmanli Pencere" sitiline gecirmeliyiz. }

{ Yoksa hicbir etkisi olmaz! }

SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);

{ Hafizada, ana form boyutlarinda bos bir resim olusturuyoruz. }

{ Resim formati 32bit Alpha Channel. Burasi cok onemli. Yoksa golgeler olusmaz! }

FBitmap := TGPBitmap.Create(Width, Height, PixelFormat32bppARGB); { Zaten default PixelFormat32bppARGB }

{ Basit bir teknik. TGPGrahics sinifi aslinda TCanvas sinifina denk duser, unutmayin! }

{ FGraphics ile yapilan cizimler aynen FBitmap nesnesine yapilir. Dogal olarak }

{ formumuza cizmis olacagiz. Ayni TForm sinifindaki Canvas nesnesi gibi! }

FGraphics := TGPGraphics.Create(FBitmap);

{ Opacity (Donukluk). Delphi formlarindaki AlphaBlendValue ile aynidir. }

{ Fakat burada FOpacity degiskeni ile formumuzun donuklugunu (yada saydamligini) }

{ ayarlayacagiz. Bkz. procedure UpdateLayeredForm; }

FOpacity := $FF; { $FF = tam donuk. }

{ Evet. Formu artik cizebiliriz. }

RepaintForm;

{ Iste en onemli proseduru cagirma zamani. Hersey tamam, artik Windows'a }

{ form uzerinde olusturdugumuz resmi, pencere ile butunlestirme zamani geldi. }

UpdateLayeredForm;

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

{ Herseyi at. Yoksa hafiza sizmasi (Memory Leak) olusur. }

FCloseButton.Free;

FOverlay.Free;

FBackground.Free;

FBitmap.Free;

FGraphics.Free;

end;

procedure TForm1.RepaintForm;

begin

{ Herseyi temizlemek gerek. Onceki cizimler silinmezse ust uste biner. }

ClearGraphics;

{ Zemin resmini ciz. }

PaintBackground;

{ Adindan da anlasiliyor zaten. }

PaintCloseButton;

{ TimeStaticText'i ciz }

PaintTimeStaticText;

{ Kaplama resmini ciz. }

PaintOverlay;

end;

procedure TForm1.UpdateLayeredForm;

var

SrcDC, DestDC: HDC;

BitmapHandle, PrevBitmap: HBITMAP;

BlendFunc: _BLENDFUNCTION;

Size: TSize;

P, S: TPoint;

begin

{ Desktop ile uyumlu bir DC olustur. (Yada 0 yerine GetDesktopWindow yazabiliriz) }

SrcDC := CreateCompatibleDC(0);

{ Olusturdugumuz DC ile uyumlu yeni bir DC daha olusturmaliyiz. Kopyalama icin. }

DestDC := CreateCompatibleDC(SrcDC);

{ Cizim yaptigimiz resmin Windows tarafidan anlasilan HBITMAP turunden degiskene ata. }

{ Bu kisim onemli. Cizim yaptigimiz resmi gercek dunyaya getiriyoruz. }

{ BitmapHandle degiskeni artik Windows tarafindan kullanilanilabilir duruma geldi. }

FBitmap.GetHBITMAP(0, BitmapHandle); { 0 = Background transparents, out BitmapHandle }

{ SrcDC de bitmap secilmeli }

PrevBitmap := SelectObject(SrcDC, BitmapHandle);

{ Boyutlar ve konum }

Size.cx := Width;

Size.cy := Height;

P := Point(Left, Top);

S := Point(0, 0);

with BlendFunc do

begin

BlendOp := AC_SRC_OVER;

BlendFlags := 0; { Sifir olmali }

SourceConstantAlpha := FOpacity; { Ana formun donukluk degeri. 0 = tam saydam, 255 = tam donuk. }

AlphaFormat := AC_SRC_ALPHA;

end;

{ Microsoft'un sihirli fonksiyonu! Oylesine onemli ki, aslinda butun kiyamet burada kopuyor. }

{ Detayli aciklamayi MSDN' den mutlaka okuyunuz. http://msdn.microsoft.com/en-us/library/ms633556(VS.85).aspx }

UpdateLayeredWindow(Handle, DestDC, @P, @Size, SrcDC, @S, 0, @BlendFunc, ULW_ALPHA);

{ SrcDC yi eski haline getir. }

SelectObject(SrcDC, PrevBitmap);

{ ve Bitmap'i yok et. Yoksa hafiza sizmasi olur. }

DeleteObject(BitmapHandle);

{ DC leri yok et. }

DeleteDC(DestDC);

DeleteDC(SrcDC);

end;

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

Shift: TShiftState; X, Y: Integer);

begin

if Button = mbLeft then

begin

{ Almanyada bulundugum zamanlarda Mayersche de okudugum bir Delphi kitabinda }

{ gordugum bir teknik. Oldukca kullanislidir. Windows'un pek bilinmeyen }

{ sistem komutlarindan biridir. }

ReleaseCapture;

SendMessageW(Handle, WM_SYSCOMMAND, SC_DRAGMOVE, 0);

end;

procedure TForm1.PaintBackground;

begin

FGraphics.DrawImage(FBackground, 0, 0);

end;

procedure TForm1.PaintOverlay;

begin

FGraphics.DrawImage(FOverlay, 0, 0);

end;

procedure TForm1.PaintCloseButton;

begin

FGraphics.DrawImage(FCloseButton, CloseBtn.Left, CloseBtn.Top,

FCloseButton.GetWidth, FCloseButton.GetHeight);

end;

procedure TForm1.CloseBtnClick(Sender: TObject);

begin

Close;

end;

procedure TForm1.PaintTimeStaticText;

begin

TimeStaticText.Caption := FormatDateTime('hh:nn:ss', SysUtils.Now);

GdiPlusDrawText(FGraphics, TimeStaticText, FontStyleBold, StringAlignmentCenter, aclWhite);

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

{ Her saniye form alanini yeniden cizmek zorundayiz. }

RepaintForm;

{ Ayrica cizdigimiz form alanini guncellemeliyiz. }

UpdateLayeredForm;

end;

procedure TForm1.ClearGraphics;

begin

FGraphics.Clear($00000000);

end;

end.

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

For döngüsünden kaçış - çıkmak

önce global bir değişken tanımlayalım (alıntı nın açıklanmış halidir diyelim ;) )

var cik : Boolean;

daha sonra mesela progressbar'a değer atıyor olalım ve bunu Button1 in clik yordamı ile başlatalım

procedure TForm1.Button1Click(Sender: TObject);

var a : Integer;

begin

cik := false;

ProgressBar1.Min := 0;

ProgressBar1.Max := 1000000;

for a:=0 to 1000000 do begin

ProgressBar1.Position := a;

Application.ProcessMessages; // Böylece bilgisayarı çok az bir zamanlığına oyaladık

if (Application.Terminated) OR (cik) then break; //o sıarada Button 2 aracılığı ile

end; //cik değerinin true olmasını sağlıyacağız

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

cik := true;

end;

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