Path - Поиск - Библиотека программиста

Поиск

Поочередно показываем рисунки

Дата: 22.02.2025 Модуль: Категория: Delphi и TurboPascal

У нас ест форма, на ней Image1 и Timer1, и на диске в одной папке содержатся рисунки. Попытаемся поочередно показывать эти рисунки в image1,

Код

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
Timer1: TTimer;
foto: TListBox;
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1; i:word;

implementation

uses ShellAPI, ShlObj;// Нужны для работы с диалогом выбора
{$R *.dfm}

procedure FillBMPFileList(Folder: string; sl: TStrings);// процедура добавления файлов в список
var Rec : TSearchRec;
begin
sl.Clear;
if SysUtils.FindFirst(Folder + '*.bmp', faAnyFile, Rec) = 0 then
try
repeat
sl.Add(Folder+Rec.Name);
until SysUtils.FindNext(Rec) <> 0;
finally
SysUtils.FindClose(Rec);
end;
end;

function BrowseDialog(const Title: string; const Flag: integer): string;// вывод диалога выбора файлов
var
lpItemID : PItemIDList;
BrowseInfo : TBrowseInfo;
DisplayName : array[0..MAX_PATH] of char;
TempPath : array[0..MAX_PATH] of char;
begin
Result:='';
FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
with BrowseInfo do begin
hwndOwner := form1.Handle;
pszDisplayName := @DisplayName;
lpszTitle := PChar(Title);
ulFlags := Flag;
end;
lpItemID := SHBrowseForFolder(BrowseInfo);
if lpItemId <> nil then begin
SHGetPathFromIDList(lpItemID, TempPath);
Result := IncludeTrailingBackslash(TempPath);
GlobalFreePtr(lpItemID);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);// запуск ункции вывода файлов
var fs : string;
begin
fs := BrowseDialog('Выберите папку с BMP файлами', BIF_RETURNONLYFSDIRS);
if fs = '' then Exit;
FillBMPFileList(fs, foto.Items);
timer1.Enabled:=true
end;

procedure TForm1.Timer1Timer(Sender: TObject);// вывод картинок на image
begin
if i= foto.Count-1 then exit;
image1.Picture.LoadFromFile(foto.Items.strings[i]);
inc(i);
end;

end

Разместил: admin Смотрим и оставляем комментарий »

Получить список директорий или файлов в каталоге

Дата: 22.02.2025 Модуль: Категория: PHP

Разместил: admin Смотрим и оставляем комментарий »

Список портов и их сервисов

Дата: 22.02.2025 Модуль: Категория: Сети и протоколы

Разместил: admin Смотрим и оставляем комментарий »

Протоколы обмена маршрутной информацией стека TCP/IP

Дата: 22.02.2025 Модуль: Категория: Сети и протоколы

Разместил: admin Смотрим и оставляем комментарий »

Стек протоколов TCP/IP

Дата: 22.02.2025 Модуль: Категория: Сети и протоколы

Разместил: admin Смотрим и оставляем комментарий »

Настройка BDE - как это делается

Дата: 22.02.2025 Модуль: Категория: Delphi и TurboPascal

Разместил: admin Смотрим и оставляем комментарий »

Преобразование ICO в BMP и наоборот

Дата: 22.02.2025 Модуль: Категория: Delphi и TurboPascal

Сегодня речь пойдет о том, как преобразовать иконку в растровое изображение и о том, как из растрового изображения сделать иконку. Описанные ниже методы помогут вам разобраться с реализацией данного вопроса.

Решение 1

Код

var
Icon : TIcon;
Bitmap : TBitmap;
begin
Icon := TIcon.Create;
Bitmap := TBitmap.Create;
Icon.LoadFromFile('c:picture.ico');
Bitmap.Width := Icon.Width;
Bitmap.Height := Icon.Height;
Bitmap.Canvas.Draw(0, 0, Icon);
Bitmap.SaveToFile('c:picture.bmp');
Icon.Free;
Bitmap.Free;
end;

Решение 2

Способ преобразования изображения размером 32x32 в иконку.

Код

unit main;

interface

uses

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

type

TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
Image2: TImage;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var winDC, srcdc, destdc : HDC;

oldBitmap : HBitmap;
iinfo : TICONINFO;
begin

GetIconInfo(Image1.Picture.Icon.Handle, iinfo);

WinDC := getDC(handle);
srcDC := CreateCompatibleDC(WinDC);
destDC := CreateCompatibleDC(WinDC);
oldBitmap := SelectObject(destDC, iinfo.hbmColor);
oldBitmap := SelectObject(srcDC, iinfo.hbmMask);

BitBlt(destdc, 0, 0, Image1.picture.icon.width,
Image1.picture.icon.height,
srcdc, 0, 0, SRCPAINT);
Image2.picture.bitmap.handle := SelectObject(destDC, oldBitmap);
DC(destDC);
DC(srcDC);
DC(WinDC);

image2.Picture.Bitmap.savetofile(ExtractFilePath(Application.ExeName)
+ 'myfile.bmp');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin

image1.picture.icon.loadfromfile('c:myicon.ico');
end;

end.

Разместил: admin Смотрим и оставляем комментарий »

Всего 22 на 2 страницах по 15 на каждой странице

<< 1 2

[ Назад | Начало | Наверх ]

Внимание! Если у вас не получилось найти нужную информацию, используйте рубрикатор или воспользуйтесь поиском