Модераторы: Poseidon, Snowy, bems, MetalFan

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Арсенал форумистов, Выкладывайте свои работы! 
:(
    Опции темы
p0s0l
Дата 15.4.2004, 00:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Г-н Посол
****


Профиль
Группа: Экс. модератор
Сообщений: 3668
Регистрация: 13.7.2003
Где: 58°38' с.ш. 4 9°41' в.д.

Репутация: 58
Всего: 112



Не раз уже встречал случаи, когда кто-нибудь хотел выложить какие-то свои наработки в Delphi: модули, исходники, компоненты, может еще что-то. Предлагалось создавать отдельный раздел, но пока не понятно, будет ли от этого толк. Пока что создаю эту тему. В дальнейшем же будет видно насчёт отдельного раздела исходников по тому, какая тут будет активность, и как к этому отнесётся Admin.

Единственное правило - в этой теме не флеймить, тут оставлять только краткое описание модулей и ссылки к ним.

Можно скинуть мне на мыло (кнопка E-Mail под моим постом) файл, и я его прикреплю к вашему сообщению при первой же возможности...



--------------------
С уважением, г-н Посол.
PM   Вверх
Akella
Дата 22.3.2005, 12:16 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Творец
****


Профиль
Группа: Модератор
Сообщений: 18477
Регистрация: 14.5.2003
Где: Корусант

Репутация: 36
Всего: 329



Примеры для работы с
1. MS Word
2. pop3
3. smtp
4. socket
5. mail - отправка почты

Примеры не мои личные

Присоединённый файл ( Кол-во скачиваний: 436 )
Присоединённый файл  dsergey.zip
PM MAIL   Вверх
Akella
  Дата 22.3.2005, 12:35 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Творец
****


Профиль
Группа: Модератор
Сообщений: 18477
Регистрация: 14.5.2003
Где: Корусант

Репутация: 36
Всего: 329



Обмен данными между процессами. Сам не тестировал.

Присоединённый файл ( Кол-во скачиваний: 132 )
Присоединённый файл  FileMapping_ExchangeData.zip
PM MAIL   Вверх
ДЫМ
Дата 3.4.2005, 03:13 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 224
Регистрация: 6.1.2004

Репутация: 8
Всего: 8



Быстрая функция для разбивки строки на части (слова) в один цикл.

Код

type TDelim=set of Char;
        TArrayOfString=Array of String;
 

//*******************
//
// Разбивает строку с разделителями на части
// и возвращает массив частей
//
// fcToParts
//

function fcToParts(sString:String;tdDelim:TDelim):TArrayOfString
var iCounter,iBegin:Integer;
begin//fc
if length(sString)>0 then
 begin
  include(tdDelim,#0);iBegin:=1; SetLength(Result,0);
  For iCounter:=1 to Length(sString)+1 do
   begin//for
    if (sString[iCounter] in tdDelim) then
     begin
      SetLength(Result,Length(Result)+1);
      Result[Length(Result)-1]:=Copy(sString,iBegin,iCounter-iBegin);
      iBegin:=iCounter+1;
     end;
  end;//for
 end;//if
end;//fc


Пример использования

Код

var
 StrArr:TArrayOfString

StrArr:=fcToParts('строка1-строка2@строка3',['-','@']):


PM MAIL WWW   Вверх
ДЫМ
Дата 17.4.2005, 01:56 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 224
Регистрация: 6.1.2004

Репутация: 8
Всего: 8



Делал тут ListBox с подсказками, получился такой вот компонент.

Компонент LSVListBox, потомок TListBox, использует всплывающие подсказки (Hint) для полного отображения
не умещающихся строк и позволяет изменять стиль подсказок (шрифт, цвета, дополнительные рамки, тень,
авторазмер), установить разные стили подсказок для выделенных и невыделенных пунктов.
Помимо этого не умещающиеся строки корректно обрезаются (с троеточием), имеется возможность изменить цвета для выделенных пунктов, отключить фокусирующий прямоугольник, уменьшено мерцание при прорисовке элементов, добавлены обработчики событий OnMouseEnter и OnMouseLeave

Это сообщение отредактировал(а) ДЫМ - 18.4.2005, 01:09

Присоединённый файл ( Кол-во скачиваний: 122 )
Присоединённый файл  LSVListBox.zip
PM MAIL WWW   Вверх
Akella
Дата 14.5.2005, 10:11 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Творец
****


Профиль
Группа: Модератор
Сообщений: 18477
Регистрация: 14.5.2003
Где: Корусант

Репутация: 36
Всего: 329



Функция подмены разделителя целой и дробной части при вводе данных прямо в сетку, а также при вводе даты. Пользователя не должен думать о том, что ему правльно вводить в качетсве разделителя: точку или запятую
TfmMain - TForm

TDBGridEh - сетка из пакета EhLib, можно необязательно сетку, можно, просто TEdit.

Код

в разделе 
  public
    { Public declarations }

главной формы объявляем
    Procedure DecPoint(Sender: TObject; var Key: Char);
для доступности из всех остальных форм


Код

Procedure TfmMain.DecPoint(Sender: TObject; var Key: Char);
begin
 if (Sender is TDBGridEh) then
   if (Sender as TDBGridEh).SelectedField.DataType=ftFloat then
      if (Key='.') or (Key=',') then Key:=DecimalSeparator;

 if (Sender is TDBEditEh) then
   if (Sender as TDBEditEh).Field.DataType=ftDate then
      if (Key='.') or (Key=',') then Key:=DateSeparator;
end;


использование в OnKeyPress
Код

procedure TfmMain.DBGrid1KeyPress(Sender: TObject; var Key: Char);
begin
  DecPoint(Sender,Key);
end;

PM MAIL   Вверх
Alex
Дата 24.6.2005, 04:32 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Экс. модератор
Сообщений: 4147
Регистрация: 25.3.2002
Где: Москва

Репутация: 80
Всего: 162



Две полезные процедуры:

Код

uses
   StrUtils;

procedure CopyComponentProp(Source, Target: TObject; aExcept: array of string);
// Копирование всех одинаковых по названию свойств/методов одного компонента в
// другой за исключение "Name", "Left", "Top" и тех которые заданы в aExcept
// Примеры использования:
// CopyComponentProp(N11, N21, []);
// CopyComponentProp(ListBox2, ListBox3, []);
// CopyComponentProp(ListView1, ListView2, ['Items', 'Color']);
var
  I, Index: Integer;
  PropName: string;
  Source_PropList  , Target_PropList  : PPropList;
  Source_NumProps  , Target_NumProps  : Word;
  Source_PropObject, Target_PropObject: TObject;

  // Поиск в списке свойства с заданным именем

  function FindProperty(const PropName: string; PropList: PPropList; NumProps: Word): Integer;
  var
    I: Integer;
  begin
    Result:= -1;
    for I:= 0 to NumProps - 1 do
      if CompareStr(PropList^[I]^.Name, PropName) = 0 then begin
        Result:= I;
        Break;
      end;
  end;

begin
  if not Assigned(Source) or not Assigned(Target) then Exit;

  Source_NumProps:= GetTypeData(Source.ClassInfo)^.PropCount;
  Target_NumProps:= GetTypeData(Target.ClassInfo)^.PropCount;

  GetMem(Source_PropList, Source_NumProps * SizeOf(Pointer));
  GetMem(Target_PropList, Target_NumProps * SizeOf(Pointer));
  try
    // Получаем список свойств
    GetPropInfos(Source.ClassInfo, Source_PropList);
    GetPropInfos(Target.ClassInfo, Target_PropList);

    for I:= 0 to Source_NumProps - 1 do begin
      PropName:= Source_PropList^[I]^.Name;

      if  (AnsiIndexText('None'  , aExcept                ) =  -1) and
         ((AnsiIndexText(PropName, ['Name', 'Left', 'Top']) <> -1) or
          (AnsiIndexText(PropName, aExcept                ) <> -1)) then Continue;

      Index:= FindProperty(PropName, Target_PropList, Target_NumProps);
      if Index = -1 then Continue; // не нашли

      // Проверить совпадение типов
      if Source_PropList^[I]^.PropType^.Kind <> Target_PropList^[Index]^.PropType^.Kind then
        Continue;

      case Source_PropList^[I]^.PropType^^.Kind of
        tkClass:  begin
                    Source_PropObject:= GetObjectProp(Source, Source_PropList^[I    ]);
                    Target_PropObject:= GetObjectProp(Target, Target_PropList^[Index]);
                    CopyComponentProp(Source_PropObject, Target_PropObject, ['None']);
                  end;
        tkMethod: SetMethodProp(Target, PropName, GetMethodProp(Source, PropName));
      else
        SetPropValue(Target, PropName, GetPropValue(Source, PropName));
      end;
    end;
  finally
    FreeMem(Source_PropList);
    FreeMem(Target_PropList);
  end;
end;


Код

uses
   StrUtils

procedure AssignComponentProp(Source, Target: TObject; aProp: array of string);
// Копирование свойств/методов заданых в aProp одного компонента в другой
// Пример использования:
// AssignedComponentProp(ListView1, ListView2, ['Items', 'Color']);
var
  I, Index: Integer;
  PropName: string;
  Source_PropList  , Target_PropList  : PPropList;
  Source_NumProps  , Target_NumProps  : Word;
  Source_PropObject, Target_PropObject: TObject;

  // Поиск в списке свойства с заданным именем

  function FindProperty(const PropName: string; PropList: PPropList; NumProps: Word): Integer;
  var
    I: Integer;
  begin
    Result:= -1;
    for I:= 0 to NumProps - 1 do
      if CompareStr(PropList^[I]^.Name, PropName) = 0 then begin
        Result:= I;
        Break;
      end;
  end;

begin
  if not Assigned(Source) or not Assigned(Target) then Exit;

  Source_NumProps:= GetTypeData(Source.ClassInfo)^.PropCount;
  Target_NumProps:= GetTypeData(Target.ClassInfo)^.PropCount;

  GetMem(Source_PropList, Source_NumProps * SizeOf(Pointer));
  GetMem(Target_PropList, Target_NumProps * SizeOf(Pointer));
  try
    // Получаем список свойств
    GetPropInfos(Source.ClassInfo, Source_PropList);
    GetPropInfos(Target.ClassInfo, Target_PropList);

    for I:= 0 to Source_NumProps - 1 do begin
      PropName:= Source_PropList^[I]^.Name;

      if (AnsiIndexText('None'  , aProp   ) = -1) and
         (AnsiIndexText(PropName, aProp   ) = -1) then Continue;

      Index:= FindProperty(PropName, Target_PropList, Target_NumProps);
      if Index = -1 then Continue; // не нашли

      // Проверить совпадение типов
      if Source_PropList^[I]^.PropType^.Kind <> Target_PropList^[Index]^.PropType^.Kind then
        Continue;

      case Source_PropList^[I]^.PropType^^.Kind of
        tkClass:  begin
                    Source_PropObject:= GetObjectProp(Source, Source_PropList^[I    ]);
                    Target_PropObject:= GetObjectProp(Target, Target_PropList^[Index]);
                    AssignComponentProp(Source_PropObject, Target_PropObject, ['None']);
                  end;
        tkMethod: SetMethodProp(Target, PropName, GetMethodProp(Source, PropName));
      else
        SetPropValue(Target, PropName, GetPropValue(Source, PropName));
      end;
    end;
  finally
    FreeMem(Source_PropList);
    FreeMem(Target_PropList);
  end;
end;



--------------------
Написать можно все - главное четко представлять, что ты хочешь получить в конце. 
PM Skype   Вверх
Alex
Дата 2.7.2005, 12:25 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Экс. модератор
Сообщений: 4147
Регистрация: 25.3.2002
Где: Москва

Репутация: 80
Всего: 162



Для пользователей библиотеки EhLib.
  • (DBCtrlsEh.pas и ToolCtrlsEh.pas) для контролов которые могут содержать доп.кнопки (наследники TCustomDBEditEh), добавлена возможность индивидуального управления активностью этих кнопок.
  • (DBCtrlsEh.pas) исправлена ошибка (неточность) при работе с датами без указания года.
  • (ToolCtrlsEh.pas) для контролов которые могут содержать доп.кнопки (наследники TCustomDBEditEh), добавлено свойство Action. При задании свойства от Action кнопка наследует свойства: Enabled, Hint, ShortCut и Visible. Свойство доступно в Delphi 6 и выше.
Измененные модули для версии 3.6 приложены к посту. Для других версий можно сделать аналогично. Для этого, все изменения отмечены коментарием Alx

Присоединённый файл ( Кол-во скачиваний: 60 )
Присоединённый файл  EhLib_v3_6_units_modified_by_Alex.rar 55,99 Kb


--------------------
Написать можно все - главное четко представлять, что ты хочешь получить в конце. 
PM Skype   Вверх
RA
Дата 2.7.2005, 14:05 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Брутальный буратина
****


Профиль
Группа: Участник Клуба
Сообщений: 3497
Регистрация: 31.3.2002
Где: Лес

Репутация: 14
Всего: 115



Функция конвертации текста HTML содержащего строки вида &# 123; в читабельбный вид



Код

Function PreDecode(s:string):string;
  function AddNumericChar(I: Integer):string;
  var
    W: WideChar;
    Buffer: array[0..10] of char;
  begin
    if I = 9 then result := ' '
       else if I < ord(' ') then  result := '?'  {control char}
           else if (I < 256)  then   result := Chr(I)
    else
    begin
    W := WideChar(I);
    SetString(result, Buffer, WideCharToMultiByte(CP_ACP, 0,
          @W, 1, @Buffer, SizeOf(Buffer), nil, nil))
    end;
  end;

var val,i,ik:integer; sq:string;
begin
  for i:=1 to Length(s) do
  begin
      if ( (s[i]='&') and (s[i+1] ='#') ) then
       begin
          sq := Copy(s,i+2,length(s));
          for ik:=1 to length(sq) do
          begin
            if not ( sq[ik] in ['0'..'9'] ) then
            break;
          end;
          if  Copy(sq,1,ik-1) <> '' then
          val := StrToInt( Copy(sq,1,ik-1) ) else val:=-1;
          if ( (val <> -1) and (sq[ik] = ';')  )
          then
           begin
             Result:=Result+AddNumericChar(val);
             Delete(s,i,ik+1);
            end;
       end else  result:=Result+s[i];
  end;

end;





PM   Вверх
Rrader
  Дата 28.7.2005, 16:53 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Inspired =)
***


Профиль
Группа: Экс. модератор
Сообщений: 1535
Регистрация: 7.5.2005

Репутация: 70
Всего: 191



В аттаче пример работы с TaskBar (получене текста всех кнопок).

Это сообщение отредактировал(а) Rrader - 18.7.2008, 15:54

Присоединённый файл ( Кол-во скачиваний: 42 )
Присоединённый файл  Toolbar_Button_Enum.rar 7,59 Kb


--------------------
Let's do this quickly!
Rest in peace, Vit!
PM MAIL Skype   Вверх
Rrader
  Дата 19.8.2005, 09:05 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Inspired =)
***


Профиль
Группа: Экс. модератор
Сообщений: 1535
Регистрация: 7.5.2005

Репутация: 70
Всего: 191



 Функция, которая нарисует на форме сетку и сделает форму похожей на дизайнер форм Delphi. По умолчанию в дизайнере Delphi отступы равны 8 пикселям smile 
Код

Procedure TForm1.DrawGrid;
Var
  TmpBmp: TBitmap;
Begin
  TmpBmp := TBitmap.Create;
  Try
    With TmpBmp Do
    Begin
      Width := 8;
      Height := 8;
      Canvas.Brush.Color := clBtnFace;
      Canvas.FillRect(TmpBmp.Canvas.ClipRect);
      Canvas.Pixels[0, 0] := clBlack;
      Canvas.Pixels[0, Height] := clBlack;
      Canvas.Pixels[Width, 0] := clBlack;
      Canvas.Pixels[Width, Height] := clBlack;
    End;
    With Canvas, Brush Do
    Begin
      Bitmap := TBitmap.Create;
      Try
        Bitmap.Assign(TmpBmp);
        Canvas.FillRect(Canvas.ClipRect);
      Finally
        Bitmap.Free;
      End;
    End;
  Finally
    TmpBmp.Free;
  End;
End;

{ Использование }
Procedure TForm1.FormPaint(Sender: TObject);
Begin
  DrawGrid; 
End;
 
Ещё способ, рисует сетку либо линии на компоненте AObject цветом FGridColor, в параметре ACanvas нужно передать холст компонента, FSizeX и FSizeY определяют размер сетки либо линий:
Код

...
  { Тип }
  TGridType = (gtDots, gtLines);
...
Procedure Draw(AObject: TControl; ACanvas: TCanvas; FGridType: TGridType; FGridColor: TColor;
  FSizeX, FSizeY: Integer);
Var
  ColorRGB, X, Y, MaxX, MaxY: Integer;
  DC: HDC;
Begin
  MaxX := AObject.ClientWidth Div FSizeX;
  MaxY := AObject.ClientHeight Div FSizeY;
  Case FGridType of
    gtDots:
      Begin
        ColorRGB := ColorToRGB(FGridColor);
        DC := ACanvas.Handle;
        For X := 0 To MaxX Do
          For Y := 0 To MaxY Do
          SetPixel(DC, X * FSizeX, Y * FSizeY, ColorRGB);
      End;
    gtLines:
      Begin
        ACanvas.Pen.Color := FGridColor;
        For X := 0 To MaxX Do
        Begin
          ACanvas.MoveTo(X * FSizeX, 0);
          ACanvas.LineTo(X * FSizeY, AObject.ClientHeight);
        End;
        For Y := 0 To MaxY Do
        Begin
          ACanvas.MoveTo(0, Y * FSizeY);
          ACanvas.LineTo(AObject.ClientWidth, Y * FSizeY);
        End;
      End;
  End;
End;
  

Это сообщение отредактировал(а) Rrader - 24.6.2006, 11:57


--------------------
Let's do this quickly!
Rest in peace, Vit!
PM MAIL Skype   Вверх
Rrader
  Дата 12.11.2005, 14:13 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Inspired =)
***


Профиль
Группа: Экс. модератор
Сообщений: 1535
Регистрация: 7.5.2005

Репутация: 70
Всего: 191



Пример использование методов интерфейса IShellDispatch (это интересно smile ).
Код

Unit UMain;

Interface

Uses
  Windows, Messages, SysUtils, Classes,
  Graphics, Controls, Forms, Dialogs, StdCtrls,
  ComObj, ActiveX, XPMan;

Const
  CLASS_Shell: TGUID = '{13709620-C279-11CE-A49E-444553540000}';

Type
  TMainForm = Class(TForm)
    FolderBtn: TButton;
    GroupBox1: TGroupBox;
    OpenBtn: TButton;
    EdFolder: TEdit;
    MinAllBtn: TButton;
    UnMinAllBtn: TButton;
    RunBtn: TButton;
    ExitWinBtn: TButton;
    FindBtn: TButton;
    CmpFndBtn: TButton;
    GroupBox2: TGroupBox;
    DTBtn: TButton;
    TaskBtn: TButton;
    Helpbtn: TButton;
    ApplBtn: TButton;
    Label1: TLabel;
    EdAppl: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure FolderBtnClick(Sender: TObject);
    procedure OpenBtnClick(Sender: TObject);
    procedure MinAllBtnClick(Sender: TObject);
    procedure UnMinAllBtnClick(Sender: TObject);
    procedure RunBtnClick(Sender: TObject);
    procedure ExitWinBtnClick(Sender: TObject);
    procedure FindBtnClick(Sender: TObject);
    procedure CmpFndBtnClick(Sender: TObject);
    procedure HelpbtnClick(Sender: TObject);
    procedure DTBtnClick(Sender: TObject);
    procedure TaskBtnClick(Sender: TObject);
    procedure ApplBtnClick(Sender: TObject);
  Private
    { Private declarations }
  Public
    { Public declarations }
  End;

  FolderItemVerb = Interface(IDispatch)
    ['{08EC3E00-50B0-11CF-960C-0080C7F4EE85}']
    Function Get_Application: IDispatch; Safecall;
    Function Get_Parent: IDispatch; Safecall;
    Function Get_Name: WideString; Safecall;
    Procedure DoIt; Safecall;
    Property Application: IDispatch Read Get_Application;
    Property Parent: IDispatch Read Get_Parent;
    Property Name: WideString Read Get_Name;
  End;

  FolderItemVerbs = Interface(IDispatch)
    ['{1F8352C0-50B0-11CF-960C-0080C7F4EE85}']
    Function Get_Count: Integer; Safecall;
    Function Get_Application: IDispatch; Safecall;
    Function Get_Parent: IDispatch; Safecall;
    Function Item(index: OleVariant): FolderItemVerb; Safecall;
    Function _NewEnum: IUnknown; Safecall;
    Property Count: Integer Read Get_Count;
    Property Application: IDispatch Read Get_Application;
    Property Parent: IDispatch Read Get_Parent;
  End;

  FolderItem = Interface(IDispatch)
    ['{FAC32C80-CBE4-11CE-8350-444553540000}']
    Function Get_Application: IDispatch; Safecall;
    Function Get_Parent: IDispatch; Safecall;
    Function Get_Name: WideString; Safecall;
    Procedure Set_Name(Const pbs: WideString); Safecall;
    Function Get_Path: WideString; Safecall;
    Function Get_GetLink: IDispatch; Safecall;
    Function Get_GetFolder: IDispatch; Safecall;
    Function Get_IsLink: WordBool; Safecall;
    Function Get_IsFolder: WordBool; Safecall;
    Function Get_IsFileSystem: WordBool; Safecall;
    Function Get_IsBrowsable: WordBool; Safecall;
    Function Get_ModifyDate: TDateTime; Safecall;
    Procedure Set_ModifyDate(pdt: TDateTime); Safecall;
    Function Get_Size: Integer; Safecall;
    Function Get_type_: WideString; Safecall;
    Function Verbs: FolderItemVerbs; Safecall;
    Procedure InvokeVerb(vVerb: OleVariant); Safecall;
    Property Application: IDispatch Read Get_Application;
    Property Parent: IDispatch Read Get_Parent;
    Property Name: WideString Read Get_Name Write Set_Name;
    Property Path: WideString Read Get_Path;
    Property GetLink: IDispatch Read Get_GetLink;
    Property GetFolder: IDispatch Read Get_GetFolder;
    Property IsLink: WordBool Read Get_IsLink;
    Property IsFolder: WordBool Read Get_IsFolder;
    Property IsFileSystem: WordBool Read Get_IsFileSystem;
    Property IsBrowsable: WordBool Read Get_IsBrowsable;
    Property ModifyDate: TDateTime Read Get_ModifyDate Write Set_ModifyDate;
    Property Size: Integer Read Get_Size;
    Property Type_: WideString Read Get_type_;
  End;

  FolderItems = Interface(IDispatch)
    ['{744129E0-CBE5-11CE-8350-444553540000}']
    Function Get_Count: Integer; Safecall;
    Function Get_Application: IDispatch; Safecall;
    Function Get_Parent: IDispatch; Safecall;
    Function Item(Index: OleVariant): FolderItem; Safecall;
    Function _NewEnum: IUnknown; Safecall;
    Property Count: Integer Read Get_Count;
    Property Application: IDispatch Read Get_Application;
    Property Parent: IDispatch Read Get_Parent;
  End;

  Folder = Interface(IDispatch)
    ['{BBCBDE60-C3FF-11CE-8350-444553540000}']
    Function Get_Title: WideString; Safecall;
    Function Get_Application: IDispatch; Safecall;
    Function Get_Parent: IDispatch; Safecall;
    Function Get_ParentFolder: Folder; Safecall;
    Function Items: FolderItems; Safecall;
    Function ParseName(Const bName: WideString): FolderItem; Safecall;
    Procedure NewFolder(Const bName: WideString; vOptions: OleVariant); Safecall;
    Procedure MoveHere(vItem: OleVariant; vOptions: OleVariant); Safecall;
    Procedure CopyHere(vItem: OleVariant; vOptions: OleVariant); Safecall;
    Function GetDetailsOf(vItem: OleVariant; iColumn: SYSINT): WideString; Safecall;
    Property Title: WideString Read Get_Title;
    Property Application: IDispatch Read Get_Application;
    Property Parent: IDispatch Read Get_Parent;
    Property ParentFolder: Folder Read Get_ParentFolder;
  End;

  IShellDispatch = Interface(IDispatch)
    ['{D8F015C0-C278-11CE-A49E-444553540000}']
    Function Get_Application: IDispatch; Safecall;
    Function Get_Parent: IDispatch; Safecall;
    Function NameSpace(vDir: OleVariant): Folder; Safecall;
    Function BrowseForFolder(Hwnd: Integer; Const Title: WideString;
      Options: Integer; RootFolder: OleVariant): Folder; Safecall;
    Function Windows: IDispatch; Safecall;
    Procedure Open(vDir: OleVariant); Safecall;
    Procedure Explore(vDir: OleVariant); Safecall;
    Procedure MinimizeAll; Safecall;
    Procedure UndoMinimizeALL; Safecall;
    Procedure FileRun; Safecall;
    Procedure CascadeWindows; Safecall;
    Procedure TileVertically; Safecall;
    Procedure TileHorizontally; Safecall;
    Procedure ShutdownWindows; Safecall;
    Procedure Suspend; Safecall;
    Procedure EjectPC; Safecall;
    Procedure SetTime; Safecall;
    Procedure TrayProperties; Safecall;
    Procedure Help; Safecall;
    Procedure FindFiles; Safecall;
    Procedure FindComputer; Safecall;
    Procedure RefreshMenu; Safecall;
    Procedure ControlPanelItem(Const szDir: WideString); Safecall;
    Property Application: IDispatch Read Get_Application;
    Property Parent: IDispatch Read Get_Parent;
  End;

  CoShell = Class
    Class Function Create: IShellDispatch;
    Class Function CreateRemote(Const MachineName: String): IShellDispatch;
  End;

Var
  MainForm: TMainForm;
  I: IShellDispatch;

Implementation

{$R *.dfm}

{ CoShell }

Class Function CoShell.Create: IShellDispatch;
Begin
  Result := CreateComObject(CLASS_Shell) As IShellDispatch;
End;

Class Function CoShell.CreateRemote(Const MachineName: String): IShellDispatch;
Begin
  Result := CreateRemoteComObject(MachineName, CLASS_Shell) As IShellDispatch;
End;

Procedure TMainForm.FormCreate(Sender: TObject);
Begin
  I := CoShell.Create;
End;

Procedure TMainForm.FolderBtnClick(Sender: TObject);
Var
  F: Folder;
Begin
  { Работа с папкой }
  F := I.BrowseForFolder(Handle, 'IShellDispatch example', 0, 0);
  If F = NIL Then Exit;
  If F.ParentFolder <> NIL Then
  Begin
    { Показ имени родительской папки }
    ShowMessage(F.ParentFolder.Title);
    { Показ количества дочерних папок }
    ShowMessage(IntToStr(F.Items.Count));
  End;
End;

Procedure TMainForm.OpenBtnClick(Sender: TObject);
Begin
  { Открытие папки }
  Try
    I.Explore(EdFolder.Text);
  Except
    Exit;
  End;
End;

Procedure TMainForm.MinAllBtnClick(Sender: TObject);
Begin
  { Свернуть все окна }
  I.MinimizeAll;
End;

procedure TMainForm.UnMinAllBtnClick(Sender: TObject);
Begin
  I.UndoMinimizeALL;
End;

Procedure TMainForm.RunBtnClick(Sender: TObject);
Begin
  { Окно "Выполнить..." }
  I.FileRun;
End;

Procedure TMainForm.ExitWinBtnClick(Sender: TObject);
Begin
  { Выключить Windows }
  I.ShutdownWindows;
End;

Procedure TMainForm.FindBtnClick(Sender: TObject);
Begin
  { Поиск }
  I.FindFiles;
End;

Procedure TMainForm.CmpFndBtnClick(Sender: TObject);
Begin
  { Поиск компьютеров }
  I.FindComputer;
End;

Procedure TMainForm.HelpbtnClick(Sender: TObject);
Begin
  { Вызов справки }
  I.Help;
End;

Procedure TMainForm.DTBtnClick(Sender: TObject);
Begin
  { Апплет: дата/время }
  I.SetTime;
End;

Procedure TMainForm.TaskBtnClick(Sender: TObject);
Begin
  { Апплет: панель задач }
  I.TrayProperties;
End;

Procedure TMainForm.ApplBtnClick(Sender: TObject);
Begin
  { Запуск своего апплета }
  I.ControlPanelItem(EdAppl.Text);
End;

End.

Проект с формой находится в аттаче.

Присоединённый файл ( Кол-во скачиваний: 132 )
Присоединённый файл  IShellDispatch.zip 11,87 Kb


--------------------
Let's do this quickly!
Rest in peace, Vit!
PM MAIL Skype   Вверх
Rrader
Дата 10.1.2006, 02:30 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Inspired =)
***


Профиль
Группа: Экс. модератор
Сообщений: 1535
Регистрация: 7.5.2005

Репутация: 70
Всего: 191



Как сделать ProgressBar таким же, как на заставке Windows XP
Вопос задается часто, вот решение без каких-либо компонентов:
Код

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, XPMan, ComCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ProgressBar1: TProgressBar;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

const
  PBS_MARQUEE = $08;
  PBM_SETMARQUEE = WM_USER + 10;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  FSpeed: Integer;
begin
  FSpeed := 100;
  SetWindowLong(ProgressBar1.Handle, GWL_STYLE,
    GetWindowLong(ProgressBar1.Handle, GWL_STYLE) Or PBS_MARQUEE);
  { Включить }
  SendMessage(ProgressBar1.Handle, PBM_SETMARQUEE, 1, FSpeed);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  { Выключить }
  SendMessage(ProgressBar1.Handle, PBM_SETMARQUEE, 0, 0);
end;

end.



--------------------
Let's do this quickly!
Rest in peace, Vit!
PM MAIL Skype   Вверх
vstepanov78
Дата 10.1.2006, 02:33 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 3
Регистрация: 10.1.2006
Где: Москва

Репутация: нет
Всего: нет



Периодически читаю рассылку этого форума. Хочу поделиться своими наработками (обновленной версией). Последние лет 5 при работе над текущими проектами пытаюсь выносить код общего назначения в отдельные библиотеки. Думаю, что выкладываемые исходники библиотек, а также реализованные в них идеи по универсализации функций и классов могут быть интересны и остальным.

ALLLIB. НАБОР ИСХОДНИКОВ ДЛЯ РАСШИРЕНИЯ ФУНКЦИОНАЛА СТАНДАРТНЫХ БИБЛИОТЕК DELPHI. ВЕРСИЯ ОТ 9.01.2006

Исходники библиотек: http://vstepanov78.narod.ru/alllib.zip
Краткая справка: http://vstepanov78.narod.ru/prog.htm#alllib

ОБЗОР ФУНКЦИОНАЛА

1. ОБЩИЕ ФУНКЦИИ (типы, строки, варианты, память, списки, таблицы, потоки, файлы, ini, реестр, многопоточность, исключения, языки):
- КОНВЕРТАЦИЯ ТИПОВ: конвертация строк и вариантов в типы и наоборот с автораспознаванием многих форматов независимо от настроек разделителей Windows (включая сложные форматы вроде '1 443,45', '12=34', '1111011b', '30-JAN-2004', '30/01/04 11:12:55.945', 'Wed Mar 13 19:15:06 UTC+0300 2002'), варианты функций без порождения исключений и использования SysUtils и с порождением исключений;
- КОДИРОВАНИЕ: кодирование и декодирование (строки C++/JScript и Pascal, Base64, HTML, URLEncode/URLDecode, KOI, ISO, Wide формата Windows NT и с нечетным количеством байт, XOR и др.), в том числе поддерживается быстрое кодирование длинных строк; разбор Delphi-форм DFM, включая бинарные; проверка соответствия маске и извлечение по маске (маски - с символами '?' и '*'); увеличение, уменьшение и округление даты до секунд, минут, часов, дней, месяцев, лет; поиск и замена в строке, добавление и извлечение строки из массива, хранимого в строке; извлечение строки текста при разных вариантах перевода строки, выравнивание колонок текста, функции парсинга выражений без использования объектов;
- ПАМЯТЬ: контроль утечек объектов и возможность контроля утечек памяти, дескрипторов; работа со списком и списком списков без SysUtils и использования объектов с заданием емкости, работа со строкой с заданием емкости и перераспределением памяти при превышении емкости, наращиваемой шагами; буфер в строку, изменение регистра и регистронезависимое сравнение блоков памяти, перемещение с перекрытием;
- СПИСКИ: индексируемые списки и таблицы без изменения порядка элементов с построением индекса при первой попытке поиска, поиск в таблице по любому набору колонок (списки и таблицы - указателей, строк, вариантов); иерархия без VCL;
- ПОТОКИ: обертки потоков с кэшированием чтения и записи, возможностью чтения следующего фрагмента данных без смещения позиции благодаря кэшу, извлечением следующей строки до перевод строки;
- ФАЙЛЫ: список файлов, копирование и удаление по маске с возможностью просмотра подкаталогов, вызовом прогресса; собственное имя DLL, получение версии библиотеки; поиск файла в %PATH%, разбор командной строки; работа с ярлыками, Map-файлами; простые функции файл в строку и строка в файл; простая функция записи в лог или на консоль с однозначно интерпретируемым форматом лога, поддержка отладки во многих функциях и объектах библиотеки; диалоги выбора файла и папки без VCL и SysUtils; вставка и извлечение из буфера обмена с правильной обработкой русских букв;
- INI: ini в памяти или потоке, возможность работы с секцией без имени, значениями параметров любой длины, быстрый поиск, сохранение комментариев; быстрое чтение иерархической конфигурации в многомерный массив вариантов;
- РЕЕСТР: реестр с корректной работой при ограниченных правах доступа, экспортом, импортом и удалением ключа с подразделами;
- МНОГОПОТОЧНОСТЬ: threadvar с инициализацией и завершением, правильной работой в Delphi 3, поддержка многопоточности всем кодом, инициализация и автоосвобождение объектов без увеличения кода приложения в случае подключения библиотеки без обращений к объекту библиотеки из приложения, работа с критическими секциями без SysUtils;
- ИСКЛЮЧЕНИЯ: отдельные модули сокращенных аналогов SysUtils для небольших приложений; объекты исключений с именем процедуры и кодом ошибки, в том числе поддержкой определения текста по коду ошибки Windows; список информации об исключениях;
- ЯЗЫКИ: русские и английские языковые константы, динамический выбор языка; чтение текущего языка системы; сумма прописью для разных валют на русском и английском с torry.ru без необходимости ini-файла; проверка ключевания счета;
- УДОБНЫЕ ФУНКЦИИ И ДР.: прочие функции для конвертации типов, удобной работы со строками вроде IIf, IfEmpty, AddPrefix, AddPostfix, JoinStr, вариантами, файлами.

2. СПЕЦИАЛИЗИРОВАННЫЕ ФУНКЦИИ (окна, база, интернет, COM, интерпретация скриптов, процессы, сжатие, привязка к компьютеру, графика):
- ДИАЛОГИ: диалоги без VCL, SysUtils и ресурсов - функции ввода строки, пароля, логина и пароля, просмотра и редактирование текста с выбором кодировки, ввода имени файла или выбора каталога, ввода случайной последовательности (функции взывают дочерние объекты от единого абстрактного объекта диалога без VCL); добавление иконки в системную область панели задач; получение списка окон верхнего уровня или иерархии с дочерними окнами; скроллирование в конец и поиск в TRichEdit в VCL, быстрое получение и обновление списка TListView и иерархии TTreeView из списка и иерархии в памяти;
- БАЗЫ ДАННЫХ: работа с базами данных через ADO без VCL, загрузка выборки таблиц в индексируемую таблицу вариантов в памяти и обновление выборки таблицы в базе по содержимому таблицы в памяти при заданных ключевых полях, в том числе с корректной работой с BLOB-полями для MS-SQL, Sybase, Oracle (с поддержкой ISO Cyrillic), Interbase; получение версии ADO;
- ИНТЕРНЕТ: работа с сокетами для сервера и клиента без VCL и SysUtils; отсылка HTTP- или HTTPS-запроса с получением ответа через WinInet; подключение к интернету, выход из Offline-режима браузера, получение собственных IP-адресов, разбор HTTP-ссылки; обертки ASP- и HTML-объектов с общим предком, делающим однотипным доступ к параметрам (полям) формы из сервера и клиента; общий метод чтения из ASP параметров сертификата CryptoAPI/Крипто-Про и Сигнал-КОМ Inter-PRO Client; отсылка почты простой функцией;
- СКРИПТЫ: поддержка интерфейса IActiveScript устанавливаемого с браузером интерпретатора JScript, VBScript (напрямую, без использования ScriptControl); поддержка интерфейса IDispatch (без необходимости написания и регистрации ocx), например, для встраивания COM-объекта в пространство имен IActiveScript для обращения к нему из скрипта; внутренний парсер функции строки обращения к COM-объекту с параметрами; получение GUID;
- ПРОЦЕССЫ: список имен и идентификаторов процессов (с поддержкой Windows 95/NT+); запуск задачи с ожиданием завершения или ожиданием создания ею первого окна, открытие документа (также есть возможность ожидания заданного промежутка времени с обработкой событий без VCL или ожидания появления файла); объекты межзадачного обмена с помощью сообщений Windows и прямой записи в память процесса; запуск приложения от имени пользователя; запуск и остановка сервиса, включая таймаут ожидания зависимых сервисов; запуск и остановка приложений COM+ в Component Services;
- СЖАТИЕ: сжатие и распаковка строки путем использования библиотеки Delphi ZLib (без внешних dll); распаковка CAB-файла;
- ПРИВЯЗКА К КОМПЬЮТЕРУ: привязка приложения к компьютеру, чтение напрямую из оборудования идентификатора и серийного номера CPU (также корректное определение частоты процессора), версии, даты, производителя и серийного номера BIOS, модели, версии и серийного номера контроллера HDD (возможно чтение для первых четырех жестки дисков) - всего используется порядка 14 различных способов обращении к оборудованию, благодаря чему поддерживаются Windows 95/98/ME/NT/2000/XP/2003, получение одинаковой информации при различных правах пользователя, включая гостевые; также чтение системной информации PCI-драйверах, версии Windows и Internet Explorer, доступных шрифтах;
- ГРАФИКА: поддержка загрузки GIF, PCX - позаимствованы с torry.ru, сделана динамическая инициализация; поддержка загрузки других форматов графики, в том числе TIF, PNG с помощью GDI+ (сделана динамически, т.к. библиотека может отсутствовать в старых Windows); функция изменения яркости картинки;
- ФИНАНСОВЫЕ И ДР.: прочие специализированные функции и классы конвертации, в том числе в и из формата 1С, поддержки HTTP-транспорта, получения информации об автозагружаемых процессах Windows.

3. КРИПТОГРАФИЯ (поддержка библиотек асимметричной шифрации и ЭЦП, симметричная шифрация и CRC):
- CRYPTOAPI/КРИПТО-ПРО: асимметричная шифрация и дешифрация, подпись и проверка ЭЦП с использованием CryptoAPI RSA, RSA-128 и Крипто-Про ГОСТ 28147-89, ГОСТ Р 34.11/34.10-94/2001 с возможностью кэширования ключей (прямое обращение к CryptoAPI), доступна симметричная шифрация (на сессионном ключе) и асимметричная шифрация на секретном и открытом ключе, секретном ключе и сертификате, автораспознавание Base64 и PEM-форматов запроса и сертификата, возможность хранения ключей Крипто-Про в файлах с временным импортом в реестр на период криптооперации и экспортом после нее; генерация ключей, формирование запросов на сертификат и установка сертификатов без и с использованием xenroll.dll, выпуск или отзыв сертификата по запросу в Microsoft Certification Authority, проверка действительности сертификата; поиск сертификата в хранилище по набору параметров, чтение его полей, добавление сертификата в хранилище, диалоги просмотра и выбора сертификатов; список установленных в системе типов криптопровайдеров, их имен и параметров, поддерживаемых алгоритмов и алгоритмов по умолчанию;
- СИГНАЛ-КОМ: асимметричная шифрация и дешифрация, подпись и проверка ЭЦП с использованием trial-версии Сигнал-КОМ Message-PRO RSA и СКЗИ ГОСТ 28147-89, ГОСТ Р 34.11/34.10-94/2001 с возможностью кэширования ключей; значения полей сертификата и просмотр содержимого сертификата аналогично диалогу в Сигнал-КОМ Inter-PRO; эмуляция диалога генерации случайной последовательности при ее отсутствии для ранних версий mespro.dll (аналогично имеющемуся в поздних);
- СИММЕТРИЧНОЕ ШИФРОВАНИЕ И CRC: симметричная шифрация и дешифрация по алгоритмам Blowfish, RC6, GOST, контрольная сумма CRC32 - позаимствованы с torry.ru, добавлена возможность кэширования ключей шифрования, чтобы не проводить повторную инициализацию, занимающую некоторое время, добавлена возможность поточного шифрования; формирование и однозначный разбор строки X500 с поддержкой имен параметров, используемых в CryptoAPI и Message-PRO.

ОСОБЕННОСТИ БИБЛИОТЕК:
- совместимость с Delphi 3 - Delphi 7 (преимущественно тестируется на Delphi 5);
- при подключении модулей в код EXE добавляются только те функции и объекты, которые реально вызываются в программе;
- динамическое подключение функций различных API, если они могут отсутствовать в Windows 95 или Windows NT, при этом для последних, по возможности, вызывается альтернативная функция, иногда недокументированная;
- все глобальные описания и объекты многопоточны или чаще создается отдельная копия глобального объекта в каждом потоке;
- библиотеки не требуют установки компонентов и прописывания путей в Delphi, при компиляции нет Warnings и Hints, публичные объекты и функции откомментированы на русском.


ПРИЛАГАЕТСЯ: UTILS.EXE. УТИЛИТА С ИНТЕРФЕЙСОМ И ПОДДЕРЖКОЙ КОМАНДНОЙ СТРОКИ И ЕЕ ИСХОДНИКИ НА DELPHI (ТРЕБУЮТ ALLLIB). ВЕРСИЯ ОТ 9.01.2006

Утилита и ее исходники: http://vstepanov78.narod.ru/utils.zip

Функции: графический просмотр и проигрывание файлов, блокнот с поддержкой шифрования, вывода оглавления; конвертация (Base64 и др.) и двоичный редактор файлов; просмотр, правка и экспорт в SQL-запросы значений полей базы данных, включая BLOB-поля; список запущенных процессов с корректным завершением; список активных окон по задачам; системная информация; запускаемые при старте Windows процессы; отправка и прием данных через серверный или клиентский сокет, включая двоичные данные, WhoIs, отправка почты; генерация ключей, запрос, издание и установка сертификатов, в том числе для сервера, для алгоритмов CryptoAPI RSA и Крипто-Про ГОСТ; шифрация и дешифрация, подпись и проверка ЭЦП для алгоритмов CryptoAPI RSA и Крипто-Про ГОСТ, а также Сигнал-КОМ Message-PRO, перепривязка секретного ключа от одного сертификата CryptoAPI к другому.

PM MAIL WWW   Вверх
Foley
Дата 21.2.2006, 00:53 (ссылка) |   (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Фсемба Яцца
*


Профиль
Группа: Участник
Сообщений: 235
Регистрация: 31.1.2006
Где: Россия, Арх.обл

Репутация: 2
Всего: 7



Мини - прога для расчета промежутка времени...


Присоединённый файл ( Кол-во скачиваний: 76 )
Присоединённый файл  raschet_vremeni.zip 9,07 Kb
PM MAIL ICQ   Вверх
CaNIBaLchik
Дата 1.3.2006, 11:24 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 48
Регистрация: 8.2.2006
Где: Томск

Репутация: нет
Всего: нет



Компилятор с подсветкой символов.

BDS2005

Компилятор паскаля
циклы
процидуры.
условные операторы
любая вложенность

реализован алгоритмом рекурсивный спуск, обратная польская строка

Присоединённый файл ( Кол-во скачиваний: 177 )
Присоединённый файл  Kompilyator.rar 88,16 Kb
PM MAIL ICQ   Вверх
Google
  Дата 19.7.2019, 08:47 (ссылка)  





  Вверх
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи


Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.

 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »


 




[ Время генерации скрипта: 0.1198 ]   [ Использовано запросов: 23 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.