파란크리스마스

1. 이벤트 핸들러 생성

Type
  TAddConnectionInfoEvent = procedure(AConnInfo : TConnectionInfo) of object;

2. 이벤트 속성으로 정의

Type
  TERDModel=class
  private
    fOnAddConnectionInfo : TAddConnectionInfoEvent;
  public
    procedure AddConnectionInfo(aConnectionInfo : TConnectionInfo);
    property OnAddConnectionInfo : TAddConnectionInfoEvent read fOnAddConnectionInfo write fOnAddConnectionInfo;
  end;

3. 이벤트 호출

procedure TERDModel.AddConnectionInfo(aConnectionInfo : TConnectionInfo);
begin
  if Assigned(OnAddConnectionInfo ) then OnAddConnectionInfo(aConnectionInfo);
end;

4. 호출될 이벤트 구현

Type
  TErdMainFm=class(TLocalForm)
  private
    procedure ERDModelAddConnection(AConnInfo : TConnectionInfo);
  end;

implementation

procedure TErdMainFm.ERDModelAddConnection(AConnInfo : TConnectionInfo);
begin
  ShowMessage('나 호출되었어요.');
end;

5. 이벤트 등록

procedure TErdMainFm.FormCreate(Sender: TObject);
var
  ERDModel : TERDModel;
begin
  ERDModel := TERDModel.Create();
  ERDModel.OnAddConnectionInfo := ERDModelAddConnection;
end;

다운받는곳 : Soft Gems Homepage (http://www.soft-gems.net/)

속성

VT.TreeOptions.SelectionOptions := [toDisableDrawSelection,toExtendedFocus,toMiddleClickSelect,toMultiSelect,toRightClickSelect{,toCenterScrollIntoView}];

이벤트

OnFocusChanged

procedure Xxx.VTFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex);
var
  Data: PAlignData;
begin
  // Data := Sender.GetNodeData(Node);
end;

OnGetImageIndex

procedure Xxx.VTGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind;
  Column: TColumnIndex; var Ghosted: Boolean; var Index: Integer);
var
  Data: PAlignData;
begin
  if Kind in [ikNormal, ikSelected] then begin
    Data := Sender.GetNodeData(Node);
    Index := Data.ImageIndex;
  end;
end;

OnGetNodeDataSize
OnGetText

Node 찾기

function TTreeWorkspace.FindSubNode(ParentNode : PVirtualNode; name : String): PVirtualNode;
var
  Run: PVirtualNode;
  NodeData : PWorkspaceData;
begin
  Result := nil;

  Run := ParentNode.FirstChild;
  while Assigned(Run) do begin
    NodeData := PWorkspaceData(Self.GetNodeData(Run));
    if (NodeData.Title=name) then begin
      result := Run;
      Exit;
    end;
    Run := Run.NextSibling;
  end;
end;

정렬하기

호출
  Self.Sort(TeamNode, 0, Self.Header.SortDirection, true);

constructor TTreeWorkspace.Create(AOwner: TComponent; aImageList : TImageList);
begin
  inherited Create(AOwner);
  Self.OnCompareNodes := TreeCompareNodes;
end;

procedure TTreeWorkspace.TreeCompareNodes(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex;
    var Result: Integer);
var
  NodeData1 : PWorkspaceData;
  NodeData2 : PWorkspaceData;
begin
  NodeData1 := Sender.GetNodeData(Node1);
  NodeData2 := Sender.GetNodeData(Node2);
  Result := 0;
  if NodeData1.Title > NodeData2.Title then
    Result := 1;
end;

- 움직이는 Form
출처 : http://delphi.about.com/od/windowsshellapi/a/dragnocaption.htm

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer) ;
begin
   ReleaseCapture;
   SendMessage(Form1.Handle, WM_SYSCOMMAND, 61458, 0) ;
end

- 현재 디렉토리

procedure TSimpleListDemoDataDM.DataModuleCreate(Sender: TObject);
var
  ExeFileName : String;
  ExePath : String;
begin
  ExeFileName := Application.ExeName;
  ExePath := ExtractFilePath(Application.ExeName);

  Database.Connected := false;
  Database.Params.Clear;
  Database.Params.Add('PATH=' + ExePath + '..\..\Data');
  Database.Params.Add('DEFAULT DRIVER=PARADOX');
  Database.Params.Add('ENABLE BCD=FALSE');
  Database.Connected := true;

  tblCars.Open;
end;

출처 - http://cc.embarcadero.com/Item/26667

DCocoR 예제를 간단하게 수정하여 만들어 보았습니다.

expr.7z

FRAME "delphi.frm"

header = (.
.)

uses = (.SysUtils,Variants,StrUtils.)

private = (.
.)
protected = (.
.)
public = (.
  function Evaluate(const str: String): integer;
.)
publicProps = (.
.)

precreate = (.
.)

implementation =
(.
function TExprUnit.Evaluate(const str: String): integer;
var rez: Variant;
begin
  SetSource(str);
  _expr(rez);
  //Result := Successful and rez;
  Result := rez;
end;
.)

END

IGNORECASE

CHARACTERS
letter="ABCDEFGHIJKLMNOPQRSTUVWXYZ_".
digit="0123456789".
hexdigit = digit + "ABCDEF".
special = "+-*/=<>[].,():;^@{}$#".
ctrl=CHR(1)..CHR(31).
tab=CHR(9).
eol=CHR(13).
lf=CHR(10).
noquote=ANY-"'" -ctrl.

TOKENS
ident = letter{letter|digit}.
number = digit{digit} | digit { digit } CONTEXT ( ".." ).
string = ("'" {noquote}"'"| "#"(digit{digit}|"$"hexdigit{hexdigit}))
         {"'" {noquote}"'"| "#"(digit{digit}|"$"hexdigit{hexdigit})}.
float = digit{digit}
        (  "." {digit}
           [ "E"
            ["+" |"-"]
            digit{digit}
           ]
          |"E"["+"|"-"]digit{digit}
        ).
hexnumber = "$" hexdigit {hexdigit}.
eq    = '='.
gr    = '>'.
les   = '<'.
lesEq = '<='.
grEq  = '>='.
noeq  = '<>'.

add = "+". 
sub = "-". 
or  = "OR".
xor = "XOR".

mult = "*"  .
divd = "/"  .
div  = "DIV".
mod  = "MOD".
and  = "AND".
shl  = "SHL".
shr  = "SHR".

IGNORE tab+lf+eol

PRODUCTIONS

ExprUnit
(. var rez: Variant; .)=
 expr<rez>
.

expr<var Value: Variant>
(. var v2: Variant; sign: Integer; AddOp: Integer; .) =
  (.sign := 1;.)
  ['+' | '-' (.sign := -1;.) ]
  Term<Value> (. if sign<0 then value := -value;.)
  {
   ( "+" | "-" | "OR" | "XOR" )
   (. AddOp := Symbols[0]^.id; .)
    Term<v2>
   (. case AddOp of
      addSym: Value := Value +   v2;
      subSym: Value := Value -   v2;
      orSym : Value := Value or  v2;
      xorSym: Value := Value xor v2;
      end;
   .)
  }
.

Term<var Value: Variant>
(. var v2: Variant; MulOp: Integer; .) =
 Factor<Value>
 {
  ("*" | "/" | "DIV" | "MOD" | "AND" | "SHL" | "SHR" )
  (. MulOp := Symbols[0]^.id; .)
  Factor<v2>
   (. case MulOp of
      multSym: Value := Value *   v2;
      divdSym: Value := Value /   v2;
      divSym:  Value := Value div v2;
      modSym:  Value := Value mod v2;
      andSym:  Value := Value and v2;
      shlSym:  Value := Value shl v2;
      shrSym:  Value := Value shr v2;
      end;
   .)
 }
.

Factor<var Value: Variant> =
 | Number<Value>
.

Number<out Value: Variant> =
   number     (. Value := StrToInt(LexString); .)
 | float      (. Value := StrToFloat(LexString); .)
 | hexnumber  (. Value := StrToInt(LexString); .)
.

END ExprUnit.
----------------------------------------

ExprApp.dpr
----------------------------------------
program ExprApp;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  CocoAncestor,
  FileLoader,
  ExprUnit in 'ExprUnit.pas';

var
  comp: TExprUnit;
  meth: TMethod;
  errProc: TErrorEvent absolute meth;
  int1: String;
  rez: Variant;

procedure ErrorHandler(this: TExprUnit; Sender: TObject; ErrorType,ErrorCode, line,col: Integer; const Msg, data: string);
begin
  WriteLn(Format('Error in "%s"(%d,%d): %s',[int1,Line,Col,Msg,data]));
end;

begin
  try
    if (ParamCount=0) then begin
      WriteLn(Format('Usage: %s "1 + 2"',[ChangeFileExt(ExtractFileName(ParamStr(0)),'')]));
      Exit;
    end;
    comp := TExprUnit.Create(nil);
    try
      meth.Data := comp;
      meth.Code := @ErrorHandler;
      comp.OnError := errProc;

      int1 := ParamStr(1);
      WriteLn(int1);
      rez := comp.Evaluate(int1);
      WriteLn(rez);
    finally
      comp.Free;
    end;
  except
    on E:Exception do
      Writeln(E.Classname, ': ', E.Message);
  end;
end.
----------------------------------------

실행결과

FileCopy

출처 : http://delphi.about.com/od/fileio/a/untypedfiles.htm

procedure FileCopy(const FileFrom, FileTo: string) ;
var
  FromF, ToF: file;
  NumRead, NumWritten: Integer;
  Buffer: array[1..2048] of Byte;
begin
  AssignFile(FromF, FileFrom) ;
  Reset(FromF, 1) ;
  AssignFile(ToF, FileTo) ;
  Rewrite(ToF, 1) ;
  repeat

   BlockRead(FromF, Buffer, SizeOf(Buffer), NumRead) ;
   BlockWrite(ToF, Buffer, NumRead, NumWritten) ;
  until (NumRead = 0) or (NumWritten <> NumRead) ;
  CloseFile(FromF) ;
  CloseFile(ToF) ;
end;

Random access file

출처 : http://www.tek-tips.com/viewthread.cfm?qid=1540019&page=3

type
  recordtype=record
    varLastName   :string[50];
    varFirstName  :string[50];
    varEmail     :string[250];
end;

  qfile:file of recordtype;
  qfileTemp:file of recordtype;
  qrecord:recordtype;
  numrec:integer;
  numtemp:integer;

procedure TfrmDataBase.imgDeleteMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin

  try

    ASSIGNFILE(qfile, Trim(lblFile.Caption));
    Reset(qfile);

    ASSIGNFILE(qfiletemp, ExtractFilePath(application.exename) + '\Database.tmp');
    REWRITE(qfiletemp);

      For numtemp:=0 To filesize(qfile)-1 Do
        begin

          seek(qfile,numtemp);
          read(qfile,qrecord);

          If IntToStr(numtemp + 1) <> Trim(lblPosition.Caption)  Then
            begin
              write (qfiletemp, qrecord);
            end;

        end;

    closefile(qfile);
    closefile(qfiletemp);

    deletefile(Trim(lblFile.Caption));
    renamefile(ExtractFilePath(application.exename) + '\Database.tmp', Trim(lblFile.Caption));

  except
   ShowMessage('Warning: access to file has been denied.' + #10 + #13 + #10 + #13 + 'Make sure the application folder is not read-only.');
   exit;
  end;

end;