Отправляет email-рассылки с помощью сервиса Sendsay

KLSoft company - программирование в Delphi и PHP

Рассылка закрыта

При закрытии подписчики были переданы в рассылку "Веб-разработка: пособие начинающим" на которую и рекомендуем вам подписаться.

Вы можете найти рассылки сходной тематики в Каталоге рассылок.

←   Декабрь 2004   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Автор
ADMIN

Статистика

989 подписчиков
0 за неделю
←   Все выпуски   →

X-Program ПО, новости сайта и программирование в Delphi7


Информационный Канал Subscribe.Ru
 

Выпуск №26

О нас:
www.X-Program.narod.ru (Наш сайт. Последнее обновление - 12.12.2004);
http://xbase.banerka.ru/?xprogram (Наша гостевая книга);
http://narod.yandex.ru/userforum/?owner=x-program (Наш форум по Delpi7)
X-Program@narod. ru (Наш EMail. Присылайте свои вопросы).
http://www.delphi-faq.fatal.ru (Сайт наших друзей)
Привет подписчики! Почему не было вопросов и ответов на вопросы за прошлый выпуск? Или вам стало не интересно? Тогда примите участие в создании следующих трёх выпусков рассылки! Мы решили посвятить следующие три выпуска  какой-то одной теме каждый! Присылайте свои темы которые вы бы хотели увидеть в нашей рассылке. В письме укажите тему, которую вы бы хотели увидеть, адрес вашего сайта(если есть) и пожелания нам(если есть :))  

Отправить тему          

Привет всем подписчикам. Спасибо за ваши вопросы, которых кстати приходит довольно много. Мы не можем размещать все вопросы в одной рассылке долгое время. Поэтому мы решили открыть страницу в internet, с вашими вопросами и ответами конечно! Вот её адрес http://www.x-program.narod.ru/vopros.html. Заходите, будем рады! Только страница пока некрасивая :)                            

Голосование

Как вы относитесь к нашей рассылке?

Супер!

Нормально.

Удовлитворительно.

Плохо.

Результаты 

Сегодня в выпуске:
1 - Вопросы подписчиков
2 - Как заставить Рабочий Стол обновится
3 - Визуализация нажатия кнопки
4 - Изменить цвет TButton
5 - Как добавить горизонтальную полосу прокрутки в TListBox
6 - Пример TWriter и TReader
Вопросы подписчиков

Вопрос №1 [MagicSasha]

Здарово челы. Как рисунки JPG засунуть в DLL, а потом использовать в Delphi. И еще как сохранить параметры о цветах в ini файл.
[Ответить]

Ответ №1 [X-Program]

Привет чел:)
Все очень просто. Берём любую програму для работы с ресурсами. Я взял Restorator (в Internet много взломов для него).
Создаём библиотеку в Delphi. Потом открываем эту библиотеку Restoratorом и суём туда BMP(BMP так как я не знаю ак загружать JPG) файлы.
В Delphi в библиотеке пишем следйший код.

procedure JPG;
var
bit:TBitmap;
begin
bit:=TBitmap.Create;
bit.LoadFromResourceName(HInstance,'Bitmap');//Вроде так. Bitmap- это папка в которую ты в ресурсах засунул BMP.
end;
 
Как заставить Рабочий Стол обновится

procedure RefreshDesktop;
var
hDesktop: HWND;
begin
hDesktop := FindWindowEx(FindWindowEx(
FindWindow('Progman', 'Program Manager'), 0,
'SHELLDLL_DefView', ''), 0, 'SysListView32', '');
PostMessage(hDesktop, WM_KEYDOWN, VK_F5, 0);
PostMessage(hDesktop, WM_KEYUP, VK_F5, 1 shl 31);
end;  

Визуализация нажатия кнопки

Я знаю как нажать кнопку через keypress, но хотя пользователь определил действие в обработчике события OnClick, сама кнопка не отражает видимых изменений, происходящих при ее нажатии мышью. Кто-нибудь может мне помочь? 
Вы можете сделать кнопку "нажатой" или "ненажатой", посылая ей сообщение BM_SETSTATE. Определить ее текущее состояние можно, послав ей сообщение BM_GETSTATE. 
Для нажатия кнопки:
Button1.Perform( BM_SETSTATE, 1, 0 );
Для отжатия кнопки:
Button1.Perform( BM_SETSTATE, 0, 0 );
Чтобы обнаружить нажатие кнопки:
ButtonPressed := Button1.Perform( BM_GETSTATE, 0, 0 ) = 1; 

Изменить цвет TButton

unit ColorButton; 

interface 

uses 
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
StdCtrls, Buttons, ExtCtrls; 

type 
TDrawButtonEvent = procedure(Control: TWinControl; 
Rect: TRect; State: TOwnerDrawState) of object; 

TColorButton = class(TButton) 
private 
FCanvas: TCanvas; 
IsFocused: Boolean; 
FOnDrawButton: TDrawButtonEvent; 
protected 
procedure CreateParams(var Params: TCreateParams); override; 
procedure SetButtonStyle(ADefault: Boolean); override; 
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED; 
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; 
procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM; 
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM; 
procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK; 
procedure DrawButton(Rect: TRect; State: UINT); 
public 
constructor Create(AOwner: TComponent); override; 
destructor Destroy; override; 
property Canvas: TCanvas read FCanvas; 
published 
property OnDrawButton: TDrawButtonEvent read FOnDrawButton write FOnDrawButton; 
property Color; 
end; 

procedure Register; 

implementation 

procedure Register; 
begin 
RegisterComponents('Samples', [TColorButton]); 
end; 

constructor TColorButton.Create(AOwner: TComponent); 
begin 
inherited Create(AOwner); 
FCanvas := TCanvas.Create; 
end; 

destructor TColorButton.Destroy; 
begin 
inherited Destroy; 
FCanvas.Free; 
end; 

procedure TColorButton.CreateParams(var Params: TCreateParams); 
begin 
inherited CreateParams(Params); 
with Params do Style := Style or BS_OWNERDRAW; 
end; 

procedure TColorButton.SetButtonStyle(ADefault: Boolean); 
begin 
if ADefault <> IsFocused then 
begin 
IsFocused := ADefault; 
Refresh; 
end; 
end; 

procedure TColorButton.CNMeasureItem(var Message: TWMMeasureItem); 
begin 
with Message.MeasureItemStruct^ do 
begin 
itemWidth := Width; 
itemHeight := Height; 
end; 
end; 

procedure TColorButton.CNDrawItem(var Message: TWMDrawItem); 
var 
SaveIndex: Integer; 
begin 
with Message.DrawItemStruct^ do 
begin 
SaveIndex := SaveDC(hDC); 
FCanvas.Lock; 
try 
FCanvas.Handle := hDC; 
FCanvas.Font := Font; 
FCanvas.Brush := Brush; 
DrawButton(rcItem, itemState); 
finally 
FCanvas.Handle := 0; 
FCanvas.Unlock; 
RestoreDC(hDC, SaveIndex); 
end; 
end; 
Message.Result := 1; 
end; 

procedure TColorButton.CMEnabledChanged(var Message: TMessage); 
begin 
inherited; 
Invalidate; 
end; 

procedure TColorButton.CMFontChanged(var Message: TMessage); 
begin 
inherited; 
Invalidate; 
end; 

procedure TColorButton.WMLButtonDblClk(var Message: TWMLButtonDblClk); 
begin 
Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos)); 
end; 

procedure TColorButton.DrawButton(Rect: TRect; State: UINT); 
var 
Flags, OldMode: Longint; 
IsDown, IsDefault, IsDisabled: Boolean; 
OldColor: TColor; 
OrgRect: TRect; 
begin 
OrgRect := Rect; 
Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT; 
IsDown := State and ODS_SELECTED <> 0; 
IsDefault := State and ODS_FOCUS <> 0; 
IsDisabled := State and ODS_DISABLED <> 0; 

if IsDown then Flags := Flags or DFCS_PUSHED; 
if IsDisabled then Flags := Flags or DFCS_INACTIVE; 

if IsFocused or IsDefault then 
begin 
FCanvas.Pen.Color := clWindowFrame; 
FCanvas.Pen.Width := 1; 
FCanvas.Brush.Style := bsClear; 
FCanvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom); 
InflateRect(Rect, - 1, - 1); 
end; 

if IsDown then 
begin 
FCanvas.Pen.Color := clBtnShadow; 
FCanvas.Pen.Width := 1; 
FCanvas.Brush.Color := clBtnFace; 
FCanvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom); 
InflateRect(Rect, - 1, - 1); 
end 
else 
DrawFrameControl(FCanvas.Handle, Rect, DFC_BUTTON, Flags); 

if IsDown then OffsetRect(Rect, 1, 1); 

OldColor := FCanvas.Brush.Color; 
FCanvas.Brush.Color := Color; 
FCanvas.FillRect(Rect); 
FCanvas.Brush.Color := OldColor; 
OldMode := SetBkMode(FCanvas.Handle, TRANSPARENT); 
FCanvas.Font.Color := clBtnText; 
if IsDisabled then 
DrawState(FCanvas.Handle, FCanvas.Brush.Handle, nil, Integer(Caption), 0, 
((Rect.Right - Rect.Left) - FCanvas.TextWidth(Caption)) div 2, 
((Rect.Bottom - Rect.Top) - FCanvas.TextHeight(Caption)) div 2, 
0, 0, DST_TEXT or DSS_DISABLED) 
else 
DrawText(FCanvas.Handle, PChar(Caption), - 1, Rect, 
DT_SINGLELINE or DT_CENTER or DT_VCENTER); 
SetBkMode(FCanvas.Handle, OldMode); 

if Assigned(FOnDrawButton) then 
FOnDrawButton(Self, Rect, TOwnerDrawState(LongRec(State).Lo)); 

if IsFocused and IsDefault then 
begin 
Rect := OrgRect; 
InflateRect(Rect, - 4, - 4); 
FCanvas.Pen.Color := clWindowFrame; 
FCanvas.Brush.Color := clBtnFace; 
DrawFocusRect(FCanvas.Handle, Rect); 
end; 
end; 
end.

 
Как добавить горизонтальную полосу прокрутки в TListBox

Компонент VCL TListBox автоматически реализует вертикальную полосу прокрутки. Полоска прокрутки появляется, когда окно списка слишком мало для показа всех элементов списка. Однако окно списка не показывает горизонтальной полосы прокрутки, когда какие-либо элементы списка имеют большую ширину, чем само окно списка. Конечно, есть возможность добавить горизонтальную полосу прокрутки. Добавьте следующий код в обработчик события OnCreate Вашей формы: 
procedure TForm1.FormCreate(Sender: TObject);
var
i, MaxWidth: integer;
begin
MaxWidth := 0;
for i := 0 to ListBox1.Items.Count - 1 do
if MaxWidth < ListBox1.Canvas.TextWidth(ListBox1.Items.Strings[i]) then
MaxWidth := ListBox1.Canvas.TextWidth(ListBox1.Items.Strings[i]);
SendMessage(ListBox1.Handle, LB_SETHORIZONTALEXTENT, MaxWidth+2, 0);
end;
Этот код находит ширину, в пикселах, самой длинной строки в окне списка. Затем он использует сообщение LB_SETHORIZONTALEXTENT для установки горизонтальной прокручиваемой ширины, в пикселах, для окна списка. Два дополнительных пиксела добавлены к MaxWidth, чтобы сдвинуть оконечные символы от правой границы окна списка. 

 
Пример TWriter и TReader

Вот что вы должны cделать для того, чтобы с помощью TWriter/TReader записать строку в поток. До сих пор для простоты я использую TMemoryStream. 
Ключевыми являются вызовы Read/WriteListBegin и Read/WriteListEnd. Без них вы получите исключение.
procedure TForm1.Button1Click(Sender: TObject);
var
sWrite, sRead: string[25];

MyStream: TMemoryStream;
MyWriter: TWriter;
MyReader: TReader;
begin

MyStream := TMemoryStream.Create;
MyStream.SetSize(4096);
MyWriter := TWriter.Create(MyStream, 4096);
sWrite := 'sWriteContents';

MyWriter.WriteListBegin;
MyWriter.WriteString(sWrite);
MyWriter.WriteListEnd;
MyWriter.free;

MyStream.Seek(0, 0);

MyReader := TReader.Create(MyStream, 4096);
MyReader.ReadListBegin;
sRead := MyReader.ReadString;
MyReader.ReadListEnd;
MyReader.free;

Label1.Caption := sRead;
MyStream.free;
end;

 
Дизайнер рассылки Андрей Ерёмин < =>  Редактор рассылки Коржов Алексей

 

http://subscribe.ru/
http://subscribe.ru/feedback/		 Подписан адрес:
Код этой рассылки: comp.soft.prog.program		 Отписаться
В избранное