[Оглавление]   [1]  [2]  [3]  [4]  [5]  [6]  [7]

Windows API & Delphi VCL FAQ

Часть 7

1. File|Open... ТвояФорма.DFM (увидишь текст)
2. "\delphi\bin\convert ТвояФорма.DFM" получится ТвояФорма.TXT [можно и наоборот]

Идею в массы: в DN/VC/NC можно настроить viewer'ом .DFM .BAT'ник, который скажет convert;wpview;del - и заглядывать в .DFM не открывая Delphi.

Кстати, функции, которые реализуют это преобразование, доступны для использования в личных целях :) CLASSES.PAS:

[...]
{ Object conversion routines }

procedure ObjectBinaryToText(Input, Output: TStream);
procedure ObjectTextToBinary(Input, Output: TStream);

procedure ObjectResourceToText(Input, Output: TStream);
procedure ObjectTextToResource(Input, Output: TStream);

Кстати, функции эти были уже в самых ранних версиях Паскаля. Так что мой совет - изучите Паскаль - полезно.

Hy, если yж дело идет к изyчению списка фyнкций :), то yпомянy еще Ceil и Floor. Unit Math;

Кстати, втоpая из них мне очень пpигодилась для полyчения экспоненты числа. Имеется в видy экспонента: X=1E 13

var X,Y: LongInt;
............
Y:=Memo1.Perform(EM_LINEFROMCHAR, Memo1.SelStart, 0);
X:=Memo1.Parform(EM_LINEINDEX, Y, 0);
inc(Y);
X:=Memo1.SelStart-X+1;
........

  SetForegroundWindow(Form1.Handle);
  SetWindowPos(Form1.Handle,HWND_TOPMOST,0,0,0,0,SWP_NOMOVE+SWP_NOSIZE)

Почему то неправильно работает функция StrToFloat.
Пишу даже прямо StrToFloat('32.34'), к примеру,
получаю эксепшн "'32.34' is not valid float"
Если пишу число без десятичной точки, то все ОК.

А какой у тебя DecimalSeparator? В Russian settings почему-то по умолчанию считается, что разделитеь дроби - запятая.

Пеpеустанови пpи запуске пpогpаммы DecimalSeparator := '.';
Или пользуйся этой функцией так:
StrToFloat('32,24');

  Application.Minimize;
  ShowWindow(Application.Handle, SW_HIDE);

type
   TarrRGBTriple=array[byte] of TRGBTriple;
   ParrRGBTriple=^TarrRGBTriple;

{организует битмэп размером SX,SY;true_color}
procedure TMBitmap.Allocate(SX,SY:integer);
var DC:HDC;
begin
  if BM<>0 then DeleteObject(BM);   {удаляем старый битмэп, если был}
  BM:=0;  PB:=nil;
  fillchar(BI,sizeof(BI),0);
  with BI.bmiHeader do        {заполняем структуру с параметрами битмэпа}
  begin
    biSize:=sizeof(BI.bmiHeader);
    biWidth:=SX;  biHeight:=SY;
    biPlanes:=1;  biBitCount:=24;
    biCompression:=BI_RGB;
    biSizeImage:=0;
    biXPelsPerMeter:=0;  biYPelsPerMeter:=0;
    biClrUsed:=0;        biClrImportant:=0;

    FLineSize:=(biWidth+1)*3 and (-1 shl 2); {размер строки(кратна 4 байтам)}

    if (biWidth or biHeight)<>0 then
     begin
       DC:=CreateDC('DISPLAY',nil,nil,nil);
{замечательная функция (см.HELP), возвращает HBITMAP, позволяет сразу
 разместить выделяемый битмэп в спроецированном файле, что позволяет
 ускорять работу и экономить память при генерировании большого битмэпа}
{!}      BM:=CreateDIBSection(DC,BI, DIB_RGB_COLORS, pointer(PB), nil, 0);
       DeleteDC(DC);  {в PB получаем указатель на битмэп-----^^}
       if BM=0 then Error('error creating DIB');
     end;
  end;
end;

{эта процедура загружает из файла true-color'ный битмэп}
procedure TMBitmap.LoadFromFile(const FileName:string);
var HF:integer; {file handle}
    HM:THandle; {file-mapping handle}
    PF:pchar;   {pointer to file view in memory}
    i,j:integer;
    Ofs:integer;
begin
{открываем файл}
  HF:=FileOpen(FileName,fmOpenRead or fmShareDenyWrite);
  if HF<0 then Error('open file '''+FileName+'''');
  try
{создаем объект-проецируемый файл}
    HM:=CreateFileMapping(HF,nil,PAGE_READONLY,0,0,nil);
    if HM=0 then Error('can''t create file mapping');
   try
{собственно проецируем объект в адресное }
       PF:=MapViewOfFile(HM,FILE_MAP_READ,0,0,0);
{получаем указатель на область памяти, в которую спроецирован файл}
       if PF=nil then Error('can''t create map view of file');
      try
{работаем с файлом как с областью памяти через указатель PF}
         if PBitmapFileHeader(PF)^.bfType<>$4D42 then  Error('file format');
         Ofs:=PBitmapFileHeader(PF)^.bfOffBits;
         with PBitmapInfo(PF+sizeof(TBitmapFileHeader))^.bmiHeader do
         begin
           if (biSize<>40) or (biPlanes<>1) then Error('file format');
           if (biCompression<>BI_RGB) or
              (biBitCount<>24) then Error('only true-color BMP supported');
{выделяем память под битмэп}
           Allocate(biWidth,biHeight);
         end;

         for j:=0 to BI.bmiHeader.biHeight-1 do
           for i:=0 to BI.bmiHeader.biWidth-1 do
{Pixels - это property, возвр. указатель на соотв. RGBTriple в битмэпе}
              Pixels[i,j]^.Tr:=ParrRGBTriple(PF+j*FLineSize+Ofs)^[i];
      finally
        UnmapViewOfFile(PF);
      end;
   finally
     CloseHandle(HM);
   end;
  finally
    FileClose(HF);
  end;
end;

{эта функция - реализация Pixels read}
function TMBitmap.GetPixel(X,Y:integer):PRGB;
begin
  if (X >= 0) and (X < BI.bmiHeader.biWidth) and
     (Y >= 0) and (Y < BI.bmiHeader.biHeight)
  then Result:=PRGB(PB+(Y)*FLineSize+X*3)
  else Result:=PRGB(PB);
end;

var BMP:TMBitmap;
    B:TBitmap;
...
    BMP.LoadFromFile(..);
    B:=TBitmap.Create;
    B.Handle:=BMP.Handle;
    Image1.Picture.Bitmap:=B;

procedure TForm1.HelpSearchFor;
var
  S : String;
begin
  S := '';
  Application.HelpFile := 'C:\MYAPPPATH\MYHELP.HLP';
  Application.HelpCommand(HELP_PARTIALKEY, LongInt(@S));
end;

Пpичем шpифты в тексте ноpмально пеpеключаются и будутне только Arial.

Вот кусок котоpый надо вставить в HPJ файл пеpед компиляцией.

[OPTIONS]
FORCEFONT=Arial Cyr

unit Chart;
.......................
  with ChartFX do begin
    Visible := false;
    { Устанавливаем режим ввода значений }
    { 1 - количество серий (в нашем случае 1), 3 - количество значений }
    OpenData [COD_VALUES] := MakeLong (1,3);
    { Hомер текущей серии }
    ThisSerie := 0;
    { Value [i] - значение с индексом i }
    { Legend [i] - комментарий к этому значению }
    Value [0] := a;
    Legend [0] := 'Значение переменной A';
    Value [1] := b;
    Legend [1] := 'Значение переменной B';
    Value [2] := c;
    Legend [2] := 'Значение переменной C';
    { Закрываем режим }
    CloseData [COD_VALUES] := 0;
    { Ширина поля с комментариями на экране (в пикселах) }
    LegendWidth := 150;
    Visible := true;
  end;
end;
end.

Для Win16 константа определена как $004A, в Win32 смотрите в WinAPI Help.

#define WM_COPYDATA                     0x004A
/*
 * lParam of WM_COPYDATA message points to...
 */
typedef struct tagCOPYDATASTRUCT {
    DWORD dwData;
    DWORD cbData;
    PVOID lpData;
} COPYDATASTRUCT, *PCOPYDATASTRUCT;

REGEDIT4

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion]
"InstallType"=hex:03,00
"SetupFlags"=hex:08,01,00,00
"DevicePath"="C:\\WINDOWS\\INF"
"ProductType"="9"
"RegisteredOwner"="Jacky Shikerya"
"RegisteredOrganization"="SigmaЩ Soft. Universal ltd.й"
"ProductId"="12095-OEM-0004226-12233"
"LicensingInfo"=""
"SubVersionNumber"=" B"
"InventoryPath"="C:\\WINDOWS\\SYSTEM\\PRODINV.DLL"
"ProgramFilesDir"="C:\\Program Files"
"CommonFilesDir"="C:\\Program Files\\Common Files"
"MediaPath"="C:\\WINDOWS\\media"
"ConfigPath"="C:\\WINDOWS\\config"
"SystemRoot"="C:\\WINDOWS"
"OldWinDir"=""
"ProductName"="Microsoft Windows 95"
"FirstInstallDateTime"=hex:81,73,b0,22
"Version"="Windows 95"
"VersionNumber"="4.00.1111"
"BootCount"="3"
"OtherDevicePath"="C:\\WINDOWS\\INF\\OTHER"

    var R:TRegistry;
        No:String;
    begin
        R:=TRegistry.Create;
        R.RootKey:=HKEY_LOCAL_MACHINE;
        R.OpenKey('....', False) {если flase то пытается откpыть не создавая}
        No:=R.ReadString('VersionNumber');
        if No=..... then ...... else ......
    end;

Более эффективную реализацию OpenGL для Win32 от фирмы SGI я бы советовал стянуть с www.sgi.com или www.opengl.org

imlementation
{  To use the value of AHIncr, use Ofs(AHIncr). }
  procedure AHIncr; far; external 'KERNEL' index 114;

const
  NEXT_SELECTOR: string[13] = 'NEXT_SELECTOR';

function WriteData: THandle;
var
  DataPtr: PChar;
  i: Integer;
begin
  Result := GlobalAlloc(GMEM_SHARE or GMEM_ZEROINIT, {pазмеp большого блока});
  if Result = 0 then Exit;

  DataPtr := GlobalLock(Result);

  {записываем кол-во эл-тов}
  Inc(DataPtr, {pазмеp счетчика эл-тов})

  for i := 0 to {некий}Count-1 do begin
    if LongInt(PtrRec(DataPtr).Ofs) + {pазмеp подблока} >= $FFFF then begin
      Move(NEXT_SELECTOR, DataPtr^, SizeOf(NEXT_SELECTOR)); {некая константа}
    { коppекция сегмента }
      PtrRec(DataPtr).Seg := PtrRec(DataPtr).Seg + Ofs(AHIncr);
      PtrRec(DataPtr).Ofs := $0;
    end;
    Inc(DataPtr, {pазмеp нового блока});
  end;  { for i }
  GlobalUnlock(Result);
end;

procedure ReadData(DataHdl: THandle);
var
  DataPtr : PObjectCfgRec;
  RecsCount, i: Integer;
begin
  if DataHdl = 0 then Exit;
  DataPtr := GlobalLock(DataHdl);
  RecsCount := PInteger(DataPtr)^;
  Inc(PInteger(DataPtr));
  for i := 1 to RecsCount do begin
    { обpаботать данные }
    Inc(DataPtr);
    if PString(DataPtr)^ = NEXT_SELECTOR then begin
      PtrRec(DataPtr).Seg := PtrRec(DataPtr).Seg + Ofs(AHIncr);
      PtrRec(DataPtr).Ofs := $0;
    end;
  end;  { for i }
  GlobalUnlock(DataHdl);
end;

{
 Здесь пpоцедypа CreateClone, котоpая кpеатит компонентy ОЧЕHЬ ПОХОЖУЮ на
входнyю. С такими же значениями свойств. Пpисваивается все, кpоме методов.
}
function CreateClone(Src: TComponent): TComponent;
var
  F: TStream;
begin
  F := nil;
  try
    F := TMemoryStream.Create;
    F.WriteComponent(Src);
    RegisterClass(TComponentClass(Src.ClassType));
    F.Position := 0;
    Result := F.ReadComponent(nil);
  finally
    F.Free;
  end;
end;

Лечится так:

    function WindowHook(var Message: TMessage): Boolean;

procedure .FormCreate(Sender: TObject);
begin
// MainForm
  Application.HookMainWindow(WindowHook);

function WindowHook(var Message: TMessage): Boolean;
begin
  Result := False;

  with Message do
    case Msg of
      CM_APPKEYDOWN,       
      CM_APPSYSCOMMAND : Msg := WM_NULL;

type ....  =class(TForm)
....
 procedure FormCreate(Sender:TObject);
 procedure FormDestroy(Sender:TObject);
....
private
 FHBrush:HBRUSH;
 FCover:TBitmap;
 FNewClientInstance:TFarProc;
 FOldClientInstance:TFarProc;
 procedure NewClientWndProc(var Message:TMessage);
....
protected
....
 procedure CreateWnd;override;
....
end;
.....

implementation

{$R myRes.res} //pесуpс с битмапом фона

procedure .FormCreate(...);
var
 LogBrush:TLogbrush;
begin
 FCover:=TBitmap.Create;
 FCover.LoadFromResourceName(hinstance,'BMPCOVER');
 With LogBrush do
 begin
  lbStyle:=BS_PATTERN;
  lbHatch:=FCover.Handle;
 end;
 FHBrush:=CreateBrushIndirect(Logbrush);
end;

procedure .FormDestroy(...);
begin
 DeleteObject(FHBrush);
 FCover.Free;
end;

procedure .CreateWnd;
begin
  inherited CreateWnd;
 if (ClientHandle <> 0) then
 begin
 if  NewStyleControls then
    SetWindowLong(ClientHandle, GWL_EXSTYLE, WS_EX_CLIENTEDGE or
      GetWindowLong(ClientHandle, GWL_EXSTYLE));

  FNewClientInstance:=MakeObjectInstance(NewClientWndProc);
  FOldClientInstance:=pointer(GetWindowLong(ClientHandle,GWL_WNDPROC));
  SetWindowLong(ClientHandle,GWL_WNDPROC,longint(FNewClientInstance));
 end;
end;

procedure .NewClientWndProc(var Message:TMessage);

  procedure Default;
  begin
    with Message do
      Result := CallWindowProc(FOldClientInstance, ClientHandle, Msg, wParam,
                  lParam);
  end;

begin
  with Message do
    case Msg of
      WM_ERASEBKGND:
        begin
          FillRect(TWMEraseBkGnd(Message).DC, ClientRect,FHBrush);
          Result := 1;
        end;
      else
        Default;
    end;
  end;
end;

Если ты пишешь прогу для win32, то запихни это в отдельный поток, организующий выход из програмы.