Секция 8 из 8 - Предыдущая - Следующая
Все секции - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8

       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;
------------------------------------------------------------------
Если у вас на форме есть компонент TImage, то можно сделать так:

var BMP:TMBitmap;
    B:TBitmap;
...
    BMP.LoadFromFile(..);
    B:=TBitmap.Create;
    B.Handle:=BMP.Handle;
    Image1.Picture.Bitmap:=B;
и загруженный битмэп появится на экране.

Author>:
Alexander Burnashov
E-mail alex@arta.spb.su
(2:5030/254.36)
.

Q>:
Как сделать так, чтобы по нажатию F1 на экране появлялось небольшое окошко
с подсказкой?
A>:
WinProcs.function WinHelp(Wnd: HWnd; HelpFile: PChar; Command: Word; DatA>:
LongInt): Bool;

HELP_CONTEXTPOPUP
An unsigned long integer containing the context number for a topic.
Displays in a pop-up window a particular Help topic identified by a context
number that has been defined in the [MAP] section of the  .HPJ file.

Author>:
Александр Петросян, Зеленоград.
(2:5020/468.8)
.

Q>:
Захотелось тут сделать так, чтобы в приложении вызывался хелп
с окошечком для поиска раздела. Ну короче макрос "Search()" для WinHelp-а.
A>:
procedure TForm1.HelpSearchFor;
var
  S : String;
begin
  S := '';
  Application.HelpFile := 'C:\MYAPPPATH\MYHELP.HLP';
  Application.HelpCommand(HELP_PARTIALKEY, LongInt(@S));
end;

Author>:
Konstantin Kipa
2:5061/19.17
kotya@extranet.ru
.

Q>:
Как заставить Help-файлы нормально отображать русский под Windows 3.x?
A>:
Удалось вылечить дописыванием в файл пpоекта в гpафу Options
стpочки FORCEFONT=Arial Cyr
пpичем HC31 pугается что нет такого шpифта, но зато хелп потом
ноpмально показывается на пpактически под любой pуссифициpованной виндой.
пpовеpял с [Win31+CyrWin] [Win311Rus] [Win95PE] [Win95Rus].
на NT не пpовеpял.
Пpичем шpифты в тексте ноpмально пеpеключаются и будутне только  Arial.

Вот кусок котоpый надо вставить в HPJ файл пеpед компиляцией.
==================
[OPTIONS]
FORCEFONT=Arial Cyr
==================

Author>:
Andrey Kalmykov
(2:5030/172.36)
.

Q>:
Расскажите, please, как использовать ChartFX.
Лyчше на пpостеньком пpимеpе.
A>:
=== Cut ===
unit Chart;
.......................
  with ChartFX do begin
    Visible := false;
    { Устанавливаем режим ввода значений }
    { 1 - количество серий (в нашем случае 1), 3 - количество значений }
    OpenData [COD_VALUES] := MakeLong (1,3);
    { Номер текущей серии }
    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.
=== Cut ===

Author>:
Alex Semibratov
(2:5050/19.9)
.

Q>:
Подскажите способ обмена информацией между приложениями Win32 - Win16.
A>:
Пользуйтесь сообщением WM_COPYDATA.
Для 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;

Author>:
Alexey A Popoff
(2:5020/487.26)
pvax@glas.apc.org
posp@ccas.ru
http://www.ccas.ru/~posp/popov/pvax.html
.

Q>:
Как из программы выявить версию Windows, на кого зарегистрирована и т. п.?
A>:
    Вот тебе кyсочек Windows Registry, pазбиpайся:

=== Cut here! [a.reg] ===
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"
=== And cut Here!(or there?!) [a.reg] ===
    В uses пpописываеш юнитy Registry и дальше так:
    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;

Author>:
Jacky Shikerya
(2:466/101.15)
.

Q>:
Можно ли запустить OpenGL под Windows'95, и как поставлять его с программой?
A>:
Беpешь, к пpимеpy, из диcтpибyтива OSR2 GLU32.DLL и OPENGL32.DLL - и запycкай
на здоpовье.

Author>:
Alexei Ivanov
(2:5020/942.1)

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

Author>:
Akzhan Abdulin
(2:5040/55)
.

Q>:
[Win16] Как работать с блоками памяти размером более 64K.
A>:
--------------------------------------------------------------------
Так можно помещать в один блок памяти записи из TList (TCollection):
--------------------------------------------------------------------
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;

Author>:
Dmitry Romanovsky
(2:5080/76.9)
.

Q>:
Как создать клон (копию, достаточно близкую к оригиналу)
произвольного компонента?
A>:
{
 Здесь пpоцедypа CreateClone, котоpая кpеатит компонентy ОЧЕНЬ ПОХОЖУЮ на
входн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;

Author>:
Vladimir Gaitanoff
(2:5020/880.5)
.

Q>:
Как сказать VCL, чтобы клавиши shortcut пунктов главного меню главной формы
действовали только в этой форме (но не в модальных окнах, к примеру)?
A>:
Знакомая проблема.
Лечится так:

    function WindowHook(var Message: TMessage): Boolean;

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

function .WindowHook;
begin
  Result := False;

  with Message do
    case Msg of
      CM_APPKEYDOWN{??????? ??????? .MainMenu ???????? ?? _????_ ??????.
?????!},       CM_APPSYSCOMMAND{????? .MainMenu ?? ?????? ????. ?????!}: Msg :=
WM_NULL;

Author>:
Александр Петросян, Зеленоград.
(2:5020/468.8)
.

Q>:
Как задать в качестве фона MDIForm картинку из TBitmap?
A>:
Я делал так:

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;

Author>:
Alex Miachin
(2:5000/81.12)
.

Q>:
Где найти описание формата файлов *.RTF?
A>:
Это довольно здоровый файл. Прилагается к последним ftsc-all.z93. Файл
называется fsc-0079.z02, топик rtf-mail. Ищи на http://www.blaze.net.auftsc

Author>:
Stas Mehanoshin
(2:5030/143.23)
.

Q>:
[Win32] Как вывести на экран путь файла с "красивым" обрезанием по длине?
A>:
DrawTextEx; dwDTFormat = DT_PATH_ELLIPSIS

Author>:
Pavel Victoroff
(2:5030/219.2)
.

Q>:
Как корректно перехватить сигнал выгрузки операционной системы, если
в моей программе нет окна?
A>:
Используй GetMessage(), в качестве HWND окна пиши NULL.
Если в очереде сообщений следущее WM_QUIT, то функция фозвращает FALSE.

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

Author>:
Alex Soloviev
(2:5047/14.20)
.

Q>:
Где можно взглянуть на пример мемо-редактора с возможностью
строк разного цвета?
A>:
http://www1.omnitel.net/proga/cmemo10.zip

Author>:
Alexander Petrosyan
(2:5020/468.8)
.

Секция 8 из 8 - Предыдущая - Следующая

© faqs.org.ru