Секция 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