purebasic.info

PureBasic forum
Текущее время: Вт июл 17, 2018 12:59 pm

Часовой пояс: UTC + 3 часа




Начать новую тему Ответить на тему  [ Сообщений: 11 ] 
Автор Сообщение
 Заголовок сообщения: Canvas_CustomText_MultiLine
СообщениеДобавлено: Сб янв 21, 2017 1:40 pm 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Вс дек 09, 2012 9:02 pm
Сообщений: 771
Откуда: Дагестан
Благодарил (а): 0 раз.
Поблагодарили: 11 раз.
Пункты репутации: 0
Можете помочь?
Думаю по коду ясно чем помочь. :)
Код:
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
#_Flag_MultiLine = 1<<2
 
Global Text.S = "строка_1"+Chr(10)+
                "строка__2"+Chr(10)+
                "строка___3 эта длиняя строка оказалась ну, очень длиной, поэтому будем его переносить"+Chr(10)+
                "строка_4"+#CRLF$+
                "строка__5"+#CRLF$+
                "строка___6"+#CRLF$
 
 
 
Procedure DrawTextMultiLine(X,Y,Text.S, FontColor = $FFFFFF, BackColor = 0, Flag = 0)
  Protected IT.I,String.S, CountString.I, StringWidth.I, StringHeight.I, Character.S = Chr(10)
  Protected iWidth = OutputWidth()-X*2 ;
 
  If ((Flag & #_Flag_MultiLine) = #_Flag_MultiLine)
      CountString = CountString(Text.S, Character)
     
      If CountString
        StringHeight = TextHeight(" ")
       
        For IT = 1 To (CountString+Space)
          String.S = Trim(StringField(Text.S, IT, Character))
         
          If String.S
            StringWidth = TextWidth(String)
            DrawText(X, Y+(((IT-1)+Space)*StringHeight), String.S, FontColor, BackColor) ; Bug
          EndIf
         
          If (StringWidth > iWidth)
            Space = 2 ; Как получить? Без цикла наверное не возможно
          EndIf
         
        Next
    EndIf
  Else
    DrawText(X, Y, Text.S, FontColor, BackColor) ; Bug
  EndIf  
 
EndProcedure
 
Procedure DrawContent(Gadget)
 
  If StartDrawing(CanvasOutput(Gadget))
    DrawingFont(GetGadgetFont(#PB_Default)) ; Шрифт по умолчанию
    Box(0,0,OutputWidth(),OutputHeight())
   
    DrawingMode(#PB_2DDrawing_Transparent)
    DrawTextMultiLine(2,0,Text,0,0,#_Flag_MultiLine)
   
    StopDrawing()
  EndIf
 
EndProcedure
 
Procedure Resize()
  Protected WindowWidth = WindowWidth(EventWindow())
 
  ResizeGadget(0,#PB_Ignore,#PB_Ignore,WindowWidth-20,#PB_Ignore)
 
  DrawContent(0)
 
  ResizeGadget(10,#PB_Ignore,#PB_Ignore,WindowWidth-20,#PB_Ignore)
EndProcedure
 
 
If OpenWindow(0, 0, 0, 220, 430, "CanvasGadget", #PB_Window_SizeGadget | #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  CanvasGadget(0, 10, 10, 200, 200)
  TextGadget(10, 10, 220, 200, 200, Text, #PB_Text_Border)
;   EditorGadget(10, 10, 220, 200, 200) : AddGadgetItem(10, -1, Text)
 
  DrawContent(0)
 
  BindEvent(#PB_Event_SizeWindow,@Resize(),0)
  Repeat
    Event = WaitWindowEvent()
  Until Event = #PB_Event_CloseWindow
EndIf
 
 



Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Canvas_CustomText_MultiLine
СообщениеДобавлено: Сб янв 21, 2017 3:37 pm 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Вс дек 09, 2012 9:02 pm
Сообщений: 771
Откуда: Дагестан
Благодарил (а): 0 раз.
Поблагодарили: 11 раз.
Пункты репутации: 0
Вот так что то похожее получилось.
Код:
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
#_Flag_MultiLine = 1<<2
 
Global Text.S = "строка_1"+Chr(10)+
                "строка__2"+Chr(10)+
                "строка___3 эта длиняя строка оказалась ну, очень длиной, поэтому будем его переносить"+Chr(10)+
                "строка_4"+#CRLF$+
                "строка__5"+#CRLF$+
                "строка___6"+#CRLF$
 
 
 
Procedure DrawTextMultiLine(X,Y,Text.S, FontColor = $FFFFFF, BackColor = 0, Flag = 0)
  Protected IT.I,String.S, CountString.I, StringWidth.I, StringHeight.I, Character.S = Chr(10)
  Protected iWidth = OutputWidth()-X*2 ;
 
  If ((Flag & #_Flag_MultiLine) = #_Flag_MultiLine)
    CountString = CountString(Text.S, Character)
   
    If CountString
      StringHeight = TextHeight(" ")
     
      For IT = 1 To (CountString+Space)
        String.S = Trim(StringField(Text.S, IT, Character))
       
        If String.S
          StringWidth = TextWidth(String)
          If (StringWidth < iWidth)
            DrawText(X, Y+(((IT-1)+Space)*StringHeight), String.S, FontColor, BackColor) ; Bug
          EndIf
        EndIf
       
        If (StringWidth > iWidth)
          For I = 1 To CountString(String.S, " ");+1
            FindString.S = Trim(StringField(String.S, I, " "))
            String1.S +" "+ FindString
           
            If TextWidth(String1.S) > iWidth
              Space + 1
              String1.S = RemoveString(String1.S,FindString.S)
               String2.S = Mid(String,1,Len(String1.S)-1);String
               String.S = Mid(String,Len(String1.S))
               DrawText(X, Y+(((IT-1)+Space)*StringHeight), String.S, FontColor, BackColor) ; Bug
             
            Else
              If Space = 0
                String3.S = Trim(String1)
              EndIf
            EndIf
          Next
         
          If String3.S
            DrawText(X, Y+(((IT-1))*StringHeight), String3.S, FontColor, BackColor) ; Bug
          EndIf
        EndIf
       
      Next
    EndIf
  Else
    DrawText(X, Y, Text.S, FontColor, BackColor) ; Bug
  EndIf  
 
EndProcedure
 
Procedure DrawContent(Gadget)
 
  If StartDrawing(CanvasOutput(Gadget))
    DrawingFont(GetGadgetFont(#PB_Default)) ; Шрифт по умолчанию
    Box(0,0,OutputWidth(),OutputHeight())
   
    DrawingMode(#PB_2DDrawing_Transparent)
    DrawTextMultiLine(0,0,Text,0,0,#_Flag_MultiLine)
   
    StopDrawing()
  EndIf
 
EndProcedure
 
Procedure Resize()
  Protected WindowWidth = WindowWidth(EventWindow())
 
  ResizeGadget(0,#PB_Ignore,#PB_Ignore,WindowWidth-20,#PB_Ignore)
 
  DrawContent(0)
 
  ResizeGadget(10,#PB_Ignore,#PB_Ignore,WindowWidth-20,#PB_Ignore)
EndProcedure
 
 
If OpenWindow(0, 0, 0, 220, 430, "CanvasGadget", #PB_Window_SizeGadget | #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  CanvasGadget(0, 10, 10, 200, 200)
  TextGadget(10, 10, 220, 200, 200, Text, #PB_Text_Border)
;   EditorGadget(10, 10, 220, 200, 200) : AddGadgetItem(10, -1, Text)
 
  DrawContent(0)
 
  BindEvent(#PB_Event_SizeWindow,@Resize(),0)
  Repeat
    Event = WaitWindowEvent()
  Until Event = #PB_Event_CloseWindow
EndIf
 
 



Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Canvas_CustomText_MultiLine
СообщениеДобавлено: Сб янв 21, 2017 8:31 pm 
Не в сети
док

Зарегистрирован: Ср апр 16, 2014 5:56 pm
Сообщений: 113
Благодарил (а): 7 раз.
Поблагодарили: 6 раз.
Пункты репутации: 5
Вот тут
mestnyi писал(а):
Код:
1
2
3
 
    DrawTextMultiLine(0,0,Text,0,0,#_Flag_MultiLine)
 


отправляется X=0. В этом предельном случае
получается "OutputWidth()-X*2" = "OutputWidth()".
Не устраивает работа с переносом?
Но сколько я не игрался с Resize, оба примера работают одинаково.
Или я не понял проблемы.
Код:
1
2
3
4
5
6
 
Procedure DrawTextMultiLine(X,Y,Text.S, FontColor = $FFFFFF, BackColor = 0, Flag = 0)
  Protected IT.I,String.S, CountString.I, StringWidth.I, StringHeight.I, Character.S = Chr(10)
  Protected iWidth = OutputWidth()-X*2 ;
...
 



Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Canvas_CustomText_MultiLine
СообщениеДобавлено: Вс янв 22, 2017 6:27 am 
Не в сети
профессор

Зарегистрирован: Вт май 13, 2014 4:12 am
Сообщений: 629
Благодарил (а): 66 раз.
Поблагодарили: 20 раз.
Пункты репутации: 5
Я так понял, нужно на канвас положить большой текст?
В качестве идеи.
Берём редактор такого же размера, кидаем в него текст, а потом построчно переносим на канвас.
Куда редактор засунуть чтобы не мешал, это другая проблема.


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: [Решено]Canvas_CustomText_MultiLine
СообщениеДобавлено: Вс янв 22, 2017 3:22 pm 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Вс дек 09, 2012 9:02 pm
Сообщений: 771
Откуда: Дагестан
Благодарил (а): 0 раз.
Поблагодарили: 11 раз.
Пункты репутации: 0
Цитата:
В качестве идеи.
Берём редактор такого же размера, кидаем в него текст, а потом построчно переносим на канвас.
:D :D :D
Цитата:
Но сколько я не игрался с Resize, оба примера работают одинаково.
:shock: :shock: :shock:
Сделай хотя бы минимальный размер и посмотри одинаково ли перенеслись слова.
За бугром помогли тема решена если нет еще оптимальных решений. :)
Код:
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
#_Flag_MultiLine = 1<<2
 
Global Text.S = "строка_1"+Chr(10)+
                "строка__2"+Chr(10)+
                "строка___3 эта длиняя строка оказалась ну, очень длиной, поэтому будем его переносить"+Chr(10)+
                "строка_4"+#CRLF$+
                "строка__5"+#CRLF$+
                "строка___6"+#CRLF$
 
 
 Procedure.S MakeMultiText(Text.S, iWidth, Character.S)
  Protected String.S, String1.S, String2.S, String3.S, IT, Start, CountSpace, CountString = CountString(Text, Character)
 
  If CountString
    For IT = 1 To CountString : Start = 1
      String = StringField(Text, IT, Character)
      CountSpace = CountString(String, " ")
     
      Repeat
        String1 = StringField(String, Start, " ")
       
        While (CountSpace>=Start) : Start+1
          String2 = StringField(String, Start, " ")
         
          If TextWidth(String1+String2) < (iWidth-2)
            String1 = Trim(String1+" "+String2)
          Else
            Break
          EndIf
        Wend
       
        String3+String1+Character
      Until (Start>CountSpace)
    Next
  Else
    String3 = String
  EndIf
 
  ProcedureReturn String3
EndProcedure
 
 
Procedure DrawTextMultiLine(X,Y,Text.S, FontColor = $FFFFFF, BackColor = 0, Flag = 0)
  Protected IT.I,String.S, CountString.I, StringWidth.I, StringHeight.I, Character.S = Chr(10)
  Protected iWidth = OutputWidth()-X*2 ;
 
  If ((Flag & #_Flag_MultiLine) = #_Flag_MultiLine)
    Text.S = MakeMultiText(Text.S, iWidth, Character)
    CountString = CountString(Text.S, Character)
   
    If CountString
      StringHeight = TextHeight(" ")
     
      For IT = 1 To (CountString+Space)
        String.S = Trim(StringField(Text.S, IT, Character))
       
        If String.S
          DrawText(X, Y+(((IT-1)+Space)*StringHeight), String.S, FontColor, BackColor) ; Bug
        EndIf
      Next
    EndIf
  Else
    DrawText(X, Y, Text.S, FontColor, BackColor) ; Bug
  EndIf  
 
EndProcedure
 
Procedure DrawContent(Gadget)
 
  If StartDrawing(CanvasOutput(Gadget))
    DrawingFont(GetGadgetFont(#PB_Default)) ; Шрифт по умолчанию
    Box(0,0,OutputWidth(),OutputHeight())
   
    DrawingMode(#PB_2DDrawing_Transparent)
    DrawTextMultiLine(0,0,Text,0,0,#_Flag_MultiLine)
   
    StopDrawing()
  EndIf
 
EndProcedure
 
Procedure Resize()
  Protected WindowWidth = WindowWidth(EventWindow())
 
  ResizeGadget(0,#PB_Ignore,#PB_Ignore,WindowWidth-20,#PB_Ignore)
 
  DrawContent(0)
 
  ResizeGadget(10,#PB_Ignore,#PB_Ignore,WindowWidth-20,#PB_Ignore)
EndProcedure
 
 
If OpenWindow(0, 0, 0, 220, 430, "CanvasGadget", #PB_Window_SizeGadget | #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  CanvasGadget(0, 10, 10, 200, 200)
  TextGadget(10, 10, 220, 200, 200, Text, #PB_Text_Border)
;   EditorGadget(10, 10, 220, 200, 200) : AddGadgetItem(10, -1, Text)
 
  DrawContent(0)
 
  BindEvent(#PB_Event_SizeWindow,@Resize(),0)
  Repeat
    Event = WaitWindowEvent()
  Until Event = #PB_Event_CloseWindow
EndIf
 



Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: [Решено]Canvas_CustomText_MultiLine
СообщениеДобавлено: Вс янв 22, 2017 6:28 pm 
Не в сети
док

Зарегистрирован: Ср апр 16, 2014 5:56 pm
Сообщений: 113
Благодарил (а): 7 раз.
Поблагодарили: 6 раз.
Пункты репутации: 5
mestnyi писал(а):
Сделай хотя бы минимальный размер и посмотри одинаково ли перенеслись слова.
За бугром помогли тема решена если нет еще оптимальных решений. :)

Вон оно что! На одном окне два гаджета с ОДИНАКОВЫМ текстом, и вот нижний работает хорошо, а верхний - нет. А надо, значит, чтобы оба давали одинаковый результат.
Меня мучает вопрос: как ты изложил суть на забугорном форуме, что там тебя поняли, а мы вот с newJS здесь - нет?


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Canvas_CustomText_MultiLine
СообщениеДобавлено: Вс янв 22, 2017 11:38 pm 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Вс дек 09, 2012 9:02 pm
Сообщений: 771
Откуда: Дагестан
Благодарил (а): 0 раз.
Поблагодарили: 11 раз.
Пункты репутации: 0
Цитата:
Меня мучает вопрос: как ты изложил суть на забугорном форуме

Цитата:
How to organize indent text?

Вот так :D


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Canvas_CustomText_MultiLine
СообщениеДобавлено: Пн янв 23, 2017 12:10 am 
Не в сети
профессор

Зарегистрирован: Пт фев 20, 2009 12:57 pm
Сообщений: 1638
Откуда: Алматы
Благодарил (а): 14 раз.
Поблагодарили: 45 раз.
Пункты репутации: 5
а я тоже чот тыркался тыркался - хотел сделать распределение текста по ширине, как в ворде... и так и не родил алгоритм. видимо к старости тупеть уже начал. это уже который раз я на алгоритме застрял :)


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Canvas_CustomText_MultiLine
СообщениеДобавлено: Пн янв 23, 2017 12:57 am 
Не в сети
док

Зарегистрирован: Ср апр 16, 2014 5:56 pm
Сообщений: 113
Благодарил (а): 7 раз.
Поблагодарили: 6 раз.
Пункты репутации: 5
mestnyi писал(а):
How to organize indent text?
Вот так :D

Перевод посредством PROMT, что ли?
"indent":
-заявка, вмятина, отступ, зазубрина, абзац, вырез
-интендантский
-заказывать, зазубривать, выравнивать, отдавать, делать отступ, вдавливать, врезать
И нигде про ПЕРЕНОС (word division)! А вдруг нужна разрядка/сужение текста?
Гениальные они там ребята! А что за форум, ссылку можно? А то я вроде поболе о проблеме разжёвываю, да не понимат...


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Canvas_CustomText_MultiLine
СообщениеДобавлено: Пн янв 23, 2017 7:14 am 
Не в сети
профессор

Зарегистрирован: Вт май 13, 2014 4:12 am
Сообщений: 629
Благодарил (а): 66 раз.
Поблагодарили: 20 раз.
Пункты репутации: 5
mestnyi писал(а):
Думаю по коду ясно чем помочь

mestnyi, я как понял так и подсказал, подумал что тебе надо длинный текст порезать по словам и выложить на канвас
ну не угадал я твой шифр, бывает :D


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Canvas_CustomText_MultiLine
СообщениеДобавлено: Пн янв 23, 2017 12:06 pm 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Вс дек 09, 2012 9:02 pm
Сообщений: 771
Откуда: Дагестан
Благодарил (а): 0 раз.
Поблагодарили: 11 раз.
Пункты репутации: 0
Цитата:
А что за форум, ссылку можно?

http://www.purebasic.fr/english/viewtopic.php?f=13&t=67530
Цитата:
mestnyi писал(а):
Думаю по коду ясно чем помочь

mestnyi, я как понял так и подсказал, подумал что тебе надо длинный текст порезать по словам и выложить на канвас
ну не угадал я твой шифр, бывает :D
:D :D :D Ну и хохмачи же вы.


Вернуться наверх
 Профиль  
 
Показать сообщения за:  Сортировать по:  
Начать новую тему Ответить на тему  [ Сообщений: 11 ] 

Часовой пояс: UTC + 3 часа


Кто сейчас на форуме

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 5


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
Перейти:  
Создано на основе phpBB® Forum Software © phpBB Group (блог о phpBB)
Сборка создана CMSart Studio
Русская поддержка phpBB