четверг, 8 ноября 2012 г.

Групповая обработка файлов в bash (цикл for)

Есть две папки
  1. bin - куда собирается программа
  2. 10y - папка с материалами, с которыми должна работать программа.
Раньше я просто копировал папку с материалами в bin. Однако настало время что я узнал, что мой винт не резиновый а материалов там пол Гига.

В общем решил симлинки положить в bin. Но создавать в ручную около 50 симлинков лень. Решил поискать как это дело можно автоматизировать.
Нашел.

Итак, структура каталогов следующая

project
├── 10y
├── bin
...
└── src


for file in 10y/*; do ln -s ../10y/$file ../bin/$file; done
  1. Заходим в каталог project
  2. Пишем выше приведенную строчку и жмем ентер
  3. Наслаждаемся результатом ))
следующая строка ищет все файлы и каталоги в папке 10y
for file in 10y/*;
где  file - это переменная итератор

далее создает для каждого выбранного файла или каталога относительный симлинк в папке bin
do ln -s ../10y/$file ../bin/$file;
значение переменной извлекается через  $, поэтому пишем не просто file, а $file

В общем виде цикл организован так
for <переменная итератор> in <маска>; do <действие>; done
Обратите внимание на точки с запятыми do и done - это обязательно

суббота, 18 февраля 2012 г.

Как убрать закладки у PageControl?

Уже много раз нужно было убрать у TPageControl эти закладки. Не TabSheet,  а именно сам заголовок. Мне нужно было для визарда, для формы настроек, где слева дерево, а справа страница с контролами.
Как сделать это с TPageControl сразу не понятно и поэтому как я только не изголялся - использовал и TFrame, и TNoteBook. Всё неудобно. Но как это сделать с TPageControl я долго не искал, потомучто нужно было делать срочно.
И вот настал момент, когда сказали переделать существующий PageControl, у которого около 20 страниц, на каждой из которых может быть до 20 контролов. Переделывать все это заново как-то не хотелось.
Правду люди говорят:
"Лень -  двигатель прогресса"
Нашел как это сделать. И все оказалось очень просто. И так.

  1. Кидаем на форму TPageControl.
  2. Устанавливаем  TPageControl.Style := tsButtons.
  3. Заполняем его TTabSheet-ами
  4. У каждого табшита устанавливаем TabVisible := False;
  5. Потом присваиваем TPageControl.ActivePage := TabSheet1;
В моем случае я сделал при создании формы
 pcMain.Style := tsButtons;
 for I := 0 to pcMain.PageCount-1 do
    pcMain.Pages[I].TabVisible := False;
 pcMain.ActivePage := tsBasic;

Заполнил TreeView нодами с заданными значениями SelectedIndex. Потом в TTreeView.OnChange 

procedure TfrmMain.PropTreeChange(Sender: TObject; Node: TTreeNode);
begin
  case Node.SelectedIndex of
    10  : pcMain.ActivePage := tsBasic;
    20  : pcMain.ActivePage := tsDocs;
    30,
    31  : pcMain.ActivePage := tsTextsOffer;
    32  : pcMain.ActivePage := tsTextsInfo;
...

где tsBasic и тому подобные - это TTabSheet


Вот и все

пятница, 17 февраля 2012 г.

Проблемы с наследниками TFrame

Добавил в проект фрейм  TCustomTextFrame = class (TFrame). Визуальных контролов на него не ложил. Просто добавил нужные свойства, методы, объявил абстракные...
Добавить наследника TCustomTextFrame  через File/Add New/Other/Inherited не получилось.
Добавил простой фрейм и вручную в коде поменял ему предка с TFrame на TCustomTextFrame 
TframeTextsOffer = class(TCustomTextFrame)
Всё  нормально подхватилось и заработало.

Самое интересно началось на следующий день - при открытии в дизайнтайме TframeTextsOffer вылетала ошибка, что нет такого свойства как ClientHeight. Компилялось молча, но при запуске приложения тоже ругалось на ClientHeight.

Оказалось что делфи почемуто добавляет внуку, так сказать, фрейма в *.dfm свойства ClientHeigh, ClientWidth и ещё кучу всякого. Но у фрейма такого нет. Вот и ругается.
Но простое удаление не дает результатов -  делфи при открытии TframeTextsOffer  в дизайнтайме упорно добавляет эти свойства, на которые потом сама же и ругается.

Помогло только изменение вручную в *.dfm object frameTextsOffer: TframeTextsOffer  на inherited frameTextsOffer: TframeTextsOffer.

Не знаю насколько это правильно, но пока работает.

вторник, 24 января 2012 г.

Delphi и дескрипшены к полям MS Access

Задача: Получить коментарии (описания) полей в MS Access и сделать их хинтами к контролам.


Итак что нужно сделать
  1. Получить комментарии к полям
  2. Список Таблица.Поле=Коментарий
  3. Обновить хинты контролов.
Первое.
В DataModule делаю 


private
  FFieldsComments: TStrings;
  ...

  procedure UpdateFieldsComments;
published
  property FieldsComments: TStrings read FFieldsComments;


FFieldsComments создается в DataModuleCreate и разрушается в DataModuleDestroy.


procedure TdmMain.UpdateFieldsComments;
var
  ADODataSet: TADODataSet;
begin
  if Assigned(FFieldsComments) and ADOConnection1.Connected then
  begin
    FFieldsComments.Clear;
    ADODataSet := TADODataSet.Create(Self);
    try
      ADOConnection1.OpenSchema(siColumns, VarArrayOf([Unassigned, Unassigned, tblDeviceCharacteristics.TableName]), EmptyParam, ADODataSet);
      ADODataSet.Open;
      ADODataSet.First;
      while not ADODataSet.Eof do
      begin
        if ADODataSet.FieldByName('DESCRIPTION').AsWideString <> '' then
          FFieldsComments.Append(ADODataSet.FieldByName('TABLE_NAME').AsWideString + '.' +ADODataSet.FieldByName('COLUMN_NAME').AsWideString + '=' +ADODataSet.FieldByName('DESCRIPTION').AsWideString);
        ADODataSet.Next;
      end;
    finally
       FreeAndNil(ADODataSet)
    end;
  end;
end;



Всё делается методом OpenSchema.Самый мне непонятный параметр это второй. Туда передаю VarArrayOf(...), но я пока не нашел описания что есть что в этом масиве. Я просто подставил то что нашёл в инете и получил, что хотел. Может, если найду описание дополню статью. 
Процедуру UpdateFieldsComments вызываю в ADOConnection.OnAfterConnect.

Теперь в форме нужно обновить хинты.


procedure TfrmMain.UpdateHitnsFromDB;
var
  i: integer;
  procedure UpdateDBEditHint( AControl: TDBEdit);
  begin
    if AControl.DataSource.DataSet is TADOTable then
      AControl.Hint := dmMain.FieldsComments.Values[TADOTable(AControl.DataSource.DataSet).TableName + '.' + AControl.DataField];
  end;

  procedure UpdateDBLinkEditHint( AControl: TDBLinkEdit);
  begin
    if AControl.DataSource.DataSet is TADOTable then
      AControl.Hint := dmMain.FieldsComments.Values[TADOTable(AControl.DataSource.DataSet).TableName + '.' + AControl.DataField];
  end;

  procedure UpdateDBLookupComboBoxHint( AControl: TDBLookupComboBox);
  begin
    if AControl.DataSource.DataSet is TADOTable then
      AControl.Hint := dmMain.FieldsComments.Values[TADOTable(AControl.DataSource.DataSet).TableName + '.' + AControl.DataField];
  end;

begin
  for I := 0 to ComponentCount-1 do
    if Components[I] is TDBEdit then
      UpdateDBEditHint(Components[I] as TDBEdit)
    else if Components[I] is TDBLinkEdit then
       UpdateDBLinkEditHint(Components[I] as TDBLinkEdit)
    else if Components[I] is TDBLookupComboBox then
       UpdateDBLookupComboBoxHint(Components[I] as TDBLookupComboBox)
end;

UpdateHitnsFromDB вызываю в actConnectExecute
Вот и все.  


среда, 18 января 2012 г.

Delphi и Диалог выбора папки

Сколько себя помню у Delphi никогда не было своего компонента выбора папки типа TOpenDialog и каждый раз когда нужно было выбирать именно папку искал как это делается.
Вот теперь решил записать то что я нашел и немного переделал для себя.
Это пока функция, возможно когда-то сделаю компонент типа TOpenFolder.

И так всё эавязано на функции ShBrowseForFolder из модуля ShlObj или по новому Winapi.ShlObj.
Но множество примеров, которые я видел были без кнопки Create New Folder и без возможности установки пути по умолчанию.
И так код:
...
function SelectFolder(hWnd: HWND; const Caption: WideString; var Folder: WideString): boolean;
...
implementation
uses  ShlObj, ActiveX, Forms;
var
  DefaultPath: widestring = '';
...
//Эта функция нужна для установки пути по умолчанию
function BrowseCallbackProc(hwnd: HWND; uMsg: UINT; lParam: LPARAM; lpData: LPARAM): integer; stdcall;
begin
  Result := 0;
  if uMsg = BFFM_INITIALIZED then
    SendMessage(hwnd, BFFM_SETSELECTION, 1, LongInt(PWideChar(DefaultPath)));
end;

function SelectFolder(hWnd: HWND; const Caption: WideString; var Folder: WideString): boolean;
var
  WindowList: Pointer;
  BrowseInfo : TBrowseInfo;
  Buffer: PChar;
  RootItemIDList, ItemIDList: PItemIDList;
  ShellMalloc: IMalloc;
  IDesktopFolder: IShellFolder;
  Eaten, Flags: LongWord;
begin
  FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
  if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
  begin
    Buffer := ShellMalloc.Alloc(MAX_PATH);
    try
      DefaultPath := Folder;
      RootItemIDList := nil;
      with BrowseInfo do
      begin
        hwndOwner := hWnd;
        pidlRoot := RootItemIDList;
        pszDisplayName := Buffer;
        lpfn := @BrowseCallbackProc;
        lpszTitle := PWideChar(Caption);
        ulFlags := BIF_RETURNONLYFSDIRS or $0040 or BIF_EDITBOX or BIF_STATUSTEXT;
      end;
      WindowList := DisableTaskWindows(0);
      try
        ItemIDList := ShBrowseForFolder(BrowseInfo);
      finally
        EnableTaskWindows(WindowList);
      end;
      Result :=  ItemIDList <> nil;
      if Result then
      begin
        ShGetPathFromIDList(ItemIDList, Buffer);
        ShellMalloc.Free(ItemIDList);
        Folder := Buffer
      end;
    finally
      ShellMalloc.Free(Buffer);
      DefaultPath := '';
    end;
  end;
end;



Теперь пример использования:
procedure TframeGeneralSettings.Button1Click(Sender: TObject);
var
  Value: WideString;
begin
  Value := edtImagesFolder.Text;
  if SelectFolder(Handle,  'Select ' + lblImagesFolder.Caption, Value) and (Value <> edtImagesFolder.Text) then
    edtImagesFolder.Text := Value;
end;