13 tane ipiucu

[By_FUCKan]

1-//GroupBox içindeki bir nesneye ulaşmak
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
procedure DoSomethingWithAGroupBox;
var
i : integer;
begin
with AGroupBox do
for i := 0 to ControlCount - 1 do
if controls[i] is TEdit then
TEdit(controls[i]).text := 'How about that!';
end;

2-//Lookup denen yerin programlanmasını bir inceleyin, ilginç...
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
{
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;

3-//DBNavigator'da disable edilebilen düğme olması
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
{ DBNavigator enhancement: allows developer to enable and disable
individual buttons via EnableButton and DisableButton methods }

unit GNav;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, DBCtrls;

type
TMyNavigator = class(TDBNavigator)
public
procedure EnableButton(Btn : TNavigateBtn) ;
procedure DisableButton(Btn : TNavigateBtn) ;
end;

procedure Register;

implementation

procedure TMyNavigator.EnableButton(Btn : TNavigateBtn) ;
begin
Buttons[Btn].Enabled := True ;
end ;

procedure TMyNavigator.DisableButton(Btn : TNavigateBtn) ;
begin
Buttons[Btn].Enabled := False ;
end ;

procedure Register;
begin
RegisterComponents('Samples** [TMyNavigator]);
end;

end.

4-//Esnek Panel Nesnesi; içine konan nesneleri otomatik Scale yapıyor (tavsiye:alClient)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
unit Elastic;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls;

type
TElasticPanel = class( TPanel )
private
FHorz, FVert: boolean;
nOldWidth, nOldHeight: integer;
bResized: boolean;
protected
procedure WMSize( var message: TWMSize ); message WM_SIZE;
public
nCount: integer;
constructor Create( AOwner: TComponent ); override;
published
property ElasticHorizontal: boolean read FHorz write FHorz default TRUE;
property ElasticVertical: boolean read FVert write FVert default TRUE;
end;

procedure Register;

implementation

constructor TElasticPanel.Create( AOwner: TComponent );
begin
inherited Create( AOwner );
FHorz := TRUE;
FVert := TRUE;
nOldWidth := Width;
nOldHeight := Height;
bResized := FALSE;
end;

procedure TElasticPanel.WMSize( var message: TWMSize );
var
bResize: boolean;
xRatio: real;
i: integer;
ctl: TWinControl;
begin
Inc( nCount );
if Align = alNone then
bResize := TRUE
else
bResize := bResized;
if not ( csDesigning in ComponentState ) and bResize then
begin
if FHorz then
begin
xRatio := Width / nOldWidth;
for i := 0 to ControlCount - 1 do
begin
ctl := TWinControl( Controls[i] );
ctl.Left := Round( ctl.Left * xRatio );
ctl.Width := Round( ctl.Width * xRatio );
end;
end;
if FVert then
begin
xRatio := Height / nOldHeight;
for i := 0 to ControlCount - 1 do
begin
ctl := TWinControl( Controls[i] );
ctl.Top := Round( ctl.Top * xRatio );
ctl.Height := Round( ctl.Height * xRatio );
end;
end;
end
else
begin
nOldWidth := Width;
nOldHeight := Height;
end;
bResized := TRUE;
nOldWidth := Width;
nOldHeight := Height;
end;

procedure Register;
begin
RegisterComponents('Additional** [TElasticPanel]);
end;

end.

5-//StringGrid'de renkli karakterler
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
procedure TForm1.StringGrid1DrawCell(Sender: TObject; Col, Row: Longint;
Rect: TRect; State: TGridDrawState);
const
CharOffset = 3;
begin
with StringGrid1.canvas do
begin
font.color := clMaroon;
textout(rect.left + CharOffset, rect.top + CharOffset, 'L');
font.color := clNavy;
textout(rect.left + CharOffset + TextWidth('L'),
rect.top + CharOffset, 'loyd');
end;
end;

end

6-//Yine bir tane daha StatusBar'a ProgressBar(veya herhangi bir nesne)
//eklenmiş hali (tek panel destekli)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
unit adStatba;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls;

type
TAdrockStatusBar = class(TStatusBar)
private
{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
Constructor Create(Aowner : TComponent); override;
published
{ Published declarations }
end;

procedure Register;

implementation

Constructor TAdrockStatusBar.Create(Aowner : TComponent);
begin
inherited Create(Aowner);
ControlStyle := ControlStyle + [csAcceptsControls];
end;

procedure Register;
begin
RegisterComponents('Adrock** [TAdrockStatusBar]);
end;

end.

7-//StringGrid'e birden fazla satır veri girilmesi
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
procedure TForm1.grid1DrawCell(Sender: TObject; Col, Row: Longint;
Rect: TRect; State: TGridDrawState);

var l_oldalign : word;
l_YPos,l_XPos,i : integer;
s,s1 : string;
l_col,l_row :longint;

begin
l_col := col;
l_row := row;
with sender as tstringgrid do
begin
if (l_row=0) then
canvas.font.style:=canvas.font.style+[fsbold];
if l_row=0 then
begin
l_oldalign:=settextalign(canvas.handle,ta_center);
l_XPos:=rect.left + (rect.right - rect.left) div 2;
s:=cells[l_col,l_row];
while s<>'' do
begin
if pos(#13,s)<>0 then
begin
if pos(#13,s)=1 then
s1:=''
else
begin
s1:=trim(copy(s,1,pred(pos(#13,s))));
delete(s,1,pred(pos(#13,s)));
end;
delete(s,1,2);
end
else
begin
s1:=trim(s);
s:='';
end;
l_YPos:=rect.top+2;
canvas.textrect(rect,l_Xpos,l_YPos,s1);
inc(rect.top,rowheights[l_row] div 3);
end;
settextalign(canvas.handle,l_oldalign);
end
else
begin
canvas.textrect(rect,rect.left+2,rect.top+2,cells[l_col,l_row]);
end;

canvas.font.style:=canvas.font.style-[fsbold];
end;
end;

8-//Nesnelerin sürüklenmesi
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
//If you only want a few controls to be movable just make those controls respond
// to the onMousedown event.
unit Main;

interface

uses
Windows,WinProcs, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Menus, registry;

type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
ListBox1: TListBox;
ComboBox1: TComboBox;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
procedure AppMessage(var Msg: TMsg; var Handled: Boolean);
public
{ Public declarations }
end;

const
SC_SIZE = $F012;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
iTemp: Integer;
r : TRegIniFile;
begin
(* Open the key in the registry where we store all the positions *)
r := TRegIniFile.Create('Resize Test');

(* Loop through all the components on a form *)
for iTemp := 0 to ComponentCount -1 do
(* Get the position of all controls *)
if Components[iTemp] is TControl then
with Components[iTemp] as TControl Do
begin
left:=r.readinteger(Name,'Left**left);
top:=r.readinteger(Name,'Top**Top);
(* Make there cursors crosses *)
cursor:=crCross;
end;
(* Release the registry object *)
r.free;

(* Use our own message handler for all message sent to the application *)
Application.OnMessage := AppMessage;
end;

procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean);
begin
(* Only do anything if the left mouse button is pressed *)
if msg.message = wm_LBUTTONDOWN then
begin
(* Release the mouse capture *)
WinProcs.ReleaseCapture;
(* Send a message to the control under the mouse to go into move mode *)
postmessage ( msg.hwnd,WM_SysCommand, SC_SIZE, 0 );
(* Say we have handled this message *)
Handled:=true;
end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
iTemp: Integer;
r : TRegIniFile;
begin
(* As in the form create loop through all the components But this *)
(* time write the left and top properties to the registry *)

r := TRegIniFile.Create('Resize Test');
for iTemp := 0 to ComponentCount -1 do
if Components[iTemp] is TControl then
with Components[iTemp] as TControl Do
begin
r.writeinteger(Name,'Left**left);
r.writeinteger(Name,'Top**Top);
end;
r.free;
end;
end.

//Tasarım / Çalışma modu Geçişi için gerekli kod
If fDesigning then
Application.OnMessage := AppMessage
else
Application.OnMessage := nil;

9-//ShowModal gibi bir pencereye odaklanmma
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
procedure TForm1.ShowProgressDlg;
var
WindowList: Pointer;
begin
{Disables all forms except Form2}
WindowList := DisableTaskWindows(Form2.Handle);
try

Form2.Show;

{Loop that performs a task}
Form2.ProgressBar1.Position := Form2.ProgressBar1.Position + 1;
{end loop}

finally
{enable all forms again}
EnableTaskWindows(WindowList);
Form2.Close;
end;
end;

10-//İstenen Formu OnTop veya tersi yapmak
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SetWindowPos(Form1.handle, HWND_TOPMOST,Form1.Left, Form1.Top, Form1.Width, Form1.Height,0);
SetWindowPos(Form1.handle, HWND_NOTOPMOST,Form1.Left, Form1.Top, Form1.Width, Form1.Height,0);

11-//LPT Portunu bulmak Win9x için
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function GetPortAddress(PortNo: integer): word; assembler; stdcall;
asm
push es
push ebx
mov ebx, PortNo
shl ebx,1
mov ax,40h // Dos segment adress
mov es,ax
mov ax,ES:[ebx+6] // get port adress in 16Bit way
pop ebx
pop es
end;

12-//Uygulama Bitene dek bekle
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
procedure ExecAndWait(sExe, sCommandLine : string);
var
tsi : TStartupInfo;
tpi : TProcessInformation;
dw : DWORD;
begin
Result := False;

FillChar(tsi, SizeOf(TStartupInfo), 0);
tsi.cb := SizeOf(TStartupInfo);
if CreateProcess(PChar(fsExe), PChar(sCommandLine), nil, nil, False, 0, nil, nil, tsi, tpi) then begin
if WAIT_OBJECT_0 = WaitForSingleObject(tpi.hProcess, INFINITE) then begin
if GetExitCodeProcess(tpi.hProcess, dw) then begin
if dw = 0 then begin
Result := True;
end
else begin
SetLastError(dw + $2000);
end;
end;
end;
dw := GetLastError;
CloseHandle(tpi.hProcess);
CloseHandle(tpi.hThread);
SetLastError(dw);
end;
end; { ExecAndWait }

13-//Sendkey Örneği, [Linkleri görebilmek için üye olmalısınız. Üye olmak için tıklayınız...] dosyasıdır
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
unit SKeys;

interface

type

{ Return values for SendKeys function }
TSendKeyError = (sk_None, sk_FailSetHook, sk_InvalidToken, sk_UnknownError);

function SendKeys(S: String): TSendKeyError;

implementation

function SendKeys; external 'SendKey' index 2;

end.