cxgrid group detial locate

uses

  cxGridViewData;

 

...

 

var

  R: TcxCustomGridRecord;

 

...

 

  View.BeginUpdate;

  try

    View.DataController.Groups.FullExpand;

    // Locate your record here

    R := View.Controller.FocusedRecord;

    if R <> nil then

    begin

      while (R is TcxGridGroupRow) and (R <> nil) do

      begin

        R := TcxGridGroupRow(R).GetFirstFocusableChild;

        if R <> nil then

          R.Focused := True;

      end;

    end;

  finally;

    View.EndUpdate;

  end;

 

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

 

sql server update two table

//mssql server

 

update        Table1

set        Table1.col3 = Table2.col3

from        Table1

join       Table2 on Table1.col1 = Table2.col2

where        Table1.col3 <> Table2.col3

 

 

// mysql server

 

UPDATE restarih p

INNER JOIN rezer pp

ON p.id = pp.rid

SET p.ytsay =p.ytsay +pp.ykisi;

WHERE p.dateCreated ='2004-01-01'

 

UPDATE product p

LEFT JOIN productPrice pp

ON p.productId = pp.productId

SET p.deleted = 1

WHERE pp.productId IS null

 

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

 

sql server update two table

//mssql server

 

update        Table1

set        Table1.col3 = Table2.col3

from        Table1

join       Table2 on Table1.col1 = Table2.col2

where        Table1.col3 <> Table2.col3

 

 

// mysql server

 

UPDATE restarih p

INNER JOIN rezer pp

ON p.id = pp.rid

SET p.ytsay =p.ytsay +pp.ykisi;

WHERE p.dateCreated ='2004-01-01'

 

UPDATE product p

LEFT JOIN productPrice pp

ON p.productId = pp.productId

SET p.deleted = 1

WHERE pp.productId IS null

 

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

 

sql server database yedekleme ve restore

procedure Tfrmgenel.BakmBalat1Click(Sender: TObject);

var

  yil,gun,ay:Word;

  gunstr,aystr:string;

Begin

  DecodeDate(date,yil,ay,gun);

  if gun < 10

      then gunstr:='0'+IntToStr(gun)

      else gunstr:=IntToStr(gun);

  if ay < 10

      then aystr:='0'+IntToStr(ay)

      else aystr:=IntToStr(ay);

  if (Application.MessageBox('Lütfen programın hiç bir bilgisayrda çalışmadığından emin olup "TAMAM" tuşuna basınız', 'Keramet',mb_okcancel+mb_iconstop)=idok)

  then begin

    with dm.qgenel do

    begin

        Close;

        sql.Clear;

        sql.Add('BACKUP DATABASE keramet TO DISK = '''+'d:'+gunstr+aystr+IntToStr(yil)+'.bck''');

        ExecSQL;

    end;

    if FileExists('d:'+IntToStr(gun)+IntToStr(ay)+IntToStr(yil)+'.bck') then

        Application.MessageBox('Bakım İşlemi Başarı İle Tamamlanmıştır', 'Keramet',Mb_ok+mb_iconinformation)

    else

        Application.MessageBox('Bakım İşlemi Başarısızlıkla Sonuçlandı', 'Keramet',Mb_ok+MB_ICONSTOP);

  end;

 

end;

 

 

//keramet database adııı

"BACKUP DATABASE dbname TO DISK = 'C:dbname.bck'"

 

 

 

"RESTORE DATABASE dbname FROM DISK = 'c:dbname.bck'"

 

attach

 

EXEC sp_attach_db @dbname = N'tekstil',

@filename1 = N'C:Documents and SettingsEmrah1DesktopYeni Klasörtekstil.mdf',

@filename2 = N'C:Documents and SettingsEmrah1DesktopYeni Klasörtekstil.ldf'

 

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

 

sql server database yedekleme ve restore

procedure Tfrmgenel.BakmBalat1Click(Sender: TObject);

var

  yil,gun,ay:Word;

  gunstr,aystr:string;

Begin

  DecodeDate(date,yil,ay,gun);

  if gun < 10

      then gunstr:='0'+IntToStr(gun)

      else gunstr:=IntToStr(gun);

  if ay < 10

      then aystr:='0'+IntToStr(ay)

      else aystr:=IntToStr(ay);

  if (Application.MessageBox('Lütfen programın hiç bir bilgisayrda çalışmadığından emin olup "TAMAM" tuşuna basınız', 'Keramet',mb_okcancel+mb_iconstop)=idok)

  then begin

    with dm.qgenel do

    begin

        Close;

        sql.Clear;

        sql.Add('BACKUP DATABASE keramet TO DISK = '''+'d:'+gunstr+aystr+IntToStr(yil)+'.bck''');

        ExecSQL;

    end;

    if FileExists('d:'+IntToStr(gun)+IntToStr(ay)+IntToStr(yil)+'.bck') then

        Application.MessageBox('Bakım İşlemi Başarı İle Tamamlanmıştır', 'Keramet',Mb_ok+mb_iconinformation)

    else

        Application.MessageBox('Bakım İşlemi Başarısızlıkla Sonuçlandı', 'Keramet',Mb_ok+MB_ICONSTOP);

  end;

 

end;

 

 

//keramet database adııı

"BACKUP DATABASE dbname TO DISK = 'C:dbname.bck'"

 

 

 

"RESTORE DATABASE dbname FROM DISK = 'c:dbname.bck'"

 

attach

 

EXEC sp_attach_db @dbname = N'tekstil',

@filename1 = N'C:Documents and SettingsEmrah1DesktopYeni Klasörtekstil.mdf',

@filename2 = N'C:Documents and SettingsEmrah1DesktopYeni Klasörtekstil.ldf'

 

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

 

mysql turkish

ALTER TABLE kart CHARACTER SET latin5;

ALTER TABLE kart DEFAULT CHARACTER SET latin5;

 

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

 

mysql turkish

ALTER TABLE kart CHARACTER SET latin5;

ALTER TABLE kart DEFAULT CHARACTER SET latin5;

 

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

 

mdi child olayları yakalamak

TChildForm = class(TObject)

  private

    Handle: THandle;

   OldChildWndProc: Pointer;

    InstanceChildWndProc: Pointer;

    Popup: TPopupMenu;

    procedure OnPopupMenu(Sender: TObject);

  protected

 

    procedure ChildWndProc(var Message: TMessage); virtual;

    procedure ClickActBut(Sender: TObject);

    procedure MinimizeMDIWindow(Sender: TObject);

    procedure CloseMDIWindow(Sender: TObject);

    procedure RestoreMDIWindow(Sender: TObject);

    procedure MaximizeMDIWindow(Sender: TObject);

    procedure ClickTriotekWindow(Sender: TObject);

  public

    constructor Create(AHandle: THandle; AToolBar: TElegantMDI);

    destructor Destroy; override;

  end;

 

constructor TChild.Create(AHandle: THandle; AToolBar: TElegantMDI);

var

  i, x: Integer;

  mi: TMenuItem;

begin

  inherited Create;

 

  Button.OnClick := ClickActBut;

 

  Popup := TPopupMenu.Create(Button);

 

  mi := TMenuItem.Create(Button);

  mi.Caption := 'Activate window';

  mi.OnClick := ClickActBut;

  mi.Bitmap.Handle := LoadBitmap(0, PChar(OBM_CHECK));

  Popup.Items.Add(mi);

 

  mi := TMenuItem.Create(Button);

  mi.Caption := '-';

  Popup.Items.Add(mi);

 

  mi := TMenuItem.Create(Button);

  mi.Caption := 'Önceki Boyut';

  mi.OnClick := RestoreMDIWindow;

  mi.Bitmap.Handle := LoadBitmap(0, PChar(OBM_RESTORED));

  Popup.Items.Add(mi);

 

  mi := TMenuItem.Create(Button);

  mi.Caption := 'Simge Durumuna Küçült';

  mi.OnClick := MinimizeMDIWindow;

  mi.Bitmap.Handle := LoadBitmap(0, PChar(OBM_REDUCED));

  Popup.Items.Add(mi);

 

  mi := TMenuItem.Create(Button);

  mi.Caption := 'Ekranı Kapla';

  mi.OnClick := MaximizeMDIWindow;

  mi.Bitmap.Handle := LoadBitmap(0, PChar(OBM_ZOOMD));

  Popup.Items.Add(mi);

 

  mi := TMenuItem.Create(Button);

  mi.Caption := '-';

  Popup.Items.Add(mi);

 

  mi := TMenuItem.Create(Button);

  mi.Caption := 'Pencereyi Kapat';

  mi.OnClick := CloseMDIWindow;

  Popup.Items.Add(mi);

 

 

  mi := TMenuItem.Create(Button);

  mi.Caption := '-';

  Popup.Items.Add(mi);

 

  mi := TMenuItem.Create(Button);

  mi.Caption := 'İptal';

  Popup.Items.Add(mi);

 

  mi := TMenuItem.Create(Button);

  mi.Caption := '-';

  Popup.Items.Add(mi);

 

 

  mi := TMenuItem.Create(Button);

  mi.Caption := 'Triotek A.Ş';

  mi.OnClick := ClickTriotekWindow;

  Popup.Items.Add(mi);

 

 

  Popup.OnPopup := OnPopupMenu;

 

  Button.PopupMenu := Popup;

 

  InstanceChildWndProc := MakeObjectInstance(ChildWndProc);

  OldChildWndProc := Pointer(GetWindowLong(Handle,GWL_WNDPROC));

  SetWindowLong(Handle, GWL_WNDPROC, Longint(InstanceChildWndProc));

end;

 

destructor TChild.Destroy;

begin

  SetWindowLong(Handle, GWL_WNDPROC, Longint(OldChildWndProc));

  FreeObjectInstance(InstanceChildWndProc);

  inherited Destroy;

end;

 

procedure TChild.OnPopupMenu(Sender: TObject);

begin

  if GetTopWindow(ToolBar.Form.ClientHandle)=Handle then

    Popup.Items[0].Enabled := False

  else

    Popup.Items[0].Enabled := True;

 

  if IsIconic(Handle) then begin

    Popup.Items[2].Enabled := True;

    Popup.Items[3].Enabled := False;

    Popup.Items[4].Enabled := True;

  end

  else begin

    Popup.Items[3].Enabled := True;

    if IsZoomed(Handle) then begin

      Popup.Items[2].Enabled := True;

      Popup.Items[4].Enabled := False;

    end

    else begin

      Popup.Items[2].Enabled := False;

      Popup.Items[4].Enabled := True;

    end;

  end;

end;

 

 

 

///

procedure TChildForm.ChildWndProc(var Message: TMessage);

begin

  case Message.Msg of

  WM_GETTEXT:

    begin

      Message.Result:= CallWindowProc(OldChildWndProc, Handle, Message.Msg, Message.WParam, Message.LParam);

      Button.Caption := Copy(PChar(Message.LParam),1,12);

      if Length(PChar(Message.LParam))>12 then begin

        Button.Caption := Button.Caption + ' ...';

        Button.Hint := PChar(Message.LParam);

        Button.ShowHint := True;

      end

      else begin

        Button.Hint := '';

        Button.ShowHint := False;

      end;

 

      Exit;

    end;

  WM_MDIACTIVATE:

    begin

      if HWND(Message.LParam)=Handle then Button.Down := True;

      if HWND(Message.WParam)=Handle then Button.Down := False;

    end;

  WM_DESTROY:

    begin

      Popup.Free;

      Button.Free;

      SetWindowLong(Handle, GWL_WNDPROC, Longint(OldChildWndProc));

      FreeObjectInstance(InstanceChildWndProc);

    end;

  WM_SYSCOMMAND:

    begin

    if Message.WParam = SC_MINIMIZE then

    begin

     ///Self.Popup.

 

     // Self.MinimizeMDIWindow(nil);

       //ShowMessage('TEST ');

     // SetWindowLong(Handle, GWL_HINSTANCE, Longint(ChildWndProc()));

    // ShowWindow(Form.ClientHandle,SW_HIDE);

     ShowWindow(Handle,SW_MINIMIZE);

     ShowWindow(Handle,SW_HIDE);

  //   end;

   end;

  end;

end;

 

Message.Result:= CallWindowProc(OldChildWndProc,Handle, Message.Msg, Message.WParam, Message.LParam);

// SetWindowLong()

end;

 

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

 

mdi child olayları yakalamak

TChildForm = class(TObject)

  private

    Handle: THandle;

   OldChildWndProc: Pointer;

    InstanceChildWndProc: Pointer;

    Popup: TPopupMenu;

    procedure OnPopupMenu(Sender: TObject);

  protected

 

    procedure ChildWndProc(var Message: TMessage); virtual;

    procedure ClickActBut(Sender: TObject);

    procedure MinimizeMDIWindow(Sender: TObject);

    procedure CloseMDIWindow(Sender: TObject);

    procedure RestoreMDIWindow(Sender: TObject);

    procedure MaximizeMDIWindow(Sender: TObject);

    procedure ClickTriotekWindow(Sender: TObject);

  public

    constructor Create(AHandle: THandle; AToolBar: TElegantMDI);

    destructor Destroy; override;

  end;

 

constructor TChild.Create(AHandle: THandle; AToolBar: TElegantMDI);

var

  i, x: Integer;

  mi: TMenuItem;

begin

  inherited Create;

 

  Button.OnClick := ClickActBut;

 

  Popup := TPopupMenu.Create(Button);

 

  mi := TMenuItem.Create(Button);

  mi.Caption := 'Activate window';

  mi.OnClick := ClickActBut;

  mi.Bitmap.Handle := LoadBitmap(0, PChar(OBM_CHECK));

  Popup.Items.Add(mi);

 

  mi := TMenuItem.Create(Button);

  mi.Caption := '-';

  Popup.Items.Add(mi);

 

  mi := TMenuItem.Create(Button);

  mi.Caption := 'Önceki Boyut';

  mi.OnClick := RestoreMDIWindow;

  mi.Bitmap.Handle := LoadBitmap(0, PChar(OBM_RESTORED));

  Popup.Items.Add(mi);

 

  mi := TMenuItem.Create(Button);

  mi.Caption := 'Simge Durumuna Küçült';

  mi.OnClick := MinimizeMDIWindow;

  mi.Bitmap.Handle := LoadBitmap(0, PChar(OBM_REDUCED));

  Popup.Items.Add(mi);

 

  mi := TMenuItem.Create(Button);

  mi.Caption := 'Ekranı Kapla';

  mi.OnClick := MaximizeMDIWindow;

  mi.Bitmap.Handle := LoadBitmap(0, PChar(OBM_ZOOMD));

  Popup.Items.Add(mi);

 

  mi := TMenuItem.Create(Button);

  mi.Caption := '-';

  Popup.Items.Add(mi);

 

  mi := TMenuItem.Create(Button);

  mi.Caption := 'Pencereyi Kapat';

  mi.OnClick := CloseMDIWindow;

  Popup.Items.Add(mi);

 

 

  mi := TMenuItem.Create(Button);

  mi.Caption := '-';

  Popup.Items.Add(mi);

 

  mi := TMenuItem.Create(Button);

  mi.Caption := 'İptal';

  Popup.Items.Add(mi);

 

  mi := TMenuItem.Create(Button);

  mi.Caption := '-';

  Popup.Items.Add(mi);

 

 

  mi := TMenuItem.Create(Button);

  mi.Caption := 'Triotek A.Ş';

  mi.OnClick := ClickTriotekWindow;

  Popup.Items.Add(mi);

 

 

  Popup.OnPopup := OnPopupMenu;

 

  Button.PopupMenu := Popup;

 

  InstanceChildWndProc := MakeObjectInstance(ChildWndProc);

  OldChildWndProc := Pointer(GetWindowLong(Handle,GWL_WNDPROC));

  SetWindowLong(Handle, GWL_WNDPROC, Longint(InstanceChildWndProc));

end;

 

destructor TChild.Destroy;

begin

  SetWindowLong(Handle, GWL_WNDPROC, Longint(OldChildWndProc));

  FreeObjectInstance(InstanceChildWndProc);

  inherited Destroy;

end;

 

procedure TChild.OnPopupMenu(Sender: TObject);

begin

  if GetTopWindow(ToolBar.Form.ClientHandle)=Handle then

    Popup.Items[0].Enabled := False

  else

    Popup.Items[0].Enabled := True;

 

  if IsIconic(Handle) then begin

    Popup.Items[2].Enabled := True;

    Popup.Items[3].Enabled := False;

    Popup.Items[4].Enabled := True;

  end

  else begin

    Popup.Items[3].Enabled := True;

    if IsZoomed(Handle) then begin

      Popup.Items[2].Enabled := True;

      Popup.Items[4].Enabled := False;

    end

    else begin

      Popup.Items[2].Enabled := False;

      Popup.Items[4].Enabled := True;

    end;

  end;

end;

 

 

 

///

procedure TChildForm.ChildWndProc(var Message: TMessage);

begin

  case Message.Msg of

  WM_GETTEXT:

    begin

      Message.Result:= CallWindowProc(OldChildWndProc, Handle, Message.Msg, Message.WParam, Message.LParam);

      Button.Caption := Copy(PChar(Message.LParam),1,12);

      if Length(PChar(Message.LParam))>12 then begin

        Button.Caption := Button.Caption + ' ...';

        Button.Hint := PChar(Message.LParam);

        Button.ShowHint := True;

      end

      else begin

        Button.Hint := '';

        Button.ShowHint := False;

      end;

 

      Exit;

    end;

  WM_MDIACTIVATE:

    begin

      if HWND(Message.LParam)=Handle then Button.Down := True;

      if HWND(Message.WParam)=Handle then Button.Down := False;

    end;

  WM_DESTROY:

    begin

      Popup.Free;

      Button.Free;

      SetWindowLong(Handle, GWL_WNDPROC, Longint(OldChildWndProc));

      FreeObjectInstance(InstanceChildWndProc);

    end;

  WM_SYSCOMMAND:

    begin

    if Message.WParam = SC_MINIMIZE then

    begin

     ///Self.Popup.

 

     // Self.MinimizeMDIWindow(nil);

       //ShowMessage('TEST ');

     // SetWindowLong(Handle, GWL_HINSTANCE, Longint(ChildWndProc()));

    // ShowWindow(Form.ClientHandle,SW_HIDE);

     ShowWindow(Handle,SW_MINIMIZE);

     ShowWindow(Handle,SW_HIDE);

  //   end;

   end;

  end;

end;

 

Message.Result:= CallWindowProc(OldChildWndProc,Handle, Message.Msg, Message.WParam, Message.LParam);

// SetWindowLong()

end;

 

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

 

formun maximize sini engellemek

interface

 

uses

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

  StdCtrls;

 

type

  TForm1 = class(TForm)

    Edit1: TEdit;

  private

    { Private declarations }

    procedure WMSyscommand(var msg: TWmSysCommand);message WM_SYSCOMMAND;

  public

    { Public declarations }

  end;

 

 

var

  Form1: TForm1;

 

implementation

 

{$R *.DFM}

 

procedure TForm1.WMSyscommand(var msg: TWmSysCommand);

begin

//(SC_MINIMIZE,SC_SIZE,SC_MOVE....)

 

   case (msg.CmdType and $FFF0) of

     SC_MAXIMIZE: begin

                   msg.CmdType:=SC_RESTORE;

                   WMSyscommand(msg);

                  end;

   end;

   inherited;

end;

 

end.

 

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

 

formun maximize sini engellemek

interface

 

uses

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

  StdCtrls;

 

type

  TForm1 = class(TForm)

    Edit1: TEdit;

  private

    { Private declarations }

    procedure WMSyscommand(var msg: TWmSysCommand);message WM_SYSCOMMAND;

  public

    { Public declarations }

  end;

 

 

var

  Form1: TForm1;

 

implementation

 

{$R *.DFM}

 

procedure TForm1.WMSyscommand(var msg: TWmSysCommand);

begin

//(SC_MINIMIZE,SC_SIZE,SC_MOVE....)

 

   case (msg.CmdType and $FFF0) of

     SC_MAXIMIZE: begin

                   msg.CmdType:=SC_RESTORE;

                   WMSyscommand(msg);

                  end;

   end;

   inherited;

end;

 

end.

 

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

 

hafta ve yıla göre tarih

function Tanafr.DateOfWeek(AYear, AWeek: Word): TDateTime;

begin

  Result := EncodeDate(AYear, 1, 1);

  Result := Result - (DayOfWeek(Result -2) +3) mod 7 +3 + (AWeek -1) * 7;

end;

 

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

 

hafta ve yıla göre tarih

function Tanafr.DateOfWeek(AYear, AWeek: Word): TDateTime;

begin

  Result := EncodeDate(AYear, 1, 1);

  Result := Result - (DayOfWeek(Result -2) +3) mod 7 +3 + (AWeek -1) * 7;

end;

 

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

 

fonksiyon çağırmak

function LoadAndRunDLLProcedure(

  sDLL,

  sFunc : string )

  : boolean;

type

  // define the type of "function"

  // we're calling

  TFunc_Start = procedure;

var

  Func_Start : TFunc_Start;

 

  hDll       : THandle;

  FuncPtr    : TFarProc;

  sMsg       : string;

begin

  Result := False;

  hDll   := LoadLibrary(

              PChar( sDLL ) );

  if(hDll > 32)then

  begin

    FuncPtr :=

      GetProcAddress(

        hDll, PChar( sFunc ) );

    @Func_Start := FuncPtr;

    if(nil <> @Func_Start)then

    begin

      Func_Start;

      Result := True;

    end else

    begin

      sMsg := 'DLL entry point ' +

              sFunc + ' not found';

      MessageBox(

        0, PChar( sMsg ), 'Error',

        MB_OK );

    end;

    FreeLibrary( hDll );

  end else

  begin

    sMsg := 'File ' + sDLL +

            ' not found';

    MessageBox(

      0, PChar( sMsg ), 'Error',

      MB_OK );

  end;

end;

 

For example, let's say you want to call a procedure called "HelloWorld()" in a DLL named "MyStuff.DLL:"

 

LoadAndRunDLLProcedure(

  'MyStuff.DLL',

  'HelloWorld' );

 

 

Please note that HelloWorld() must be a procedure, for example, declared as:

 

procedure HelloWorld;

 

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

Type

 MyFunction:Function (X,Y,Z:Byte; R:Real; S:String; Var W:Word):String;

 {Create exactly what you need. You probibly only want function:Boolean or

  something}

 

Var

 Funcs:Array[1..20] Of MyFunction;

 FuncsCount:Byte;

 

{$F+}

Function Example_My_Func(X,Y,Z:Byte; R:Real; S:String; Var W:Word):String;

Begin

 {Any code here!}

 Example_My_Func:=S+'!';

End;

{$F-}

 

Procedure Add_Function(Func:MyFunction);

Begin

 Inc(FuncsCount);

 Funcs[FuncsCount]:=Func;

End;

 

Procedure Call_All_Funcs;

Var

 L:Byte;

 A_Word:Word;

Begin

 For L:=1 To FuncsCount Do

  Writeln(Funcs[FuncsCount](1,2,3,1.55,'Yay',A_Word));

End;

 

Begin

 FuncsCount:=0; {Initialisation}

 Add_Function(@Example_My_Func);   {<= Not sure if the '@' symbol is needed}

 Call_All_Funcs;

  {Dont need to remove them or anything.}

End.

 

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

 

fonksiyon çağırmak

function LoadAndRunDLLProcedure(

  sDLL,

  sFunc : string )

  : boolean;

type

  // define the type of "function"

  // we're calling

  TFunc_Start = procedure;

var

  Func_Start : TFunc_Start;

 

  hDll       : THandle;

  FuncPtr    : TFarProc;

  sMsg       : string;

begin

  Result := False;

  hDll   := LoadLibrary(

              PChar( sDLL ) );

  if(hDll > 32)then

  begin

    FuncPtr :=

      GetProcAddress(

        hDll, PChar( sFunc ) );

    @Func_Start := FuncPtr;

    if(nil <> @Func_Start)then

    begin

      Func_Start;

      Result := True;

    end else

    begin

      sMsg := 'DLL entry point ' +

              sFunc + ' not found';

      MessageBox(

        0, PChar( sMsg ), 'Error',

        MB_OK );

    end;

    FreeLibrary( hDll );

  end else

  begin

    sMsg := 'File ' + sDLL +

            ' not found';

    MessageBox(

      0, PChar( sMsg ), 'Error',

      MB_OK );

  end;

end;

 

For example, let's say you want to call a procedure called "HelloWorld()" in a DLL named "MyStuff.DLL:"

 

LoadAndRunDLLProcedure(

  'MyStuff.DLL',

  'HelloWorld' );

 

 

Please note that HelloWorld() must be a procedure, for example, declared as:

 

procedure HelloWorld;

 

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

Type

 MyFunction:Function (X,Y,Z:Byte; R:Real; S:String; Var W:Word):String;

 {Create exactly what you need. You probibly only want function:Boolean or

  something}

 

Var

 Funcs:Array[1..20] Of MyFunction;

 FuncsCount:Byte;

 

{$F+}

Function Example_My_Func(X,Y,Z:Byte; R:Real; S:String; Var W:Word):String;

Begin

 {Any code here!}

 Example_My_Func:=S+'!';

End;

{$F-}

 

Procedure Add_Function(Func:MyFunction);

Begin

 Inc(FuncsCount);

 Funcs[FuncsCount]:=Func;

End;

 

Procedure Call_All_Funcs;

Var

 L:Byte;

 A_Word:Word;

Begin

 For L:=1 To FuncsCount Do

  Writeln(Funcs[FuncsCount](1,2,3,1.55,'Yay',A_Word));

End;

 

Begin

 FuncsCount:=0; {Initialisation}

 Add_Function(@Example_My_Func);   {<= Not sure if the '@' symbol is needed}

 Call_All_Funcs;

  {Dont need to remove them or anything.}

End.

 

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

 

Neoturk - Coder Test - 3 teki  16 sorunun cevabı (Yellow + Brown = Purple)

Surların cevabı verildiğinde sayıların buluma süresi 240 sn(4dk) yazıyordu

bende biraz uğraştım ama süresini hesaplayamadım.

Eğer ne kadar sürede bulduğunu bulabilirseniz bana da söyleyin :)

{ sanırım 1 sn den az sürüyor }

 

object lblYellow: TLabel

  Left = 48

  Top = 40

  Width = 80

  Height = 13

  Alignment = taRightJustify

  AutoSize = False

  Caption = 'lblYellow'

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'Courier'

  Font.Style = []

  ParentFont = False

end

object lblBrown: TLabel

  Left = 48

  Top = 64

  Width = 80

  Height = 13

  Alignment = taRightJustify

  AutoSize = False

  Caption = 'lblBrown'

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'Courier'

  Font.Style = []

  ParentFont = False

end

object lblPurple: TLabel

  Left = 48

  Top = 88

  Width = 80

  Height = 17

  Alignment = taRightJustify

  AutoSize = False

  Caption = 'lblPurple'

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'Courier'

  Font.Style = []

  ParentFont = False

end

object Button1: TButton

  Left = 40

  Top = 152

  Width = 75

  Height = 25

  Caption = 'Button1'

  TabOrder = 0

  OnClick = Button1Click

end

 

unit uYellow;

 

interface

 

uses

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

  Dialogs, StdCtrls, ExtCtrls;

 

type

  TForm1 = class(TForm)

    Button1: TButton;

    lblPurple: TLabel;

    lblBrown: TLabel;

    lblYellow: TLabel;

    procedure Button1Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

    Yellow : packed array [1..6] of char ;

     Brown : packed array [1..6] of char ;

    purple : packed array [1..6] of char ;

    function atama(poz:Integer;dizi:String) : boolean ;

    procedure DispResult(shwmsg:Integer) ;

  end;

 

var

  Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

{ TForm1 }

 

function TForm1.atama(poz: Integer; dizi: String) : Boolean ;

var

  i :Integer ;

  yDizi : String ;

  Deger : byte ;

  ilkdeger : char ;

begin

  if poz = 10 then

  begin

    result := false ;

    if StrToInt(Yellow)+StrToInt(Brown)=StrToInt(Purple) then

    begin

      dispresult(1) ;

      result := true ;

    end;

    exit ;

  end ;

  for i := 1 to length(dizi) do

  begin

    yDizi := Dizi ;

    ilkDeger := Dizi[i] ;

    system.Delete(yDizi,i,1) ;

    case poz of

      0 : begin Yellow[6] := ilkdeger ; brown[5]  := ilkdeger ; end;

      1 : begin brown[6]  := ilkdeger ; end;

      2 : begin Yellow[2] := ilkdeger ; purple[6] := ilkdeger ; end;

      3 : begin Yellow[5] := ilkdeger ; brown[4]  := ilkdeger ; end;

      4 : begin Yellow[3] := ilkdeger ; Yellow[4] := ilkdeger ; purple[5] := ilkdeger ; end;

      5 : begin purple[1] := ilkdeger ; purple[4] := ilkdeger ; end;

      6 : begin brown[3]  := ilkdeger ; purple[3] := ilkdeger ; end;

      7 : begin brown[2]  := ilkdeger ; end;

      8 : begin purple[2] := ilkdeger ; end;

      9 : begin yellow[1] := ilkdeger ; end ;

    end;

    if Atama(poz+1,ydizi) then

    begin

      result := true ;

      exit ;

    end ;

    ilkdeger := ' ' ;

    case poz of

      0 : begin Yellow[6] := ilkdeger ; brown[5] := ilkdeger ; end;

      1 : begin brown[6] := ilkdeger ; end;

      2 : begin Yellow[2] := ilkdeger ; purple[6] := ilkdeger ; end;

      3 : begin Yellow[5] := ilkdeger ; brown[4] := ilkdeger ; end;

      4 : begin Yellow[3] := ilkdeger ; Yellow[4] := ilkdeger ; purple[5] := ilkdeger ; end;

      5 : begin purple[1] := ilkdeger ; purple[4] := ilkdeger ; end;

      6 : begin brown[3] := ilkdeger ; purple[3] := ilkdeger ; end;

      7 : begin  brown[2] := ilkdeger ; end;

      8 : begin purple[2] := ilkdeger ; end;

      9 : begin yellow[1] := ilkdeger ; end ;

    end;

  end ;

end;

 

procedure TForm1.DispResult;

begin

  lblYellow.caption := Yellow ;

  lblbrown.caption  := brown ;

  lblPurple.caption := purple ;

end;

 

procedure TForm1.Button1Click(Sender: TObject);

begin

  yellow := '      ' ;

  brown  := '      ' ;

  purple := '      ' ;

  Atama(0,'1234567890') ;

end;

 

end.

 

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

 

Neoturk - Coder Test - 3 teki  16 sorunun cevabı (Yellow + Brown = Purple)

Surların cevabı verildiğinde sayıların buluma süresi 240 sn(4dk) yazıyordu

bende biraz uğraştım ama süresini hesaplayamadım.

Eğer ne kadar sürede bulduğunu bulabilirseniz bana da söyleyin :)

{ sanırım 1 sn den az sürüyor }

 

object lblYellow: TLabel

  Left = 48

  Top = 40

  Width = 80

  Height = 13

  Alignment = taRightJustify

  AutoSize = False

  Caption = 'lblYellow'

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'Courier'

  Font.Style = []

  ParentFont = False

end

object lblBrown: TLabel

  Left = 48

  Top = 64

  Width = 80

  Height = 13

  Alignment = taRightJustify

  AutoSize = False

  Caption = 'lblBrown'

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'Courier'

  Font.Style = []

  ParentFont = False

end

object lblPurple: TLabel

  Left = 48

  Top = 88

  Width = 80

  Height = 17

  Alignment = taRightJustify

  AutoSize = False

  Caption = 'lblPurple'

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'Courier'

  Font.Style = []

  ParentFont = False

end

object Button1: TButton

  Left = 40

  Top = 152

  Width = 75

  Height = 25

  Caption = 'Button1'

  TabOrder = 0

  OnClick = Button1Click

end

 

unit uYellow;

 

interface

 

uses

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

  Dialogs, StdCtrls, ExtCtrls;

 

type

  TForm1 = class(TForm)

    Button1: TButton;

    lblPurple: TLabel;

    lblBrown: TLabel;

    lblYellow: TLabel;

    procedure Button1Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

    Yellow : packed array [1..6] of char ;

     Brown : packed array [1..6] of char ;

    purple : packed array [1..6] of char ;

    function atama(poz:Integer;dizi:String) : boolean ;

    procedure DispResult(shwmsg:Integer) ;

  end;

 

var

  Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

{ TForm1 }

 

function TForm1.atama(poz: Integer; dizi: String) : Boolean ;

var

  i :Integer ;

  yDizi : String ;

  Deger : byte ;

  ilkdeger : char ;

begin

  if poz = 10 then

  begin

    result := false ;

    if StrToInt(Yellow)+StrToInt(Brown)=StrToInt(Purple) then

    begin

      dispresult(1) ;

      result := true ;

    end;

    exit ;

  end ;

  for i := 1 to length(dizi) do

  begin

    yDizi := Dizi ;

    ilkDeger := Dizi[i] ;

    system.Delete(yDizi,i,1) ;

    case poz of

      0 : begin Yellow[6] := ilkdeger ; brown[5]  := ilkdeger ; end;

      1 : begin brown[6]  := ilkdeger ; end;

      2 : begin Yellow[2] := ilkdeger ; purple[6] := ilkdeger ; end;

      3 : begin Yellow[5] := ilkdeger ; brown[4]  := ilkdeger ; end;

      4 : begin Yellow[3] := ilkdeger ; Yellow[4] := ilkdeger ; purple[5] := ilkdeger ; end;

      5 : begin purple[1] := ilkdeger ; purple[4] := ilkdeger ; end;

      6 : begin brown[3]  := ilkdeger ; purple[3] := ilkdeger ; end;

      7 : begin brown[2]  := ilkdeger ; end;

      8 : begin purple[2] := ilkdeger ; end;

      9 : begin yellow[1] := ilkdeger ; end ;

    end;

    if Atama(poz+1,ydizi) then

    begin

      result := true ;

      exit ;

    end ;

    ilkdeger := ' ' ;

    case poz of

      0 : begin Yellow[6] := ilkdeger ; brown[5] := ilkdeger ; end;

      1 : begin brown[6] := ilkdeger ; end;

      2 : begin Yellow[2] := ilkdeger ; purple[6] := ilkdeger ; end;

      3 : begin Yellow[5] := ilkdeger ; brown[4] := ilkdeger ; end;

      4 : begin Yellow[3] := ilkdeger ; Yellow[4] := ilkdeger ; purple[5] := ilkdeger ; end;

      5 : begin purple[1] := ilkdeger ; purple[4] := ilkdeger ; end;

      6 : begin brown[3] := ilkdeger ; purple[3] := ilkdeger ; end;

      7 : begin  brown[2] := ilkdeger ; end;

      8 : begin purple[2] := ilkdeger ; end;

      9 : begin yellow[1] := ilkdeger ; end ;

    end;

  end ;

end;

 

procedure TForm1.DispResult;

begin

  lblYellow.caption := Yellow ;

  lblbrown.caption  := brown ;

  lblPurple.caption := purple ;

end;

 

procedure TForm1.Button1Click(Sender: TObject);

begin

  yellow := '      ' ;

  brown  := '      ' ;

  purple := '      ' ;

  Atama(0,'1234567890') ;

end;

 

end.

 

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

 

Abs Fonksiyonu (Aritmetik Usuller) - Eksi Sayıyı Artı Sayı yapma

Negatif bir sayıyı pozitif bir sayı yapmak için kullanılır.

 

Örnek :

 

Uses System;

procedure TForm1.Button1Click(Sender: TObject);

var

 i, r: string;

begin

  i := inttostr(Abs(-523));

  r := floattostr(Abs(-523.104));

  MessageDlg('Tam Sayı : ' + i + ' Real Sayı : ' + r, mtInformation, [mbOk], 0);

end;

 

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