Programlama yapalım ve Öğrenelim.

ZipField

unit ZipField;

interface

uses

Classes,Graphics,Db,DbTables;

type

TZipField = class(TBlobField)

protected

procedure AssignTo(Dest: TPersistent); override;

procedure SaveToBitmap(Bitmap: TBitmap);

procedure LoadFromBitmap(Bitmap: TBitmap);

public

procedure Assign(Source: TPersistent); override;

procedure Compress(aInput,aOutput: TStream);

procedure Decompress(aInput,aOutput: TStream);

end;

procedure Register;

implementation

uses

ZLib;

{ TZipField }

procedure TZipField.Assign(Source: TPersistent);

begin

if Source is TBitmap then

begin

LoadFromBitmap(TBitmap(Source));

Exit;

end;

if (Source is TPicture) and (TPicture(Source).Graphic is TBitmap) then

begin

LoadFromBitmap(TBitmap(TPicture(Source).Graphic));

Exit;

end;

inherited Assign(Source);

end;

procedure TZipField.AssignTo(Dest: TPersistent);

begin

if Dest is TBitmap then

begin

SaveToBitmap(TBitmap(Dest));

exit;

end;

if Dest is TPicture then

begin

SaveToBitmap(TPicture(Dest).Bitmap);

Exit;

end;

inherited AssignTo(Dest);

end;

procedure TZipField.SaveToBitmap(Bitmap: TBitmap);

var

aOutput,

aInput : TStream;

begin

aInput:=TMemoryStream.Create;

try

SaveToStream(aInput);

aInput.Position:=0;

aOutput:=TMemoryStream.Create;

try

Decompress(aInput,aOutput);

aOutput.Position:=0;

Bitmap.LoadFromStream(aOutput);

finally

aOutput.Free;

end;

finally

aInput.Free;

end;

procedure TZipField.LoadFromBitmap(Bitmap: TBitmap);

var

aInput,

aOutput: TStream;

begin

aInput:=TMemoryStream.Create;

try

Bitmap.SaveToStream(aInput);

aInput.Position:=0;

aOutput:=TMemoryStream.Create;

try

Compress(aInput,aOutput);

aOutput.Position:=0;

LoadFromStream(aOutput);

finally

aOutput.Free;

end;

finally

aInput.Free;

end;

procedure TZipField.Compress(aInput,aOutput: TStream);

begin

with TCompressionStream.Create(clMax, aOutput) do

try

CopyFrom(aInput,0);

finally

Free;

end;

procedure TZipField.Decompress(aInput,aOutput: TStream);

const

BUFFER_SIZE = 4096;

var

aBuffer : array[0..BUFFER_SIZE-1] of byte;

aCount : Integer;

begin

with TDecompressionStream.Create(aInput) do

try

repeat

aCount := Read(aBuffer, BUFFER_SIZE);

if aCount <> 0 then

aOutput.WriteBuffer(aBuffer, aCount)

else

break;

until False;

finally

Free;

end;

procedure Register;

begin

RegisterFields([TZipField]);

end;

end.

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

SQLList

unit SQLList;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, db, dbTables;

type

TSQLRec = class(TPersistent)

private

FCreationDate: String;

FAuthor: String;

FNote: TStrings;

FSQL: TStrings;

procedure SetCreationDate(Value: string);

procedure SetAuthor(Value: String);

procedure SetNote(Value: TStrings);

procedure SetSQL(Value: TStrings);

protected

public

constructor Create;

destructor Destroy; override;

published

property CreationDate: String Read FCreationDate write SetCreationDate;

property Author: String Read FAuthor write SetAuthor;

property Note: TStrings Read FNote write SetNote;

property SQL: TStrings Read FSQL write SetSQL;

end;

type

TSQLItem = (_SQL1, _SQL2, _SQL3, _SQL4, _SQL5, _SQL6, _SQL7, _SQL8, _SQL9, _SQL10);

type

TSQLList = class(TComponent)

private

FActiveSQL: TSQLItem;

FActive: Boolean;

FSQL1: TSQLRec;

FSQL2: TSQLRec;

FSQL3: TSQLRec;

FSQL4: TSQLRec;

FSQL5: TSQLRec;

FSQL6: TSQLRec;

FSQL7: TSQLRec;

FSQL8: TSQLRec;

FSQL9: TSQLRec;

FSQL10: TSQLRec;

FQuery: TQuery;

procedure SetSQL1(Value: TSQLRec);

procedure SetSQL2(Value: TSQLRec);

procedure SetSQL3(Value: TSQLRec);

procedure SetSQL4(Value: TSQLRec);

procedure SetSQL5(Value: TSQLRec);

procedure SetSQL6(Value: TSQLRec);

procedure SetSQL7(Value: TSQLRec);

procedure SetSQL8(Value: TSQLRec);

procedure SetSQL9(Value: TSQLRec);

procedure SetSQL10(Value: TSQLRec);

procedure SetQuery(Value: TQuery);

procedure SetActive(Value: Boolean);

procedure SetActiveSQL(Value: TSQLItem);

protected

procedure Notification(AComponent: TComponent; Operation: TOperation); override;

public

constructor Create(Aowner: TComponent); override;

published

property Active: Boolean read FActive write SetActive;

property ActiveSQL: TSQLItem read FActiveSQL write SetActiveSQL;

property SQL1: TSQLRec read FSQL1 write SetSQL1;

property SQL2: TSQLRec read FSQL2 write SetSQL2;

property SQL3: TSQLRec read FSQL3 write SetSQL3;

property SQL4: TSQLRec read FSQL4 write SetSQL4;

property SQL5: TSQLRec read FSQL5 write SetSQL5;

property SQL6: TSQLRec read FSQL6 write SetSQL6;

property SQL7: TSQLRec read FSQL7 write SetSQL7;

property SQL8: TSQLRec read FSQL8 write SetSQL8;

property SQL9: TSQLRec read FSQL9 write SetSQL9;

property SQL10: TSQLRec read FSQL10 write SetSQL10;

property Query: TQuery read FQuery write SetQuery;

end;

procedure Register;

implementation

{$R zsqllist.DCR}

procedure Register;

begin

RegisterComponents('AZ', [TSQLList]);

end;

constructor TSQLRec.Create;

begin

inherited;

FNote := TStringList.Create;

FSQL := TStringList.Create;

end;

destructor TSQLRec.Destroy;

begin

inherited;

FNote.Free;

FSQL.FRee;

end;

procedure TSQLRec.SetCreationDate(Value: String);

begin

FCreationDate := Value;

end;

procedure TSQLRec.SetAuthor(Value: String);

begin

FAuthor := Value;

end;

procedure TSQLRec.SetNote(Value: TStrings);

begin

FNote.Assign(Value);

end;

procedure TSQLRec.SetSQL(Value: TStrings);

begin

FSQL.Assign(Value);

end;

// ***********

// TSQLList

// ***********

constructor TSQLList.Create(Aowner: TComponent);

begin

inherited;

FSQL1 := TSQLRec.Create;

FSQL2 := TSQLRec.Create;

FSQL3 := TSQLRec.Create;

FSQL4 := TSQLRec.Create;

FSQL5 := TSQLRec.Create;

FSQL6 := TSQLRec.Create;

FSQL7 := TSQLRec.Create;

FSQL8 := TSQLRec.Create;

FSQL9 := TSQLRec.Create;

FSQL10:= TSQLRec.Create;

SetActive(False);

SetActiveSQL(_SQL1);

end;

procedure TSQLList.Notification(AComponent: TComponent;

Operation: TOperation);

begin

inherited Notification(AComponent, Operation);

if Operation = opRemove then

if AComponent = Query then Query := nil

end;

procedure TSQLList.SetQuery(Value: TQuery);

begin

FQuery := Value;

if Value <> nil then

begin

Value.FreeNotification(Self);

end;

procedure TSQLList.SetSQL1(Value: TSQLRec);

begin

FSQL1.Assign(Value);

end;

procedure TSQLList.SetSQL2(Value: TSQLRec);

begin

FSQL2.Assign(Value);

end;

procedure TSQLList.SetSQL3(Value: TSQLRec);

begin

FSQL3.Assign(Value);

end;

procedure TSQLList.SetSQL4(Value: TSQLRec);

begin

FSQL4.Assign(Value);

end;

procedure TSQLList.SetSQL5(Value: TSQLRec);

begin

FSQL5.Assign(Value);

end;

procedure TSQLList.SetSQL6(Value: TSQLRec);

begin

FSQL6.Assign(Value);

end;

procedure TSQLList.SetSQL7(Value: TSQLRec);

begin

FSQL7.Assign(Value);

end;

procedure TSQLList.SetSQL8(Value: TSQLRec);

begin

FSQL8.Assign(Value);

end;

procedure TSQLList.SetSQL9(Value: TSQLRec);

begin

FSQL9.Assign(Value);

end;

procedure TSQLList.SetSQL10(Value: TSQLRec);

begin

FSQL10.Assign(Value);

end;

procedure TSQLList.SetActive(Value: Boolean);

begin

If (Value) and (FQuery <> nil) then

begin

FActive := Value;

If FActive then

begin

Case ActiveSQL of

_SQL1: FQuery.SQL := FSQL1.SQL;

_SQL2: FQuery.SQL := FSQL2.SQL;

_SQL3: FQuery.SQL := FSQL3.SQL;

_SQL4: FQuery.SQL := FSQL4.SQL;

_SQL5: FQuery.SQL := FSQL5.SQL;

_SQL6: FQuery.SQL := FSQL6.SQL;

_SQL7: FQuery.SQL := FSQL7.SQL;

_SQL8: FQuery.SQL := FSQL8.SQL;

_SQL9: FQuery.SQL := FSQL9.SQL;

_SQL10: FQuery.SQL := FSQL10.SQL;

end;

end

else FActive := False;

If FQuery <> nil then

FQuery.Active := FActive;

end;

procedure TSQLList.SetActiveSQL(Value: TSQLItem);

begin

FActiveSQL := Value;

SetActive(True);

end;

end.

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

URL component

unit urls;

interface

uses

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

StdCtrls, ShellAPI;

const

crExplorerCursor = -20123;

type

TUrlFailedEvent = procedure (Sender: TObject; URL: string; ErrorCode: Integer) of object;

TUrl = class(TCustomStaticText)

private

FActiveLinkColor: TColor;

FActiveLinkStyle: TFontStyles;

FOnMouseEnter: TNotifyEvent;

FOnMouseLeave: TNotifyEvent;

FOnUrlFailed: TUrlFailedEvent;

FURL: string;

SaveColor: TColor;

SaveStyle: TFontStyles;

procedure CMMouseEnter(var Msg:TMessage); message CM_MOUSEENTER;

procedure CMMouseLeave(var Msg:TMessage); message CM_MOUSELEAVE;

procedure SetURL(const AURL: string);

protected

public

constructor Create(AOwner: TComponent); override;

procedure Click; override;

function Execute: Boolean; virtual;

published

property ActiveLinkColor: TColor read FActiveLinkColor write FActiveLinkColor;

property ActiveLinkStyle: TFontStyles read FActiveLinkStyle write FActiveLinkStyle;

property OnMouseEnter: TNotifyEvent read FOnMouseEnter

write FOnMouseEnter;

property OnMouseLeave: TNotifyEvent read FOnMouseLeave

write FOnMouseLeave;

property OnUrlFailed: TUrlFailedEvent read FOnUrlFailed write FOnUrlFailed;

property URL: string read FURL write SetURL;

// From TCustomStaticText

property Align;

property Alignment;

property Anchors;

property AutoSize;

property BiDiMode;

property BorderStyle;

property Caption;

property Color;

property Constraints;

property DragCursor;

property DragKind;

property DragMode;

property Enabled;

property FocusControl;

property Font;

property ParentBiDiMode;

property ParentColor;

property ParentFont;

property ParentShowHint;

property PopupMenu;

property ShowAccelChar;

property ShowHint;

property TabOrder;

property TabStop;

property Visible;

property OnClick;

property OnContextPopup;

property OnDblClick;

property OnDragDrop;

property OnDragOver;

property OnEndDock;

property OnEndDrag;

property OnMouseDown;

property OnMouseMove;

property OnMouseUp;

property OnStartDock;

property OnStartDrag;

end;

procedure Register;

implementation

{ Global }

procedure Register;

begin

RegisterComponents('Custom', [TUrl]);

end;

{ TURL }

constructor TUrl.Create;

begin

inherited Create(AOwner);

FURL := '';

ShowHint := True;

FActiveLinkColor := clBlue;

FActiveLinkStyle := [fsUnderline];

Font.Color := clNavy;

if (AOwner <> nil) and (AOwner is TCustomForm) then

Font.Name := (AOwner as TCustomForm).Font.Name;

Screen.Cursors[crExplorerCursor] := LoadCursor(0, IDC_HAND);

Cursor := crExplorerCursor;

SaveColor := Font.Color;

SaveStyle := Font.Style;

end;

procedure TUrl.Click;

begin

inherited;

if not Assigned(OnClick) then

Execute;

end;

function TUrl.Execute: Boolean;

var

ResVal: Integer;

begin

Result := False;

if FURL <> '' then

begin

ResVal := ShellExecute(GetDesktopWindow, 'open', PChar(FURL),

nil, nil, SW_SHOWNORMAL);

Result := ResVal > 32;

if not Result and Assigned(FOnUrlFailed) then

FOnUrlFailed(Self, FURL, ResVal);

end;

procedure TUrl.CMMouseEnter(var Msg:TMessage);

begin

SaveColor := Font.Color;

SaveStyle := Font.Style;

Font.Color := FActiveLinkColor;

Font.Style := FActiveLinkStyle;

inherited;

if Assigned(FOnMouseEnter) then

FOnMouseEnter(Self);

end;

procedure TUrl.CMMouseLeave(var Msg:TMessage);

begin

Font.Color := SaveColor;

Font.Style := SaveStyle;

inherited;

if Assigned(FOnMouseLeave) then

FOnMouseLeave(Self);

end;

procedure TUrl.SetURL(const AURL: string);

begin

if AURL <> FURL then

begin

if ((Hint = FURL) or (Hint = '')) and ShowHint then Hint := AURL;

if (Caption = FURL) or (Caption = '') then Caption := AURL;

FURL := AURL;

Update;

end;

end.

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

Wizard component

unit wizards;

interface

uses

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

ExtCtrls, StdCtrls;

resourcestring

sWizardButtonNextCaption = '&Next >';

sWizardButtonBackCaption = '< &Back';

sWizardButtonFinishCaption = '&Finish';

type

TWizardDirection = (wdForward, wdBackward);

TWizardButtonClickEvent = procedure (Sender: TObject; CurrentPage: Integer;

var AllowMove: Boolean) of object;

TEnteringPageEvent = procedure (Sender: TObject; CurrentPage: Integer;

Direction: TWizardDirection) of object;

TUpdateHeadersEvent = procedure (Sender: TObject; HeaderText, InfoText: string;

CurrentPage: Integer) of object;

TWizard = class(TNotebook)

private

FButtonNext: TButton;

FButtonBack: TButton;

FStaticTextHeader: TStaticText;

FStaticTextInfo: TStaticText;

FHeaderCaption: TStrings;

FInfoCaption: TStrings;

FFinishing: Boolean;

FHideButtons: Boolean;

FPageIndex: Integer;

FOnButtonBackClick: TWizardButtonClickEvent;

FOnButtonNextClick: TWizardButtonClickEvent;

FOnButtonFinishClick: TNotifyEvent;

FOnEnteringPage: TEnteringPageEvent;

FOnUpdateHeaders: TUpdateHeadersEvent;

procedure AdjustButtonCaptions;

function GetBackEnabled: Boolean;

function GetFinishing: Boolean;

function GetNextEnabled: Boolean;

function GetNextPage: Integer;

function GetPrevPage: Integer;

function GetPageIndex: Integer;

procedure SetHeaderCaption(Value: TStrings);

procedure SetHideButtons(Value: Boolean);

procedure SetInfoCaption(Value: TStrings);

procedure SetStaticTextHeader(const Value: TStaticText);

procedure SetStaticTextInfo(const Value: TStaticText);

procedure SetButtonBack(const Value: TButton);

procedure SetButtonNext(const Value: TButton);

procedure SetNextEnabled(const Value: Boolean);

procedure SetBackEnabled(const Value: Boolean);

procedure SetPageIndex(const Value: Integer);

protected

procedure ButtonBackClick(Sender: TObject); virtual;

procedure ButtonNextClick(Sender: TObject); virtual;

procedure DisableButton(const Button: TButton);

procedure EnableButton(const Button: TButton);

procedure Loaded; override;

procedure UpdateHeaders; virtual;

public

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

function IsSkipPage(PageNum: Integer): Boolean; virtual;

procedure SetSkipPage(PageNum: Integer; Skip: Boolean); virtual;

property Finishing: Boolean read GetFinishing;

property BackEnabled: Boolean read GetBackEnabled write SetBackEnabled;

property NextEnabled: Boolean read GetNextEnabled write SetNextEnabled;

published

property ButtonNext: TButton read FButtonNext write SetButtonNext;

property ButtonBack: TButton read FButtonBack write SetButtonBack;

property HeaderCaption: TStrings read FHeaderCaption write SetHeaderCaption;

property HideButtons: Boolean read FHideButtons write SetHideButtons default False;

property InfoCaption: TStrings read FInfoCaption write SetInfoCaption;

property PageIndex: Integer read GetPageIndex write SetPageIndex;

property StaticTextHeader: TStaticText read FStaticTextHeader write SetStaticTextHeader;

property StaticTextInfo: TStaticText read FStaticTextInfo write SetStaticTextInfo;

property OnButtonBackClick: TWizardButtonClickEvent read FOnButtonBackClick write FOnButtonBackClick;

property OnButtonNextClick: TWizardButtonClickEvent read FOnButtonNextClick write FOnButtonNextClick;

property OnButtonFinishClick: TNotifyEvent read FOnButtonFinishClick write FOnButtonFinishClick;

property OnEnteringPage: TEnteringPageEvent read FOnEnteringPage write FOnEnteringPage;

property OnUpdateHeaders: TUpdateHeadersEvent read FOnUpdateHeaders write FOnUpdateHeaders;

end;

procedure Register;

implementation

{ Global }

procedure Register;

begin

RegisterComponents('Custom', [TWizard]);

end;

{ TWizard }

constructor TWizard.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

FHeaderCaption := TStringList.Create;

FInfoCaption := TStringList.Create;

end;

destructor TWizard.Destroy;

begin

FHeaderCaption.Free;

FInfoCaption.Free;

inherited Destroy;

end;

procedure TWizard.AdjustButtonCaptions;

begin

if not (csDesigning in ComponentState) and (FButtonNext <> nil) then

with FButtonNext do

if Finishing then Caption := sWizardButtonFinishCaption

else Caption := sWizardButtonNextCaption;

end;

function TWizard.IsSkipPage(PageNum: Integer): Boolean;

begin

if (Pages.Count > 0) and (PageNum < Pages.Count) and

(Pages.Objects[PageNum] <> nil) then

Result := (Pages.Objects[PageNum] as TCustomControl).HelpContext < 0

else

Result := False;

end;

procedure TWizard.SetSkipPage(PageNum: Integer; Skip: Boolean);

begin

// Skipping pages is done by setting the HelpContext value

// on the indicated page to a negative number, or to the lowest

// possible value of HelpContext if HelpContext was zero.

// You can't skip the first and last page

if (Pages.Count > 2) and (PageNum > 0) and (PageNum < Pages.Count - 1) and

(Pages.Objects[PageNum] <> nil) then

with Pages.Objects[PageNum] as TCustomControl do

if Skip then

begin

if HelpContext = 0 then HelpContext := Low(HelpContext)

else if HelpContext > 0 then HelpContext := -HelpContext;

end else

if HelpContext = Low(HelpContext) then HelpContext := 0

else if HelpContext < 0 then HelpContext := -HelpContext;

end;

procedure TWizard.SetButtonNext(const Value: TButton);

begin

FButtonNext := Value;

if not (csDesigning in ComponentState) and (FButtonNext <> nil) then

begin

FButtonNext.OnClick := ButtonNextClick;

FFinishing := Pages.Count = 1;

if FFinishing then

FButtonNext.Caption := sWizardButtonFinishCaption

else

FButtonNext.Caption := sWizardButtonNextCaption;

end

end;

procedure TWizard.SetButtonBack(const Value: TButton);

begin

FButtonBack := Value;

if not (csDesigning in ComponentState) and (FButtonBack <> nil) then

begin

FButtonBack.OnClick := ButtonBackClick;

FButtonBack.Caption := sWizardButtonBackCaption;

DisableButton(FButtonBack);

end;

procedure TWizard.SetHeaderCaption(Value: TStrings);

begin

FHeaderCaption.Assign(Value);

UpdateHeaders;

end;

procedure TWizard.SetHideButtons(Value: Boolean);

begin

FHideButtons := Value;

if csDesigning in ComponentState then Exit;

if FButtonNext <> nil then

FButtonNext.Visible := not FHideButtons or NextEnabled;

if FButtonBack <> nil then

FButtonBack.Visible := not FHideButtons or BackEnabled;

end;

procedure TWizard.SetInfoCaption(Value: TStrings);

begin

FInfoCaption.Assign(Value);

UpdateHeaders;

end;

procedure TWizard.SetStaticTextHeader(const Value: TStaticText);

begin

FStaticTextHeader := Value;

UpdateHeaders;

end;

procedure TWizard.SetStaticTextInfo(const Value: TStaticText);

begin

FStaticTextInfo := Value;

UpdateHeaders;

end;

function TWizard.GetNextPage: Integer;

begin

// Find the next page which isn't marked as skip page

Result := FPageIndex + 1;

if Pages.Count > 2 then

while (Result < Pages.Count - 1) and IsSkipPage(Result) do

Inc(Result);

if Result > Pages.Count - 1 then

Result := Pages.Count - 1;

end;

function TWizard.GetPrevPage: Integer;

begin

// Find the previous page which isn't marked as skip page

Result := FPageIndex - 1;

if Pages.Count > 2 then

while (Result > 0) and IsSkipPage(Result) do

Dec(Result);

if Result < 0 then

Result := 0;

end;

function TWizard.GetPageIndex: Integer;

begin

FPageIndex := Pages.IndexOf(ActivePage);

Result := FPageIndex;

end;

function TWizard.GetBackEnabled: Boolean;

begin

if FButtonBack <> nil then Result := FButtonBack.Enabled

else Result := False;

end;

function TWizard.GetFinishing: Boolean;

begin

Result := (Pages.Count <= 1) or (FPageIndex = Pages.Count - 1);

end;

function TWizard.GetNextEnabled: Boolean;

begin

if FButtonNext <> nil then Result := FButtonNext.Enabled

else Result := False;

end;

procedure TWizard.SetNextEnabled(const Value: Boolean);

begin

// Enable/disable the 'Next' button

if FButtonNext <> nil then

if Value then EnableButton(FButtonNext)

else DisableButton(FButtonNext)

end;

procedure TWizard.SetBackEnabled(const Value: Boolean);

begin

// Enable/disable the 'Back' button

if FButtonBack <> nil then

if Value then EnableButton(FButtonNext)

else DisableButton(FButtonNext)

end;

procedure TWizard.SetPageIndex(const Value: Integer);

begin

// This method overrides our descendant class' 'PageIndex := Value'

// statement. That's because we want to call the UpdateHeaders to make

// sure the headers reflect the page changes, too

if (Value <> FPageIndex) and (Value >= 0) and (Value < Pages.Count) then

begin

FPageIndex := Value;

ActivePage := Pages[FPageIndex];

UpdateHeaders;

end;

procedure TWizard.ButtonBackClick(Sender: TObject);

var

PrevIndex: Integer;

AllowMove,

OnFirstPage: Boolean;

begin

// This method gets assinged to your BackButton's

// OnClick event when assinging your buttons to TWizard.

// That's also why you shouldn't declare your own OnClick

// events to your Back/Next buttons -- they'll get overrided.

// In such cases use TWizard's OnButtonBackClick/OnButtonNextClick

// events instead

if Assigned(FOnButtonBackClick) then

begin

AllowMove := True;

FOnButtonBackClick(Sender, PageIndex, AllowMove);

if not AllowMove then Exit;

end;

OnFirstPage := (PageIndex = 0) or (Pages.Count = 1);

if not OnFirstPage then

begin

PrevIndex := FPageIndex;

PageIndex := GetPrevPage;

if FPageIndex = PrevIndex then Exit;

EnableButton(FButtonNext);

AdjustButtonCaptions;

// Check to see if we are on first page after the move

if (FPageIndex = 0) and (Pages.Count > 1) then

DisableButton(FButtonBack);

if Assigned(FOnEnteringPage) then

FOnEnteringPage(Sender, FPageIndex, wdBackward);

end else

DisableButton(FButtonBack);

end;

procedure TWizard.ButtonNextClick(Sender: TObject);

var

PrevIndex: Integer;

AllowMove: Boolean;

begin

// This method gets assinged to your NextButton's

// OnClick event when assinging your buttons to TWizard.

// That's also why you shouldn't declare your own OnClick

// events to your Back/Next buttons -- they'll get overrided.

// In such cases use TWizard's OnButtonBackClick/OnButtonNextClick

// events instead

if not Finishing then

begin

if Assigned(FOnButtonNextClick) then

begin

AllowMove := True;

FOnButtonNextClick(Sender, PageIndex, AllowMove);

if not AllowMove then Exit;

end;

PrevIndex := PageIndex;

PageIndex := GetNextPage;

if FPageIndex = PrevIndex then Exit;

EnableButton(FButtonBack);

AdjustButtonCaptions;

if Assigned(FOnEnteringPage) then

FOnEnteringPage(Sender, FPageIndex, wdForward);

end else

if Assigned(FOnButtonFinishClick) then

FOnButtonFinishClick(Self);

end;

procedure TWizard.DisableButton(const Button: TButton);

begin

if Button <> nil then

with Button do

begin

Enabled := False;

if FHideButtons then Visible := False;

end;

procedure TWizard.EnableButton(const Button: TButton);

begin

if Button <> nil then

begin

Button.Visible := True;

Button.Enabled := True;

end;

procedure TWizard.Loaded;

begin

inherited;

if not (csDesigning in ComponentState) then

PageIndex := 0;

end;

procedure TWizard.UpdateHeaders;

procedure DoSetHeader(ST: TStaticText; List: TStrings; var Txt: string);

begin

Txt := '';

with List do

if PageIndex < Count then Txt := Strings[FPageIndex];

if ST <> nil then

ST.Caption := Txt;

end;

var

HeaderText,

InfoText: string;

begin

if not (csDesigning in ComponentState) then

begin

DoSetHeader(FStaticTextHeader, FHeaderCaption, HeaderText);

DoSetHeader(FStaticTextInfo, FInfoCaption, InfoText);

if Assigned(FOnUpdateHeaders) then

FOnUpdateHeaders(Self, HeaderText, InfoText, FPageIndex);

end;

end.

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

AnsiCompareText Fonksiyonu (String Yakalama Usulleri) - İki String İfadeyi Karşılaştırma

Bu komutun kullanımıda ANSICOMPARESTR ile aynıdır. Yani iki stringi karşılaştırır.

Fakat küçük büyük harf duyarlılığı yoktur.

Kullanımı : AnsiCompareText(const S1, S2: string): Integer;

Örnek :

AnsiCompareStr AnsiCompareText

(aBB,ABB) -1 0

(ABB,aBB) 1 0

(ABB,ABB) 0 0

AnsiCompareStr ile AnsiCompareText arasındaki farkı anlamak için kodla test edin.

Not: Bu komutlar delphide sysutils uniti içinde bulunmaktadır. Bu komutların

yapımında CompareString apisi kullanılmıştır. Aşağıda bu fonksiyonlar

gösterilmiştir.

function AnsiCompareText(const S1, S2: string): Integer;

begin

Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, PChar(S1),

Length(S1), PChar(S2), Length(S2)) - 2;

end;

function AnsiCompareStr(const S1, S2: string): Integer;

begin

Result := CompareString(LOCALE_USER_DEFAULT, 0, PChar(S1), Length(S1),

PChar(S2), Length(S2)) - 2;

end;

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

AnsiContainsStr Fonksiyonu (String Yakalam Usulleri) - Bir stringin içinde başka stringi arama***

Bir stringin içinde stringin olup olmadığını kontrol etmek için kullanılan

fonksiyondur. Eğer aranan string varsa sonuç true yoksa fonksiyon false dönderir.

AnsiContainsStr küçük büyük harfe duyarlıdır.

Kullanımı : AnsiContainsStr(const AText, ASubText: string): Boolean;

AnsiContainsStr(Metin,Aranacak);

Örnek :

procedure TForm1.Button1Click(Sender: TObject);

begin

if AnsiContainsStr('alem alem2', 'M2') = True then

showmessage('aranan kelime var')

else

showmessage('aranan kelime yok'); {Sonuç Burası: Çünkü M büyük harf ile}

end;

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

AnsiContainsText Fonksiyonu (String Yakalama Usulleri) - String içinde string arama***

Bir stringin içinde stringin olup olmadığını kontrol etmek için kullanılan

fonksiyondur. Eğer aranan string varsa sonuç true yoksa fonksiyon false dönderir.

AnsiContainsText küçük büyük harfe duyarlı değildir.

Kullanımı : AnsiContainsText(const AText, ASubText: string): Boolean;

AnsiContainsText(Metin,Aranacak);

Örnek :

procedure TForm1.Button1Click(Sender: TObject);

begin

if AnsiContainsText('alem alem2', 'M2') = True then

showmessage('aranan kelime var'); {sonuç burası}

else

showmessage('aranan kelime yok');

end;

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

AnsiDequotedStr Fonksiyonu (String Yakalama Usulleri) - Bir stringin ilk ve son karekteri silme

Bir stringin başındaki ilk ve son kareketeri silmek için kullanılan fonksiyondur.

AnsiDequoteStr fonksiyonu iki parametreden oluşmaktadir. İlk parametre değeri

bir stringi ifade etmekte ikinci değeri ise bu bir karekteri ifade etmektedir.

İkinci değer birinci değerin başına bulunuyorsa AnsiDequoteStr fonksiyonu ilk

değerin başındaki ve sonundaki karekterleri siler.AnsiDequoteStr küçük büyük

harf ayrımı yapmaktadır. Bu nedenle kullanımında küçük büyük harf ayrımına

dikkat etmek gerekir.

Kullanımı : AnsiDequotedStr(const S: string; AQuote: Char): string;

Örnek :

Uses SysUtils;

procedure TForm1.Button1Click(Sender: TObject);

var

s1:String;

begin

s1:=',AnsiDequotedStr Bu stringte bulunan ilk ve son karekterdeki virgülleri atar,';

s1:=AnsiDequotedStr(s1,',');

Showmessage(s1);

end;

Sonuç :AnsiDequotedStr Bu stringte bulunan ilk ve son karekterdeki virgülleri atar

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

AnsiEndsStr Fonksiyonu (String Yakalama Usulleri ) - Bir string başka bir stringin sonunda varmı***

Bir stringi başka bir stringin sonunda arar, eger birinci string ikinci stringte

varsa sonuç true, yoksa sonuç false olarak döner. AnsiEndStr küçük büyük harf

ayrımı yapmaktadır.

Kullanımı : AnsiEndsStr(const ASubText, AText: string): Boolean;

Örnek:

Uses StrUtils;

procedure TForm1.Button1Click(Sender: TObject);

var

s1, s2: string;

begin

s1 := 'En sonunda var mı?';

s2 := 'Bilmem En sonunda var mı?';

if AnsiEndsStr(s1,s2) = True then

begin

Showmessage(S1+' '+'Evet Var');

end;

Sonuç : En sonunda var mı? Evet Var

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

AnsiEndsText Fonksiyonu (String Yakalama Usulleri ) - Bir string başka bir stringin sonunda varmı**

Bir stringi başka bir stringin sonunda arar, eger birinci string ikinci stringte

varsa sonuç true, yoksa sonuç false olarak döner. AnsiEndText küçük büyük harf

ayrımı yapmamaktadır.

Kullanımı : AnsiEndsText(const ASubText, AText: string): Boolean;

Örnek:

Uses StrUtils;

procedure TForm1.Button1Click(Sender: TObject);

var

s1, s2: string;

begin

s1 := 'En sonunda var mı?';

s2 := 'Bilmem En sonunda VAR mı?';

if AnsiEndsText(s1,s2) = True then

begin

Showmessage(S1+' '+'Evet Var');

end;

Sonuç : En sonunda var mı? Evet Var

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

AnsiExtractQuotedStr Fonksiyonu (String Yakalama Usulleri) ***

Bir string dizinin içindeki

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

AnsiIndexStr Fonksiyonu (String Yakalama Usulleri)- Bir string dizinin elaman indexini bulma***

Bir string, bir string dizinin içinde bulunuyorsa o stringin dizi içindeki

index numarasını verir. AnsiIndexStr büyük küçük harf ayrımı yapmaktadır.

AnsiIndexStr fonksiyonu sonuç olarak integer bir sayı dönderir. Eğer string

dizinin elamanı değilse sonuç olarak -1 döner.

Kullanımı :

AnsiIndexStr(const AText: string; const AValues: array of string): Integer;

AnsiIndexStr(String,StringDizi)

Örnek :

Uses StrUtils;

procedure TForm1.Button1Click(Sender: TObject);

Const

arr: array['1'..'5'] of string = ('ocak', 'Şubat', 'mart', 'nisan', 'mayıs');

begin

Showmessage(inttostr(AnsiIndexStr('mayıs', arr)));

end;

Sonuç: 4

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

AnsiIndexText Fonksiyonu (String Yakalama Usulleri)- Bir string dizinin elaman indexini bulma***

Bir string, bir string dizinin içinde bulunuyorsa o stringin dizi içindeki

index numarasını verir. AnsiIndexText büyük küçük harf ayrımı yapmamaktadır.

AnsiIndexText fonksiyonu sonuç olarak integer bir sayı dönderir. Eğer string

dizinin elamanı değilse sonuç olarak -1 döner. AnsiIndexText ile AnsiIndexStr

arasındaki tek fark büyük küçük harf duyarlığının olmasıdır.

Kullanımı :

AnsiIndexStr(const AText: string; const AValues: array of string): Integer;

AnsiIndexStr(String,StringDizi);

Örnek :

Uses StrUtils;

procedure TForm1.Button1Click(Sender: TObject);

Const

arr: array['1'..'5'] of string = ('ocak', 'Şubat', 'mart', 'nisan', 'mayıs');

begin

Showmessage(inttostr(AnsiIndexText('şubat', arr)));

end;

Sonuç: 1

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

AnsiLeftStr Fonksiyonu (String Yakalama Usulleri) - Stringin solundan istendiği sayıda karekter alma

Bir stringin solundan itibaren istendiği ölçüde karekter geri dönderir.

Kullanımı:

AnsiLeftStr(const AText: AnsiString; const ACount: Integer): AnsiString;

Örnek:

Uses StrUtils;

procedure TForm1.Button1Click(Sender: TObject);

var

s1,s2: string;

begin

s1 := 'Bir Stringin Solundan Belirtilen Ölçüde Karekteri Dönderir.';

s2 :=AnsiLeftStr(S1,21);

begin

Showmessage(S2);

end;

Sonuç: Bir Stringin Solundan

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

AnsiLowerCase Fonksiyonu (String Yakalama Usulleri)

Bir string içindeki tüm büyük harfli karekterleri küçük harfe dönüştürür.

Normalde Ansi ile başlayan tüm fonksiyonlar windowsa tanıtılmış dillere destek

verir, yani AnsiLoweCase fonksiyonun türkçe karekter sorunu olmaması gerekirken

yani türkçe karekterleri (Ğ,Ü,Ş,İ,Ö,Ç) küçük harefe dönüştürme işlemi yapması

gerekirken bu fonksiyon sadece İ harfini küçük harfe dünüştürememektedir.

Aşağıdaki örneği inceleyiniz.

Kullanımı : AnsiLowerCase(const S: string): string;

Örnek :

Uses SysUtils;

procedure TForm1.Button1Click(Sender: TObject);

var

s1,s2: string;

begin

s1 := 'BİR STRING iÇİNDEKİ TÜM BÜYÜK Harfleri Küçük Harf Yapar. Ama Türkçe '+

'karekterlerden sadece İ dönüştürülemez. Örneğin küçük i, büyük İ ';

s2 :=AnsiLowerCase(S1);

begin

Showmessage(S2);

end;

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