Шрифт:
Интервал:
Закладка:
begin
if Picture.Bitmap<>nil then begin
with Printer, Canvas do begin
Bits := Picture.Bitmap.Handle;
GetDIBSizes(Bits, InfoSize, ImageSize);
Info := AllocMem(InfoSize);
try
Image := AllocMem(ImageSize);
try
GetDIB(Bits, 0, Info^, Image^);
with Info^.bmiHeader do begin
DIBWidth := biWidth;
DIBHeight := biHeight;
end;
PrintWidth := DIBWidth;
PrintHeight := DIBHeight;
StretchDIBits(Canvas.Handle, aLeft, aTop, PrintWidth, PrintHeight, 0, 0, DIBWidth, DIBHeight, Image, Info^, DIB_RGB_COLORS, SRCCOPY);
finally
FreeMem(Image, ImageSize);
end;
finally
FreeMem(Info, InfoSize);
end;
end;
end;
end;
end;
В чем заключается идея PreView? Остается имея на руках Metafila, Bmp – отрисовать с пересчетом внешний вид изобpажения (надо высчитать левый верхний угол и размеpы «предварительно просматриваемого» изображения. Для показа изобpажения достаточно использовать StretchDraw.
После того, как удалось вывести объекты на печать, проблему создания PreView решили как «домашнее задание».
Кстати, когда мы работаем с Bmp, то для просмотра используем следующий хинт – записываем битовый образ через такую процедуру:
w:=MulDiv(Bmp.Width, GetDeviceCaps(Printer.Handle,LOGPIXELSX), Screen.PixelsPerInch);
h:=MulDiv(Bmp.Height, GetDeviceCaps(Printer.Handle,LOGPIXELSY), Screen.PixelsPerInch);
PrevBmp.Width:=w;
PrevBmp.Height:=h;
PrevBmp.Canvas.StretchDraw(Rect(0, 0, w, h),Bmp);
aPicture.Assign(PrevBmp);
Пpи этом масштабируется битовый образ с минимальными искажениями, а вот при печати – приходится bmp печатать именно так, как описано выше. Итог – наша bmp при печати чуть меньше, чем печатать ее через WinWord, но при этом – внешне – без каких-либо искажений и пр.
Imho, я для себя пpоблему печати pешил. Hа основе вышесказанного, сделал PreView для myStringGrid, где вывожу сложные многостpочные заголовки и пр. на несколько листов, осталось кое-что допилить, но с принтером у меня проблем не будет уже точно :)
PS. Кстати, Андрей Аристов на основе своей наработки сделал сложные геокарты, которые по качеству не хуже, а может, и лучше, чем выдает Surfer (специалисты поймут). Hа ватмат.
PPS. Прошу прощения за возможные стилистические неточности – время вышло, охрана уже ругается. Но код – выдран из работающих исходников.
Разное
Как в ATX корпусе программно выключить питание под DOS
Serj Kolesnikov рекомендует:
=== Cut ===
mov ax,5301h
sub bx,bx
int 15h
jc @@finish
mov ax,530Eh
sub bx,bx
mov cx,102h
int 15h
jc @@finish
mov ax,5307h
mov bx,1
mov cx,3
int 15h
@@finish:
int 20h
=== Cut ===
Операционная система
Буфер обмена
Как удобнее работать с буфером обмена как с последовательностью байт?
Из советов Nomadic'a:
Используя потоки —
unit ClipStrm;
{
This unit is Copyright (c) Alexey Mahotkin 1997-1998
and may be used freely for any purpose. Please mail
your comments to
E-Mail: [email protected]
FidoNet: Alexey Mahotkin, 2:5020/433
This unit was developed during incorporating of TP Lex/Yacc
into my project. Please visit ftp://ftp.nf.ru/pub/alexm
or FREQ FILES from 2:5020/433 or mail me to get hacked
version of TP Lex/Yacc which works under Delphi 2.0+.
}
interface uses Classes, Windows;
type TClipboardStream = class(TStream)
private
FMemory : pointer;
FSize : longint;
FPosition : longint;
FFormat : word;
public
constructor Create(fmt : word);
destructor Destroy; override;
function Read(var Buffer; Count : Longint) : Longint; override;
function Write(const Buffer; Count : Longint) : Longint; override;
function Seek(Offset : Longint; Origin : Word) : Longint; override;
end;
implementation uses SysUtils;
constructor TClipboardStream.Create(fmt : word);
var
tmp : pointer;
FHandle : THandle;
begin
FFormat := fmt;
OpenClipboard(0);
FHandle := GetClipboardData(FFormat);
FSize := GlobalSize(FHandle);
FMemory := AllocMem(FSize);
tmp := GlobalLock(FHandle);
MoveMemory(FMemory, tmp, FSize);
GlobalUnlock(FHandle);
FPosition := 0;
CloseClipboard;
end;
destructor TClipboardStream.Destroy;
begin
FreeMem(FMemory);
end;
function TClipboardStream.Read(var Buffer; Count : longint) : longint;
begin
if FPosition + Count > FSize then Result := FSize - FPosition
else Result := Count;
MoveMemory(@Buffer, PChar(FMemory) + FPosition, Result);
Inc(FPosition, Result);
end;
function TClipboardStream.Write(const Buffer; Count : longint) : longint;
var
FHandle : HGlobal;
tmp : pointer;
begin
ReallocMem(FMemory, FPosition + Count);
MoveMemory(PChar(FMemory) + FPosition, @Buffer, Count);
FPosition := FPosition + Count;
FSize := FPosition;
FHandle := GlobalAlloc(GMEM_MOVEABLE or GMEM_SHARE or GMEM_ZEROINIT, FSize);
try
tmp := GlobalLock(FHandle);
try
MoveMemory(tmp, FMemory, FSize);
OpenClipboard(0);
SetClipboardData(FFormat, FHandle);
finally
GlobalUnlock(FHandle);
end;
CloseClipboard;
except
GlobalFree(FHandle);
end;
Result := Count;
end;
function TClipboardStream.Seek(Offset : Longint; Origin : Word) : Longint;
begin
case Origin of
0 : FPosition := Offset;
1 : Inc(FPosition, Offset);
2 : FPosition := FSize + Offset;
end;
Result := FPosition;
end;
end.
Шрифты
Хранение стилей шрифта
Как мне сохранить свойство шрифта Style, ведь он же набор?
Вы можете получать и устанавливать FontStyle через его преобразование к типу byte.
Для примера,
Var Style: TFontStyles;
begin
{ Сохраняем стиль шрифта в байте }
Style := Canvas.Font.Style; {необходимо, поскольку Font.Style – свойство}
ByteValue := Byte(Style);
{ Преобразуем значение byte в TFontStyles }
Canvas.Font.Style := TFontStyles(ByteValue);
end;
Для восстановления шрифта, вам необходимо сохранить параметры Color, Name, Pitch, Style и Size в базе данных и назначить их соответствующим свойствам при загрузке.
– Robert Wittig
Управление настройками шрифта
Delphi 1
{
Данный код изменяет стиль шрифта поля редактирования,
если оно выбрано. Может быть адаприрован для управления
шрифтами в других объектах.
Расположите на форме Edit(Edit1) и ListBox(ListBox1).
Добавьте следующие элементы (Items) к ListBox:
fsBold
fsItalic
fsUnderLine
fsStrikeOut
}
procedure TForm1.ListBox1Click(Sender: TObject);
var X: Integer;
type TLookUpRec = record
Name: String;
Data: TFontStyle;
end;
const LookUpTable: array[1..4] of TLookUpRec = (
(Name: 'fsBold'; Data: fsBold),
(Name: 'fsItalic'; Data: fsItalic),
(Name: 'fsUnderline'; Data: fsUnderline),
(Name: 'fsStrikeOut'; Data: fsStrikeOut));
begin
X := ListBox1.ItemIndex;
Edit1.Text := ListBox1.Items[X];
Edit1.Font.Style := [LookUpTable[ListBox1.ItemIndex+1].Data];
end;
Перетащи и брось (Drag and Drop)
Как получить список файлов, которые были перенесены на мою форму, например, из Проводника?
Из советов Nomadic'a:
Развлекался когда-то — вот, осталось:
unit Unit1;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ShellAPI, Grids, StdCtrls;
- Python для детей. Анимация с черепашьей графикой - Виктор Рабинович - Прочая детская литература / Программирование
- Программист-фанатик - Чед Фаулер - Программирование
- Эффективное использование STL - Скотт Мейерс - Программирование
- Как функции, не являющиеся методами, улучшают инкапсуляцию - Скотт Мейерс - Программирование
- Как я делаю мультфильмы - Андрей Шумин - Прочая научная литература / Прочее / Программирование
- Программирование - Ирина Козлова - Программирование
- Программирование на языке Пролог для искусственного интеллекта - Иван Братко - Программирование
- Новое в зарплатном учете в 2023 году: лайфхаки бухгалтера в 1С - Компания СервисКлауд - Программирование / Финансы
- ВСТУП ДО ІНЖЕНЕРІЇ ПРОГРАМНОГО ЗАБЕЗПЕЧЕННЯ - М. Сидоров - Программирование