Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2002.08.05;
Скачать: [xml.tar.bz2];

Вниз

Помогите. Проблеммы с переводом программы из DOS в Windows   Найти похожие ветки 

 
Cosinus   (2002-07-23 13:15) [0]

УВАЖАЕМЫЕ ГОСПОДА.
У меня есть законченная программа под ДОС, которая работает следующим образом: имеется некоторое количество графических файлов, размером 1xN пикселей, с двумя цветами(черный и красный). Программа их открывает и смотрит цвет пикселя в каждом файле на n-ом месте. Если цвет красный, то 1, в противном случае - 0. Далее она делит файлы по 8 и из получившегося двоичного числа(представьте себе эти 8 графических файлов один под другим, замените цвет на boolean и смотрите по столбцам) делает hex и записывает результат в свежесозданный имя.hex файл. Проблемма в том, что при попытке переписать его под делфи образуется какое то непонятное число(где то поганая единичка что ли вылезает?) в начале каждого цикла. Причем, что интересно, если программу запустить три раза в подряд то они(паразитные числа) разные, дальше опять повторяются.Не подскажите, может быть что то обнулять надо? Заранее благодарен, Владислав.


 
MBo   (2002-07-23 13:20) [1]

вероятно, кое-где надо подправить, кое-что обнулить, кое-какие переменные инициализировать ;)

Сам бы без кода ответил?


 
cosinus   (2002-07-23 13:32) [2]

2MBo
Да уж очень он здоров, но я попробую вычленить ...


 
Tangens   (2002-07-23 13:39) [3]

Могу помочь, видя код...


 
cosinus   (2002-07-23 13:43) [4]

Ну вот, вроде того:

interface

uses
SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs,
Menus,INFO, ExtCtrls, StdCtrls, Gauges;

type
matrix = array [1..32,1..7] of byte;
matrix1 = array [1..32,1..8] of byte;
matrix2 = array [1..32,1..8] of byte;
TForm1 = class(TForm)
MainMenu1: TMainMenu;
FileMen: TMenuItem;
OpenMen: TMenuItem;
SaveAsMen: TMenuItem;
ConvertMen: TMenuItem;
ExitMen: TMenuItem;
ParametersMen: TMenuItem;
HelpMen: TMenuItem;
ExitMen1: TMenuItem;
AboutMen: TMenuItem;
od: TOpenDialog;
sd: TSaveDialog;
cb1: TComboBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
openbutton: TButton;
savebutton: TButton;
convertbutton: TButton;
G1: TGauge;
Image1: TImage;
Image2: TImage;
Image5: TImage;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
procedure check;
procedure main1;
procedure main2;
procedure main3;
procedure matrtobin1;
procedure matrtobin2;
procedure matrtobin3;
procedure fillmatrix;
procedure convertfilecreate;
procedure ExitMenClick(Sender: TObject);
procedure ExitMen1Click(Sender: TObject);
procedure OpenMenClick(Sender: TObject);
procedure SaveAsMenClick(Sender: TObject);
procedure AboutMenClick(Sender: TObject);
procedure cb1Click(Sender: TObject);
procedure ConvertMenClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormDeactivate(Sender: TObject);
procedure N1Click(Sender: TObject);

private

public
convertfile:file of byte;
convertfile1:file of byte;
convertfile2:file of byte;
graphfile:file of byte;
channelamount : integer;
size:longint;
pixamount:integer;
pixamountfrac:real;
matr7:matrix;
matr15:matrix1;
matr23:matrix2;
i,k:byte;
champ1:byte;
champ2:byte;
champ3:byte;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.check;
var
i:byte;
warn1:string;
grfile:string;
begin
i:=1;
channelamount:=strtoint(cb1.text);
for i:=1 to channelamount do
begin
grfile:=copy(od.filename,1,length(od.filename)-5) + inttostr(i) + ".bmp";

procedure TForm1.cb1Click(Sender: TObject);
begin
check;
end;



 
cosinus   (2002-07-23 13:44) [5]

Сорри, все не влезло

procedure tform1.matrtobin1;
var
convertbyte: byte;
kl:byte;
i:byte;
l:byte;
QQ:STRING;
begin
for i:=1 to 32 do
begin
for l:=1 to 7 do
begin
case l of
1:kl:=1;
2:kl:=2;
3:kl:=4;
4:kl:=8;
5:kl:=16;
6:kl:=32;
7:kl:=64;
end;
convertbyte:=(convertbyte+matr7[i,l]*kl) or 128;
qq:="i=" + inttostr(i) + " L=" + inttostr(l) + " MATR[I,L]=" + INTTOSTR(MATR7[I,L]) + " KL=" + inttostr(kl) + " CONVERTBYTE=" + inttostr(convertbyte);
end;
write(convertfile,convertbyte);
convertbyte:=0;
end;
end;

procedure tform1.fillmatrix;
var
j:byte;
g:byte;
begin
for j:=1 to 32 do
begin
for g:=1 to 7 do
matr7[j,g]:=1;
for g:=1 to 8 do
begin
matr15[j,g]:=1;
matr23[j,g]:=1;
end;
end;
end;

procedure tform1.main1;
var
posish:longint;
buff:byte;
i:byte;
k:byte;
grfile:string;
brtn:integer;
begin
posish:=56;
while posish<size do
begin
for k:=1 to champ1{strtoint(cb1.text)} do
begin
g1.progress:=g1.progress+1;
grfile:=copy(od.filename,1,length(od.filename)-5) + inttostr(k) + ".bmp";
assignfile(graphfile,grfile);
reset(graphfile);
seek(graphfile,posish);
read(graphfile,buff);
brtn:=round(buff/8);
for i:=1 to brtn do
begin
matr7[i,k]:=1;
end;
for i:=brtn+1 to 32 do
begin
matr7[i,k]:=0;
end;
closefile(graphfile);
end;
matrtobin1;
inc(posish,3);
end;
closefile(convertfile);
end;

procedure TForm1.ConvertMenClick(Sender: TObject);
var
channelamount:byte;
begin

check;
g1.maxvalue:=champ1*(size-54) div 3;
convertbutton.enabled:=false;
cursor:=crhourglass;
channelamount:=strtoint(cb1.text);
fillmatrix;
g1.progress:=g1.progress+1;
convertfilecreate;
g1.progress:=g1.progress+1;
if channelamount>16 then main3;
if channelamount>7 then main2;
main1;
cursor:=crdefault;
g1.progress:=0;

{ Image1.Picture.LoadFromFile("c:\conv2.bmp");
Image1.Show;}

end;
if FileExists(grfile)=false then
begin
warn1:="Отсутствует файл для " + inttostr(i) + " канала. Проверьте правильность выбора количества каналов";
MessageDlg(warn1, mtwarning,[mbOk], 0);
exit;
end;
if (channelamount>=1) and (channelamount<=7) then champ1:=channelamount else champ1:=7;
if (channelamount>=8) and (channelamount<=15) then champ2:=channelamount else champ2:=15;
if (channelamount>=16) and (channelamount<=23) then champ3:=channelamount;
end;
end;




Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2002.08.05;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.47 MB
Время: 0.004 c
14-13804
pave1
2002-07-11 09:57
2002.08.05
Вопрос о литературе ...


1-13601
msk
2002-07-23 18:58
2002.08.05
Закрытие всех приложений


3-13530
Jungle
2002-07-12 11:28
2002.08.05
Поиск в базе, чувствительный к регистру


1-13638
Matrics
2002-07-22 17:13
2002.08.05
Толи я туплю, толи Delphi…


1-13590
Xper
2002-07-24 13:49
2002.08.05
Два тупых вопроса. Один из них по NMHTTP.





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский