Форум программистов, компьютерный форум, киберфорум
Наши страницы
OpenGL
Войти
Регистрация
Восстановить пароль
 
 
Рейтинг: Рейтинг темы: голосов - 28, средняя оценка - 4.86
Andrej070
0 / 0 / 0
Регистрация: 15.07.2009
Сообщений: 31
#1

Очень надо решить проблему - OpenGL

15.07.2009, 14:24. Просмотров 3485. Ответов 31
Метки нет (Все метки)

КТО НИБУДЬ МОЖЕТ НА ПРАКТИКЕ РЕАЛИЗОВАТЬ ТАКОЕ РЕШЕНИЕ? короче задача:
написать парсер и вывод смайлов.
\
Procedure Smile(str:string);
begin
//str обрабатывается и если найдены смайлы, то преобразуются в графику.
вывод - в richedit или в любое поле поддерживающее цветной текст.
можно RxRichEdit
end;

Добавлено через 12 часов 38 минут 15 секунд
Цитата Сообщение от Andrej070 Посмотреть сообщение
КТО НИБУДЬ МОЖЕТ НА ПРАКТИКЕ РЕАЛИЗОВАТЬ ТАКОЕ РЕШЕНИЕ? короче задача:
написать парсер и вывод смайлов.
\
Procedure Smile(str:string);
begin
//str обрабатывается и если найдены смайлы, то преобразуются в графику.
вывод - в richedit или в любое поле поддерживающее цветной текст.
можно RxRichEdit
end;
ВОБЩЕМ НАДО ЧТО БЫ СМАЙЛЫ КОТОРЫЕ ТЫ ОТПРАВЛЯЕШЬ ПРИХОДИЛИ В ВИДЕ СМАЙЛОВ, А НЕ ЗНАЧКОВ (-) (-) (-)
http://www.cyberforum.ru/cpp-builder/thread28744.html
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
15.07.2009, 14:24
Я подобрал для вас темы с готовыми решениями и ответами на вопрос Очень надо решить проблему (OpenGL):

Не могу решить!!! Очень надо.
Скоро госэкзамен, а у нас так и не было не одного урока по программированию,...

Помогите решить проблему!
вообщем из за просмотра видео на каких то сайтах, мой комп накрылся(((...

Помогите решить проблему
Ребят,очень большая просьба подскажите каким оброзом это...

помогите решить проблему
всем привет!ноуту полтора года последнее время стал ужасно тупить очень долго...

помогите решить проблему
import nltk from nltk.corpus import brown...

31
Andrej070
0 / 0 / 0
Регистрация: 15.07.2009
Сообщений: 31
20.07.2009, 22:17  [ТС] #21
Плохо. Разделю еще ¿ таких в смайлах нет ¿ : ) ¿ ¿ : ] ¿ ¿ : р ¿ ¿ ; ) ¿ ¿ : D ¿ ¿ : р ¿ ¿ : Р ¿ ¿ 0 : } ¿ ¿ : ( ¿ ¿ : о ¿ ¿ : | ¿ ¿ : - / ¿ ¿ : \ ¿ ¿ о_0 ¿ ¿ : [ ¿ ¿ Х ( ¿ ¿ : 0 ¿ ¿ ( ) ¿ ¿ ( - ) ¿ ¿ \ _ / ¿ ¿ ] : - > ¿ ¿ ^ _ ^ ¿ ¿ : - . ¿ ¿ : - * ¿ ВСЕ.
0
galileopro
Пробующий
184 / 97 / 8
Регистрация: 28.04.2009
Сообщений: 1,040
20.07.2009, 22:35 #22
Спасибо. Дополнишь код
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
smail[0]:=':)';
smail[1]:=':]';
smail[2]:=':p';
smail[3]:=';)';
smail[4]:=':D';
smail[5]:=':p';
smail[6]:=':P';
smail[7]:=':}';
smail[8]:=':(';
smail[9]:=':o';
smail[10]:=':|';
smail[11]:=':-/';
smail[12]:=':\';
smail[13]:=':->^_^';
smail[14]:=':-.';
smail[15]:=':-*';
И все. У меня 24 не получилось. Ну не важно. Попраавишь сам. Допишешь. Если будут вопросы - пиши.

Добавлено через 1 минуту 24 секунды
Тебе выложить скрин, ты без компа архив откроешь? Там программа вся. Екзешник есть. Может получится где-то запустить?

Добавлено через 6 минут 54 секунды
Вот
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
smail[0]:=':)';
smail[1]:=':]';
smail[2]:=':p';
smail[3]:=';)';
smail[4]:=':D';
smail[5]:=':P';
smail[6]:='0:}';
smail[7]:=':(';
smail[8]:=':o';
smail[9]:=':|';
smail[10]:=':-/';
smail[11]:=':\';
smail[12]:='o_0';
smail[13]:=':[';
smail[14]:=':[';
smail[15]:='X(';
smail[16]:=':0';
smail[17]:='()';
smail[18]:='(-)';
smail[19]:='\_/';
smail[20]:=']:->';
smail[21]:='^_^';
smail[22]:=':-';
smail[23]:=':-*';
1
Andrej070
0 / 0 / 0
Регистрация: 15.07.2009
Сообщений: 31
20.07.2009, 22:36  [ТС] #23
galileopro, Мне без компа не открыть архив и не дополнить. Я че то между закорючками ¿¿24 насчитал. Вобщем мне самому не сделать никак : )
0
galileopro
Пробующий
184 / 97 / 8
Регистрация: 28.04.2009
Сообщений: 1,040
20.07.2009, 22:45 #24
Скрин
Очень надо решить проблему
0
galileopro
Пробующий
184 / 97 / 8
Регистрация: 28.04.2009
Сообщений: 1,040
20.07.2009, 22:47 #25
Очень надо решить проблему
1
Andrej070
0 / 0 / 0
Регистрация: 15.07.2009
Сообщений: 31
21.07.2009, 00:54  [ТС] #26
galileopro, я еще в асю скинул смайлы. У тебя немного напутано. Там третий и шестой одинаковые, а дальше я не помню.: )

Добавлено через 2 часа 0 минут 2 секунды
Я вот подумал над буквами в смайлах, так и оказалось. Буквы о р О Р это русские буквы.
0
galileopro
Пробующий
184 / 97 / 8
Регистрация: 28.04.2009
Сообщений: 1,040
22.07.2009, 14:24 #27
Вот программа. Текс не весь. Основное.
Delphi
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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ImgList, StdCtrls, ComCtrls, JvExStdCtrls,JvRichEdit,RichEdit,
  Menus, Grids, Buttons;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    ImageList1: TImageList;
    JvRichEdit1: TJvRichEdit;
    PopupMenu1: TPopupMenu;
    BitBtn1: TBitBtn;
    Memo1: TMemo;m;
    smail1: TMenuItem;
    smail2: TMenuItem;
     ...
    smail23: TMenuItem;
    smail24: TMenuItem;
    galileopro: TEdit;
    procedure PutBitmap(RichEdit:TJvRichEdit;num: integer);
    procedure Button1Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure smail1Click(Sender: TObject);
    procedure smile2Click(Sender: TObject);
    ...
    procedure smail24Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
 
    { Public declarations }
  end;
 
 
type
// функция обратного вызова - для обработки TRichedit
  TEditStreamCallBack = function(dwCookie: Longint; pbBuff: PByte;
    cb: Longint; var pcb: Longint): DWORD;
  stdcall;
 
// Тип данных для помещения их в RichEdit
  TEditStream = record
    dwCookie: Longint;
    dwError: Longint;
    pfnCallback: TEditStreamCallBack;
  end;
 
type
  TMyRichEdit = TJvRichEdit;
var
  Form1: TForm1;
  s: String;// array[0..3] of String[60];
  smail:array[0..23]of String;
  pos_smail:array[0..23]of integer;
  j:integer;
implementation
 
{$R *.dfm}
// Собственно сама функция обработки обратного вызова - требуется для добавления данных
function EditStreamInCallback(dwCookie: Longint; pbBuff: PByte;
  cb: Longint; var pcb: Longint): DWORD; stdcall;
 
var
  theStream: TStream;
  dataAvail: LongInt;
begin
  theStream := TStream(dwCookie);
  with theStream do
  begin
    dataAvail := Size - Position;
    Result := 0;
    if dataAvail <= cb then
    begin
      pcb := read(pbBuff^, dataAvail);
      if pcb <> dataAvail then
        Result := UINT(E_FAIL);
    end
    else
    begin
      pcb := read(pbBuff^, cb);
      if pcb <> cb then
        Result := UINT(E_FAIL);
    end;
  end;
end;
 
 
// функция помещения строки в RichEdit в формате RTF
procedure PutRTFSelection(RichEdit: TMyRichEdit; SourceStream: TStream);
var
  EditStream: TEditStream;
begin
// Заполнение EditStream нашими данными
  with EditStream do
  begin
    dwCookie := Longint(SourceStream);
    dwError := 0;
    pfnCallback := EditStreamInCallBack;
  end;
// собственно сама операция по добавлению данных в RichEdit
  RichEdit.Perform(EM_STREAMIN, SF_RTF or SFF_SELECTION, Longint(@EditStream));
end;
 
//Функция перевода BMP в String
function BitmapToRTF(pict: TBitmap): string;
var
  bi, bb, rtf: string;
  bis, bbs: Cardinal;
  achar: ShortString;
  hexpict: string;
  I: Integer;
begin
// Устанавливаем размеры переменных
  GetDIBSizes(pict.Handle, bis, bbs);
  SetLength(bi, bis);
  SetLength(bb, bbs);
  GetDIB(pict.Handle, pict.Palette, PChar(bi)^, PChar(bb)^);
//Подгоняем результат под формат Rtf
  rtf := '{\rtf1 {\pict\dibitmap ';
  SetLength(hexpict, (Length(bb) + Length(bi)) * 2);
  I := 2;
  for bis := 1 to Length(bi) do //Цикл перевода данных BMP в String
// т.е. берем значение из TBitmap и дописываем его в Hex формате
  begin
    achar := Format('%x', [Integer(bi[bis])]);
    if Length(achar) = 1 then
      achar := '0' + achar;
    hexpict[I - 1] := achar[1];
    hexpict[I] := achar[2];
    Inc(I, 2);
  end;
  for bbs := 1 to Length(bb) do
  begin
    achar := Format('%x', [Integer(bb[bbs])]);
    if Length(achar) = 1 then
      achar := '0' + achar;
    hexpict[I - 1] := achar[1];
    hexpict[I] := achar[2];
    Inc(I, 2);
  end;
  rtf := rtf + hexpict + ' }}';
// Возвращаем полученную строку
  Result := rtf;
end;
 
// Та процедура с которой мы и работаем
procedure TForm1.PutBitmap(RichEdit:TJvRichEdit;num: integer);
var
  SS: TStringStream; //Накопитель строковых данных для добавления в RichEdit
  BMP: TBitmap; //Картинка
begin
  BMP := TBitmap.Create;
   imagelist1.GetBitmap(num,bmp); //получаем картинку по номеру Num в BMP.
   SS  := TStringStream.Create(BitmapToRTF(BMP)); //Создаем SS из BMP.
  try
    PutRTFSelection(RichEdit, SS); //Добавляем в RichEdit
    application.ProcessMessages;
  finally
    SS.Free;
  end;
  bmp.Free;
end;
Procedure setline(WhichEdit:TJvRichedit;Linepos,charpos:integer);
Begin
with WhichEdit do
begin
  selstart:=perform(EM_LineIndex,Linepos,0)+charpos;
  perform(EM_ScrollCaret,0,0);
end;
end;
function RemoveInvalid(what, where: string): string;
// what - удаляемая подстрока, where - обрабатываемая строка
var
  tstr: string;
begin
  tstr:=where;
  while pos(what, tstr)>0 do
    tstr:=copy(tstr,1,pos(what,tstr)-1) +
  copy(tstr,pos(what,tstr)+length(tstr),length(tstr));
  Result:=tstr;
 
end; 
procedure TForm1.Button1Click(Sender: TObject);  //парсер
var i,kol:integer;
s1:String;
i2,j2,i3,j3,kol2,kol3:integer;
k:integer;
flag:boolean;
MyFont:TFont;
mass:array[0..23,1..10]of integer;
mass2:array[0..230]of integer;
pos2:array[0..230]of integer;
begin
smail[0]:=':)';
smail[1]:=':]';
smail[2]:=':р';
smail[3]:=';)';
smail[4]:=':D';
smail[5]:=':Р';
smail[6]:='0:}';
smail[7]:=':(';
smail[8]:=':o';
smail[9]:=':|';
smail[10]:=':-/';
smail[11]:=':\';
smail[12]:='o_0';
smail[13]:=':[';
smail[14]:=':[';
smail[15]:='X(';
smail[16]:=':0';
smail[17]:='()';
smail[18]:='(-)';
smail[19]:='\_/';
smail[20]:=']:->';
smail[21]:='^_^';
smail[22]:=':-';
smail[23]:=':-*';
s:='['+Form1.galileopro.Text+']';
for i2:=0 to 23 do
for j2:=0 to 10 do mass[i2,j2]:=0;
 
for i2:=0 to 230 do mass2[i2]:=0;
for i2:=0 to 230 do pos2[i2]:=0;
 
for i:=0 to 3 do s:=s+Form1.Memo1.Lines[i];
 
for i:=0 to 23 do begin   //находим смайлы
kol:=0;
repeat
inc(kol);
mass[i,kol]:=Pos(smail[i],s);
DELETE(s,mass[i,kol],Length(smail[i]));
until (mass[i,kol]=0);
end;
 
 kol2:=0;
 for i2:=0 to 23 do
  for j2:=1 to 10 do
if(mass[i2,j2]>0)then begin
 mass2[kol2]:=mass[i2,j2];
 inc(kol2);
 end;
 
  if(kol2>0)then begin
 repeat
  flag:=true;
 for i:=0 to kol2-2 do
 if (mass2[i+1]<mass2[i])then begin
 flag:=false;
  k:=mass2[i];
  mass2[i]:=mass2[i+1];
  mass2[i+1]:=k;
  end;
  until(flag=true);
  end;
 
for i3:=0 to kol2-1 do
  for i2:=0 to 23 do
   for j2:=1 to 10 do
   if(mass2[i3]=mass[i2,j2])then pos2[i3]:=i2;
 
MyFont:=TFont.Create();
 MyFont.Color:=clGreen;
 Form1.JvRichEdit1.SetFocus();
 
 if(kol2>0)then begin
s1:='';
s1:=copy(s,0,mass2[0]-1);
Form1.JvRichEdit1.AddFormatText(s1,MyFont);
Form1.JvRichEdit1.SelStart:=Form1.JvRichEdit1.Perform(EM_LineIndex,Form1.JvRichEdit1.CaretPos.Y+length(s1)div 50,0)+Form1.JvRichEdit1.CaretPos.X+length(s1);
  PutBitmap(JvRichEdit1,pos2[0]);
  if(kol2-1>0)then begin
  for kol3:=0 to kol2-2 do begin
s1:='';
s1:=copy(s,mass2[kol3],mass2[kol3+1]-mass2[kol3]);
Form1.JvRichEdit1.AddFormatText(s1,MyFont);
Form1.JvRichEdit1.SelStart:=Form1.JvRichEdit1.Perform(EM_LineIndex,Form1.JvRichEdit1.CaretPos.Y+length(s1)div 50,0)+Form1.JvRichEdit1.CaretPos.X+length(s1);
  PutBitmap(JvRichEdit1,pos2[kol3+1]); 
  end;
  end;
s1:='';
s1:=copy(s,mass2[kol2-1],length(s)-1);
 Form1.JvRichEdit1.AddFormatText(s1+#10,MyFont);
Form1.JvRichEdit1.SelStart:=Form1.JvRichEdit1.Perform(EM_LineIndex,Form1.JvRichEdit1.CaretPos.Y+1,0);
end
else begin
Form1.JvRichEdit1.AddFormatText(s+#10,MyFont);
Form1.JvRichEdit1.SelStart:=Form1.JvRichEdit1.Perform(EM_LineIndex,Form1.JvRichEdit1.CaretPos.Y+length(s1)div 50+1,0)+Form1.JvRichEdit1.CaretPos.X+length(s1);
end;
   MyFont.Free();
  Form1.Memo1.SetFocus();
end;
 
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
PopupMenu1.Popup(Mouse.CursorPos.X, Mouse.CursorPos.y);
end;
 
procedure TForm1.smile1Click(Sender: TObject);
begin
 PutBitmap(JvRichEdit1,0);
end;
 
procedure TForm1.smail2Click(Sender: TObject);
begin
PutBitmap(JvRichEdit1,1);
end;
 
...
 
procedure TForm1.smail24Click(Sender: TObject);
begin
PutBitmap(JvRichEdit1,23);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.Memo1.MaxLength:=240;
j:=0;
end;
end.
В программе есть проблема. Нужно переделать это:
Delphi
1
2
3
4
5
6
7
8
for i:=0 to 23 do begin   //находим смайлы
kol:=0;
repeat
inc(kol);
mass[i,kol]:=Pos(smail[i],s);
DELETE(s,mass[i,kol],Length(smail[i]));
until (mass[i,kol]=0);
end;
Я постараюсь за сегодня переделать.
1
Вложения
Тип файла: rar 79.rar (297.5 Кб, 17 просмотров)
galileopro
Пробующий
184 / 97 / 8
Регистрация: 28.04.2009
Сообщений: 1,040
22.07.2009, 15:00 #28
Исправил глюк. Вот окончательный результат.
1
Вложения
Тип файла: rar 79_1.rar (296.2 Кб, 22 просмотров)
galileopro
Пробующий
184 / 97 / 8
Регистрация: 28.04.2009
Сообщений: 1,040
22.07.2009, 16:39 #29
Тут я добавил возможность изменять цвет текста и запись истории сообщений.
0
Вложения
Тип файла: rar 79_2.rar (298.7 Кб, 21 просмотров)
galileopro
Пробующий
184 / 97 / 8
Регистрация: 28.04.2009
Сообщений: 1,040
24.07.2009, 21:13 #30
Вот малость переделанное:
79_3.rar
1
galileopro
Пробующий
184 / 97 / 8
Регистрация: 28.04.2009
Сообщений: 1,040
24.07.2009, 21:29 #31
Вот оно.79_5.rar
0
galileopro
Пробующий
184 / 97 / 8
Регистрация: 28.04.2009
Сообщений: 1,040
24.07.2009, 21:35 #32
Ну как?

Вотс примерчик с анимацией:
34.rar

прога.rarВот для Poshta и Павелнекст

Вот малость переделанная
прога.rar

Смайлы:
Смайлы.rar
0
24.07.2009, 21:35
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
24.07.2009, 21:35
Привет! Вот еще темы с решениями:

Помогите решить проблему.
Помогите, у меня такой вопрос. Была windows7(и два диска C и D) я переустановил...

Помогите решить проблему!
Уже вторые сутки бьюсь над решением задачи: Вводится строка с...

Помогите решить проблему!
1с Бух УСН 7.7 При вводе сотрудника, на закладке налоги и отчисления есть...

Возможно ли решить проблему с группировкой
Т.к. ассортимент товаров очень большой, то хочется при вводе Счета или Товарной...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
32
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru