* * *    
Главная » Статьи » Код PB

Просмотров: 1578 | Дата: 09.05.2024 | Коментарии (0)

Сохранить в файле и открыть в Ворде




Code
Structure CHARFORMAT2_  
  cbSize.l  
  dwMask.l  
  dwEffects.l  
  yHeight.l  
  yOffset.l  
  crTextColor.l  
  bCharSet.b  
  bPitchAndFamily.b  
  szFaceName.b[#LF_FACESIZE]  
  _wPad2.w  
  wWeight.w  
  sSpacing.w  
  crBackColor.l  
  lcid.l  
  dwReserved.l  
  sStyle.w  
  wKerning.w  
  bUnderlineType.b  
  bAnimation.b  
  bRevAuthor.b  
  bReserved1.b  
EndStructure  

Procedure EditorBackColor(Gadget, Color.l)  
  format.CHARFORMAT2_  
  format\cbSize = SizeOf(CHARFORMAT2_)  
  format\dwMask = $4000000 ; = #CFM_BACKCOLOR  
  format\crBackColor = Color  
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)  
EndProcedure

Procedure EditorSelect(Gadget, LineStart.l, CharStart.l, LineEnd.l, CharEnd.l)  
  sel.CHARRANGE  
  sel\cpMin = SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, LineStart, 0) + CharStart - 1  
   
  If LineEnd = -1  
  LineEnd = SendMessage_(GadgetID(Gadget), #EM_GETLINECOUNT, 0, 0)-1  
  EndIf  
  sel\cpMax = SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, LineEnd, 0)  
   
  If CharEnd = -1  
  sel\cpMax + SendMessage_(GadgetID(Gadget), #EM_LINELENGTH, sel\cpMax, 0)  
  Else  
  sel\cpMax + CharEnd - 1  
  EndIf  
  SendMessage_(GadgetID(Gadget), #EM_EXSETSEL, 0, @sel)  
EndProcedure  

; Set the Text color for the Selection  
; in RGB format  
Procedure EditorColor(Gadget, Color.l)  
  format.CHARFORMAT  
  format\cbSize = SizeOf(CHARFORMAT)  
  format\dwMask = #CFM_COLOR  
  format\crTextColor = Color  
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)  
EndProcedure  

; Set Font Size for the Selection  
; in pt  
Procedure EditorFontSize(Gadget, Fontsize.l)  
  format.CHARFORMAT  
  format\cbSize = SizeOf(CHARFORMAT)  
  format\dwMask = #CFM_SIZE  
  format\yHeight = FontSize*20  
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)  
EndProcedure  

; Set Font for the Selection  
; You must specify a font name, the font doesn't need  
; to be loaded  
Procedure EditorFont(Gadget, FontName.s)  
  format.CHARFORMAT  
  format\cbSize = SizeOf(CHARFORMAT)  
  format\dwMask = #CFM_FACE  
  PokeS(@format\szFaceName, FontName)  
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)  
EndProcedure  

; Set Format of the Selection. This can be a combination of  
; the following values:  
; #CFM_BOLD  
; #CFM_ITALIC  
; #CFM_UNDERLINE  
; #CFM_STRIKEOUT  
Procedure EditorFormat(Gadget, Flags.l)  
  format.CHARFORMAT  
  format\cbSize = SizeOf(CHARFORMAT)  
  format\dwMask = #CFM_ITALIC|#CFM_BOLD|#CFM_STRIKEOUT|#CFM_UNDERLINE  
  format\dwEffects = Flags  
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)  
EndProcedure  

; -------------------------------------------------------------  
; Source Example:  

;- Save *******
Procedure StreamFileOut_Callback(hFile, pbBuff, cb, pcb)  
  ProcedureReturn WriteFile_(hFile, pbBuff, cb, pcb, 0)!1  
EndProcedure  
   

; Hier eine Procedure + Callback zum speichern einer Datei:  
;  
; FileID freie ID fьr Dateioperationen  
; File Die Datei ggf. mit Pfad  
; Gadget Gadget ID vom EditorGadget()  

Procedure FileStreamOut(FileID.l, File.s, Gadget.l)  
  r.b=0
  Protected StreamData.EDITSTREAM  
   
  ;Wenn die Datei erzeugt werden kann, fortfahren.  
  If CreateFile(FileID, File)  
   
  ;Das Handle der Datei speichern  
  StreamData\dwCookie = FileID(FileID)  
  StreamData\dwError = #Null  
   
  ;Die Adresse der Callback Procedure speichern  
  StreamData\pfnCallback = @StreamFileOut_Callback()  
   
  ;Das RichEdit Control anweisen, den Stream zu aktivieren  
  SendMessage_(GadgetID(Gadget), #EM_STREAMOUT, #SF_RTF, @StreamData)  
   
  ;Datei schliessen  
  CloseFile(FileID)  
  r.b=1
  EndIf  
  ProcedureReturn r
EndProcedure

#Editor = 1  

If OpenWindow(0, 0, 0, 500, 500, "EditorGadget", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)  
  If CreateGadgetList(WindowID(0))  
  ButtonGadget(0,40,10,220,28,"Сохранить в файле и открыть в Ворде")
  EditorGadget(#Editor, 10, 50, 480, 430)  
   
  AddGadgetItem(#Editor, 0, "This is a blue, bold and underlined big text")  
  AddGadgetItem(#Editor, 1, "Times new Roman, red, striked out and italic")
  AddGadgetItem(#Editor, 2, "This is usual text, with a yellow background color")  
  AddGadgetItem(#Editor, 3, "This is usual Text.")  
   
   
  EditorSelect(#Editor, 0, 1, 0, -1) ; select line 1  
  EditorColor(#Editor, RGB(0,0,255))  
  EditorFontSize(#Editor, 18)  
  EditorFormat(#Editor, #CFM_UNDERLINE)  
   
  EditorSelect(#Editor, 1, 1, 1, -1) ; select line 2  
  EditorColor(#Editor, RGB(255,0,0))  
  EditorFont(#Editor, "Times New Roman")  
  EditorFormat(#Editor, #CFM_ITALIC|#CFM_STRIKEOUT)  

  EditorSelect(#Editor, 2, 1, 2, -1) ; select line 2  
  EditorBackColor(#Editor, RGB(255,200,100))  
   
  EditorSelect(#Editor, 0, 0, 0, 0) ; select nothing again  

   
  Repeat  
  Event=WaitWindowEvent()  
  If Event=#PB_Event_Gadget
  If EventGadget()=0
  FileStreamOut(0, "Temp.rtf", 1)
  Delay(200)
  If FileSize("Temp.rtf")>0
  RunProgram("Temp.rtf")
  Else
  MessageRequester("", "Проблемы при создании файла!", #MB_OK|#MB_ICONERROR)
  EndIf
  EndIf
  EndIf
  Until Event = #PB_Event_CloseWindow  
  EndIf  
EndIf  

End










Сайт посвящён языку программирования PureBasic — коммерческий компилятор языка программирования, использующего синтаксис BASIC. Предназначен для создания кроссплатформенных приложений для AmigaOS, Linux, Microsoft Windows, Windows NT и Mac OS X. Разработан компанией Fantaisie Software.