Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2002.08.05;
Скачать: CL | DM;

Вниз

Помогите. Проблеммы с переводом программы из 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;
Скачать: CL | DM;

Наверх




Память: 0.49 MB
Время: 0.013 c
3-13580
ZLOST
2002-07-14 20:19
2002.08.05
Дайте пример как резалт запроса (тип _Recordset)вывести в DBGRID


3-13551
Itspets
2002-07-14 01:11
2002.08.05
Сбор данных из множества баз MS Access


4-13856
lds
2002-05-27 14:34
2002.08.05
HELP!!!


14-13816
111
2002-07-11 18:41
2002.08.05
HiperTerminal


1-13619
eruc
2002-07-22 18:08
2002.08.05
Создаем XML-файл