Delphi - Drag & Drop

Programming/Delphi 2010.11.10 21:39 Posted by 파란크리스마스
출처 : http://kjs1981.tistory.com/entry/%EB%8D%B8%ED%8C%8C%EC%9D%B4-Drag-Drop%EC%9D%98-%EC%A0%95%EB%A6%AC-%ED%8E%8C-softech%EA%B3%A8%EB%B1%85%EC%9D%B4pppkornet21net

1. 소스 : cxVirtualTreeList1.DragMode = dmAutomatic

DragMode = dmAutomatic의 경우 모든 객체에 대해서 Darg 모드가 적용되지만
특정객체만 선택적으로 Drag 모드가 적용되게 하려면 DragMode = dmManual 로 수정하고
MouseDown 이벤트에서 BeginDrag(False); 로 해준다.

cxVirtualTreeList1.DragMode = dmManual  // 수정

procedure TObjectTreeForm.cxVirtualTreeList1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  TableItem : TTableItem;
begin
  TableItem := DBManager.DBObjectTreeModel.DoSelectNode(cxVirtualTreeList1.GetNodeAt(x, y));
  if Assigned(TableItem) then begin
    cxVirtualTreeList1.BeginDrag(False);  { 있다면 드랙을 시작한다. }
    ColumnGridModel.ColumnList := TableItem.ColumnList;
    ColumnGridModel.DataChanged;
  end;
end;

2. 대상 : OnDragOver 이벤트

procedure TfrmSQLEditor.SyntaxMemo1DragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
var
  TableItem : TTableItem;
begin
  if (Source is TcxVirtualTreeList) then begin
    TableItem := DBManager.DBObjectTreeModel.DoSelectNode((Source as TcxVirtualTreeList).DragNode);
    if Assigned(TableItem) then begin
      Accept := true;
    end;
  end;
end;

3. 대상 : DragDrop이벤트

procedure TfrmSQLEditor.SyntaxMemo1DragDrop(Sender, Source: TObject; X,
  Y: Integer);
var
  TableItem : TTableItem;
begin
  if (Source is TcxVirtualTreeList) then begin
    TableItem := DBManager.DBObjectTreeModel.DoSelectNode((Source as TcxVirtualTreeList).DragNode);
    if Assigned(TableItem) then begin
      SyntaxMemo1.InsertText(TableItem.Name);
    end;
  end;
end;

신고

MeCab - 일본어 형태소 분석기

Programming/Delphi 2010.10.05 22:18 Posted by 파란크리스마스



Delphi 2010으로 컴파일,
MeCab 라이브러리 사용

일본어 검색엔진이나 번역기를 만들기 위해
일본어 형태소 단위로 분석하는 프로그램입니다.

일본어 문장을 입력하고 [실행]하시면,
단어, 조사, 동사 등으로 분리하여 결과를 보여줍니다.

한자로 된 단어의 읽는 방법이나
동사의 기본형도 나오니 공부하는데 도움이 될까 싶어 올립니다.

신고
출처 : http://stackoverflow.com/questions/728701/what-is-the-send-api-for-accessing-menu-commands-from-outside-application
http://swissdelphicenter.com/torry/showcode.php?id=1104
http://www.delphisources.ru/pages/faq/base/get_res_names.html
http://www.swissdelphicenter.ch/torry/showcode.php?id=1710

// Grab sub menu for a Window (by handle), given by (0 based) indices in menu hierarchy
function GetASubmenu(const hW: HWND; const MenuInts: array of Integer): HMENU;
var
  hSubMenu: HMENU;
  I: Integer;
begin
  Result := 0;
  if Length(MenuInts) = 0 then
    Exit;
 
  hSubMenu := GetMenu(hW);
  if not IsMenu(hSubMenu) then
    Exit;
 
  for I in MenuInts do
  begin
    Assert(I < GetMenuItemCount(hSubMenu), format('GetASubmenu: tried %d out of %d items',[I, GetMenuItemCount(hSubMenu)]));
    hSubMenu := GetSubMenu(hSubMenu, I);
    if not IsMenu(hSubMenu) then
      Exit;
  end;
 
  Result := hSubMenu;
end;
 
// Get the caption for MenuItem ID
function GetMenuItemCaption(const hSubMenu: HMENU; const Id: Integer): string;
var
  MenuItemInfo: TMenuItemInfo;
begin
  MenuItemInfo.cbSize := 44;           // Required for Windows 95. not sizeof(AMenuInfo)
  MenuItemInfo.fMask := MIIM_STRING;
  // to get the menu caption, 1023 first chars should be enough
  SetLength(Result, 1023 + 1);
  MenuItemInfo.dwTypeData := PChar(Result);
  MenuItemInfo.cch := Length(Result)-1;
  if not GetMenuItemInfo(hSubMenu, Id, False, MenuItemInfo) then
    RaiseLastOSError;
  // real caption's size. Should call GetMenuItemInfo again if was too short
  SetLength(Result, MenuItemInfo.cch);
  {$WARN SYMBOL_PLATFORM OFF}
  if DebugHook > 0 then
    OutputDebugString(MenuItemInfo.dwTypeData);
end;
 
procedure Test;
var
  hwnd, hSubMenu: Cardinal;
  id : Integer;
begin
//  hwnd := FindWindow('Afx:00400000:8:00010013:00000000:03F61829', nil); // UltraEdit
//  hSubMenu := GetASubmenu(hwnd, [5,0]);

  hwnd := FindWindow('Notepad', nil); // get the 1st instance of Notepad...
  hSubMenu := GetASubmenu(hwnd, [3]); // 4th submenu Menu aka &View
 
  if hSubMenu > 0 then
  begin
    id := GetMenuItemID(hSubMenu, 0); // 1st Item in that sub menu (must not be a submenu itself)
    if id > -1 then
    begin
      PostMessage(hwnd, WM_COMMAND, id, 0); 
      ShowMessage('Done: ' + GetMenuItemCaption(hSubMenu, id));
    end
    else
      RaiseLastOSError;
  end
  else
    RaiseLastOSError;
end;

// 리소스 파일에 존재하는 메뉴 조회
procedure GetMenuInfo2(MainMenu: hMenu; MenuType : TMenuType);
var
  id : integer;
  i, nItems: Integer;
  hwnd, hSubMenu: hMenu;
  menuTitle : String;
begin
  nItems := GetMenuItemCount(MainMenu);
  for i := 0 to  nItems - 1 do begin
    id := GetMenuItemID(MainMenu, i);
    if id > -1 then begin
      menuTitle := GetSubMenuItemCaption(MainMenu, id);
      if Length(menuTitle)>0 then begin
        //ShowMessage(menuTitle);
        MenuType.Menus.Add(menuTitle);
      end;
    end else begin
      hSubMenu := GetSubMenu(MainMenu, i );
      GetMenuInfo2(hSubMenu, MenuType);
    end;
  end;
end;
신고

Delphi Tip - 숫자 여부 확인

Programming/Delphi 2010.05.18 17:52 Posted by 파란크리스마스
Delphi에서 StrToInt을 하는 경우 Exception 발생하는데, Debug 시에는 귀찮을 때가 있어
Tip을 올립니다.

SysUtil.pas의 StrToInt 내부를 보면,
Var 함수를 사용하고 있는데, 3번째 인자의 값이 0이 아니면 Exception을 발생하도록 되어 있습니다.

function StrToInt(const S: string): Integer;
var
  E: Integer;
begin
  Val(S, Result, E);
  if E <> 0 then ConvertErrorFmt(@SInvalidInteger, [S]);
end;

사용예)
아래의 예를 보시면 Result 값을 0으로 초기화 하고
Var의 3번째 인자의 값이 0이면 Result에 값에 담아서 반환하도록 했습니다.

function StrToInt2(const S: string): Integer;
var
  intTemp, E : Integer;
begin
  Result := 0;
  // 숫자 여부 확인
  Val(S, intTemp , E);
  if E=0 then
    Result := intTemp ;
end
신고

Delphi Tip - 디렉토리 문자열 분리

Programming/Delphi 2010.04.04 06:31 Posted by 파란크리스마스


uses
  StrUtils;

procedure TForm1.Button1Click(Sender: TObject);
var
  tmpDirStr : String;
  offset : integer;

  function GetFindStr(SubFindStr : String; var offset : integer):string;
  var
    offsetOld, offset2 : integer;
  begin
    Result := '';

    offset2 := 0;
    if SubFindStr[offset] = '/' then
      inc(offset2);

    offsetOld := offset;
    offset := PosEx('/', SubFindStr, offset + offset2);

    if offset>0 then begin
      Result := MidStr(SubFindStr, offsetOld + offset2, offset-offsetOld-offset2);
    end;
  end;

begin
  tmpDirStr := Edit1.Text;

  if (tmpDirStr[Length(tmpDirStr)]<>'/') then
    tmpDirStr := tmpDirStr + '/';

  offset := 1;

  while (offset > 0) do begin
    Memo1.Lines.Add(GetFindStr(tmpDirStr, offset));
  end;
end;

신고

Delphi - 열거형 타입 ( Delphi enum type )

Programming/Delphi 2010.03.04 11:25 Posted by 파란크리스마스

type
  TDatabaseType
    = (dbtMSSQL, dbtOracle, dbtCUBRID, dbtSybase, dbtNone);

  TDatabaseSet = set of TDatabaseType;

const
  StrDatabaseNames : array[TDatabaseType] of String
    = ('MSSQL', 'Oracle', 'CUBRID', 'Sybase', 'None');

 함수  내용
 Typeinfo  열거형의 형정보(TypeInfo)에 대한 포인터 반환
 GetEnumName  열거형의 각 멤버를 문자열로 반환
 GetEnumValue  
 Ord  
 Pred  
 Succ  
 Dec  
 Inc  
 Low  


procedure TForm1.Button1Click(Sender: TObject);
var
  DatabaseType : TDatabaseType;
begin
  // GetEnumValue : String to Enum
  DatabaseType := TDatabaseType(GetEnumValue(TypeInfo(TDatabaseType), 'dbtOracle'));

  // GetEnumName : Enum to String
  ShowMessage(GetEnumName(TypeInfo(TDatabaseType), Ord(DatabaseType))); // dbtOracle

  // Ord
  ShowMessage(IntToStr(Ord(dbtOracle))); // 1

  // Dec
  Dec(DatabaseType);
  ShowMessage(GetEnumName(TypeInfo(TDatabaseType), Ord(DatabaseType))); // dbtMSSQL

  // Inc
  Inc(DatabaseType);
  ShowMessage(GetEnumName(TypeInfo(TDatabaseType), Ord(DatabaseType))); // dbtOracle

  // Low, High / Loop
  for DatabaseType := Low(TDatabaseType) to High(TDatabaseType) do
    ShowMessage(GetEnumName(TypeInfo(TDatabaseType), Ord(DatabaseType)));
end;

Delphi Set배열

uses
  TypInfo;

procedure TForm1.Button1Click(Sender: TObject);
var
  i : TDBObjectType;
begin
  for i in UniSQLObjectSet[DBVer_CUBRID] do begin
    Memo1.Lines.Add('i=' + GetEnumName ( TypeInfo ( TDBObjectType ), Ord(i) ) );
  end;

end;

- end -

신고

Delphi Tip 로케일(Locale) 확인 하기

Programming/Delphi 2010.01.20 10:48 Posted by 파란크리스마스

원본 사이트 : http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_10231553.html

procedure TForm1.Button1Click(Sender: TObject);

  function GetLocale(ALcid: Integer): string;
  var s: string;
  begin
    Result := '[Unknown]';
    SetLength(s, 128);
    if GetLocaleInfo(ALcid, LOCALE_SENGLANGUAGE, PChar(s), 128) > 0 then
      begin
        Result := StrPas(PChar(s));
        if GetLocaleInfo(ALcid, LOCALE_SENGCOUNTRY, PChar(s), 128) > 0 then
          begin
            Result := Format('%s (%s)', [Result, StrPas(PChar(s))]);
          end;
      end;
  end;

begin
  showmessage(GetLocale(GetUserDefaultLangID));
end;

더보기


 

신고

Delphi - TcxGrid

Programming/Delphi 2009.12.08 09:54 Posted by 파란크리스마스

- Query 실행후 동적으로 컬럼 추가

(cxGridDBTableView1.DataController as IcxCustomGridDataController).DeleteAllItems;
(cxGridDBTableView1.DataController as IcxCustomGridDataController).CreateAllItems(true);
cxGridDBTableView1.ApplyBestFit();

- [Enter] 키로 Cell 이동

cxGrid1TableView1.OptionsBehavior.FocusCellOnCycle := true;
cxGrid1TableView1.OptionsBehavior.FocusCellOnTab := true;
cxGrid1TableView1.OptionsBehavior.FocusFirstCellOnNewRecord := true;
cxGrid1TableView1.OptionsBehavior.GoToNextCellOnEnter := true;

- 속성

속성명 자료형 설명
OptionsBehavior.CopyCaptionsToClipboard Boolean 클립보드에 복사할 때 캡션도 복사할지 여부
OptionsSelection.CellMultiSelect Boolean Cell 다중 선택 여부
OptionsSelection.CellSelect Boolean Cell별로 선택 가능 여부
OptionsSelection.MultiSelect Boolean Row 다중 선택 여부

- TcxCustomDataSource

TDatasetFieldModel=class(TcxCustomDataSource)
  private
    DatasetAnalyzer : TDatasetAnalyzer;
  protected
    function GetRecordCount: Integer; override;
    function GetValue(ARecordHandle: TcxDataRecordHandle; AItemHandle: TcxDataItemHandle): Variant; override;
  public
    constructor Create;
    destructor Destroy; override;
  end;

implementation

{ TDatasetFieldModel }

constructor TDatasetFieldModel.Create;
begin
  inherited Create;
  DatasetAnalyzer := TDatasetAnalyzer.Create(TDatasetField);
end;

destructor TDatasetFieldModel.Destroy;
begin
  DatasetAnalyzer.Free;
  inherited Destroy;
end;

function TDatasetFieldModel.GetRecordCount: Integer;
begin
  Result := DatasetAnalyzer.Count;
end;

function TDatasetFieldModel.GetValue(ARecordHandle: TcxDataRecordHandle; AItemHandle: TcxDataItemHandle): Variant;
var
  AColumnId: Integer;
  theField : TDatasetField;
begin
  result := Variants.Null;
  AColumnId := GetDefaultItemID(Integer(AItemHandle));

  if Integer(ARecordHandle) < Self.GetRecordCount then begin
    theField := (DatasetAnalyzer.Items[Integer(ARecordHandle)] as TDatasetField);
    if Assigned(theField) then begin
      case AColumnId of
        0 : Result := theField.FieldName;
        1 : Result := theField.DataTypeStr;
        2 : Result := theField.Size;
      end;
    end;
  end;
end;

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  DatasetFieldModel := TDatasetFieldModel.Create;
  cxGrid1TableView1.DataController.CustomDataSource := DatasetFieldModel;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
  if ListBox1.ItemIndex >= 0 then begin
    Table1.Active := false;
    Table1.TableName := ListBox1.Items.Strings[ListBox1.ItemIndex];
    Table1.Active := true;

    DatasetFieldModel.DatasetAnalyzer.Analyzer(Table1);
    DatasetFieldModel.DataChanged;
  end;
end;

- 한글관련 버그 수정 (Delphi 2009 이상

사이트 : http://eaglesoft.tistory.com/162

- 옵션

cxGrid1TableView1.OptionsView.GroupByBox := false;
cxGrid1TableView1.OptionsData.Editing := false;  // 읽기전용

- ??

procedure TCreateTableFrm.Col1GetProperties(
  Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord;
  var AProperties: TcxCustomEditProperties);
var
  rowData : TRowObject;
begin
  rowData := TRowObject(CustomGridModel.RowDataList.Items[ARecord.Index]);


  ...
end;

- 수정중인 Cell 바로 적용

cxGrid1TableView1.DataController.PostEditingData;

- end - 

신고
TAG CxGrid, Delphi


신고

Delphi - IniFile

Programming/Delphi 2009.11.22 01:50 Posted by 파란크리스마스

참조
http://delphigeist.blogspot.com/2009/11/saveload-controls-from-inifile-using.html

uses
  inifiles;

procedure TForm1.FormCreate(Sender: TObject);
var
  IniFile  : TiniFile;
begin
  //
  IniFile  := TiniFile.Create(ChangeFileExt(Application.ExeName,'.ini'));
  try
    isDEBUG := IniFile.ReadBool('INFO', 'DEBUG', false);
  finally
    IniFile.Free;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  IniFile  : TiniFile;
begin
  //
  IniFile  := TiniFile.Create(ChangeFileExt(Application.ExeName,'.ini'));
  try
    IniFile.WriteBool('INFO', 'DEBUG', isDEBUG);
  finally
    IniFile.Free;
  end;
end;

신고

Delphi - MessageDlg

Programming/Delphi 2009.09.24 10:17 Posted by 파란크리스마스

uses
  Dialogs;

function MessageDlg(const Msg: string; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; HelpCtx: Longint; DefaultButton: TMsgDlgBtn): Integer; overload;

TMsgDlgType = (
  mtWarning,
  mtError,
  mtInformation,
  mtConfirmation,
  mtCustom
);

TMsgDlgBtn = (
  mbYes,
  mbNo,
  mbOK,
  mbCancel,
  mbAbort,
  mbRetry,
  mbIgnore,
  mbAll,
  mbNoToAll,
  mbYesToAll,
  mbHelp,
  mbClose
);

if MessageDlg('종료 할래?', mtConfirmation, [mbYes, mbNo], 0, mbYes) = mrYes then begin
  Close;
end;

신고

Delphi로 만들어본 자바분석기

Programming/Delphi 2009.09.22 02:03 Posted by 파란크리스마스

Antlr 도구를 이용해서 만들어본 자바파서입니다.
간단하게 샘플 Grammer 을 이용해서 만들어 보았습니다.
 
파싱하는 자바 소스는 컴파일 가능한 소스가 아니면
Grammer에 어긋나기 때문에 파싱이 되지 않습니다.
(사용된 Grammer가 최신 JDK에 만족하지 않을 수 있으므로 최신 JDK 문법도 파싱이 안 될수 있음)
 
Package, Import, Class, Method을 몇번째 라인, 열, 사용된 이름을 객체화해서 담아 두었습니다.
 
더 자세한 정보를 담으려 했으나,
Delphi로 자바 파싱에 관심이 있는 사람이 있는지 궁금하네요. (손들어 보세요.)
 
파싱한 결과를
객체화 하기 위해서 클래스를 설계하는 일도 만만치 않는 일이라 여기에서 중단합니다.
(누가 클래스를 설계주시면 객체에 담아 보겠습니다. JavaSourceUnit.pas)
 
Grammer 파일은 제외한 컴파일 하는 한 소스 파일은 제 블로그에서 받으실 수 있으며,
배포시 제 블로그의 주소와 함께 배포해주세요.
(Delphi 2090이상에서만 컴파일 가능)

신고


 

티스토리 툴바